unit BitmapButton; interface uses Windows, Messages, RealICQUIColor, RealICQColors,SysUtils, Classes, Graphics, Controls, Forms, Dialogs,Buttons; type TBitmapButton = class(TGraphicControl,IRealICQUIColor) private FBitmap: TBitmap; FLighter: TBitmap; FDarker: Tbitmap; FPushDown:boolean; FMouseOver:boolean; FLatching: boolean; FDown: boolean; FHotTrack: boolean; procedure SetBitmap(const Value: TBitmap); procedure MakeDarker; procedure MakeLighter; procedure SetLatching(const Value: boolean); procedure SetDown(const Value: boolean); procedure SetHotTrack(const Value: boolean); { Private declarations } protected { Protected declarations } procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override; procedure MouseMove(Shift: TShiftState; X, Y: Integer);override; procedure Click;override; procedure CMMouseLeave(var Message:TMessage); message CM_MouseLeave; procedure Loaded;override; procedure Resize;override; public { Public declarations } constructor Create(AOwner:TComponent);override; destructor Destroy;override; procedure Paint; override; procedure ChangeUIColor(AColor: TColor); published { Published declarations } property Align; property Bitmap:TBitmap read FBitmap write SetBitmap; property Down:boolean read FDown write SetDown; property Latching:boolean read FLatching write SetLatching; property HotTrack:boolean read FHotTrack write SetHotTrack; property OnClick; property ShowHint; property Hint; property OnmouseDown; property OnMouseUp; property OnMouseMove; end; procedure Register; implementation { TBitmapButton } procedure TBitmapButton.Click; begin inherited Click; // if FPushDown then // if assigned(onclick) then // OnClick(self); end; constructor TBitmapButton.Create(AOwner: TComponent); begin inherited; width:=24; height:=24; FPushDown:=false; FMouseOver:=false; FLatching:=false; FHotTrack:=true; FDown:=false; FBitmap:=TBitmap.create; Fbitmap.width:=24; Fbitmap.Height:=24; Fbitmap.canvas.brush.color:=clgray; FBitmap.canvas.FillRect (rect(1,1,23,23)); FLighter:=Tbitmap.create; FDarker:=Tbitmap.create; end; destructor TBitmapButton.Destroy; begin FBitmap.free; FLighter.free; FDarker.free; inherited; end; procedure TBitmapButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; if FBitmap.canvas.pixels[x,y]<>Fbitmap.canvas.pixels[0,FBitmap.height-1] then FPushDown:=true else FPushDown:=false; Paint; // if assigned(OnMouseDown) then // OnMouseDown(self,button,shift,x,y); end; procedure TBitmapButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseUp(Button, Shift, X, Y); FPushDown:=false; if Latching then FDown:= not FDown else FDown:=false; Paint; // if assigned(OnMouseUp) then // OnMouseUp(self,button,shift,x,y); end; procedure TBitmapButton.Paint; var Acolor:TColor; begin inherited; if assigned(FBitmap) then begin AColor:=FBitmap.canvas.pixels[0,FBitmap.height-1]; Fbitmap.transparent:=true; Fbitmap.transparentcolor:=Acolor; FLighter.transparent:=true; Flighter.TransparentColor :=AColor; FDarker.transparent:=true; FDarker.TransparentColor :=AColor; if FPushdown then begin canvas.draw(1,1,FBitmap)// FDarker end else begin if Down then canvas.Draw(1,1,FBitmap) else if (FMouseOver and FHotTrack) then canvas.draw(0,0,FLighter) else canvas.Draw (0,0,FBitmap); end; end; end; procedure TBitmapButton.SetBitmap(const Value: TBitmap); begin FBitmap.assign(Value); FBitmap.transparent:=true; FBitmap.TransparentColor :=FBitmap.Canvas.pixels[0,FBitmap.Height-1]; width:=FBitmap.Width ; height:=FBitmap.Height ; MakeLighter; MakeDarker; end; procedure TBitmapButton.MakeLighter; var p1,p2:Pbytearray; x,y:integer; rt,gt,bt:byte; r,g,b:byte; AColor:TColor; begin FLighter.Width :=FBitmap.Width ; FLighter.Height :=FBitmap.height; Acolor:=colortorgb(FBitmap.canvas.pixels[0,FBitmap.height-1]); rt:=GetRValue(Acolor); gt:=GetGValue(AColor); bt:=getBValue(AColor); FBitmap.PixelFormat :=pf24bit; FLighter.PixelFormat :=pf24bit; for y:=0 to Fbitmap.height-1 do begin p1:=Fbitmap.ScanLine [y]; p2:=FLighter.ScanLine [y]; for x:=0 to FBitmap.width-1 do begin if (p1[x*3]=bt)and (p1[x*3+1]=gt)and (p1[x*3+2]=rt) then begin p2[x*3]:=p1[x*3]; p2[x*3+1]:=p1[x*3+1]; p2[x*3+2]:=p1[x*3+2]; end else begin p2[x*3]:=$FF-round(0.8*abs($FF-p1[x*3])); p2[x*3+1]:=$FF-round(0.8*abs($FF-p1[x*3+1])); p2[x*3+2]:=$FF-round(0.8*abs($FF-p1[x*3+2])); end; end; end; end; procedure TBitmapButton.MakeDarker; var p1,p2:Pbytearray; x,y:integer; rt,gt,bt:byte; r,g,b:byte; AColor:TColor; begin FDarker.Width :=FBitmap.Width ; FDarker.Height :=FBitmap.height; Acolor:=colortorgb(FBitmap.canvas.pixels[0,FBitmap.height-1]); rt:=GetRValue(Acolor); gt:=GetGValue(AColor); bt:=getBValue(AColor); FBitmap.PixelFormat :=pf24bit; FDarker.PixelFormat :=pf24bit; for y:=0 to Fbitmap.height-1 do begin p1:=Fbitmap.ScanLine [y]; p2:=FDarker.ScanLine [y]; for x:=0 to FBitmap.width-1 do begin if (p1[x*3]=bt)and (p1[x*3+1]=gt)and (p1[x*3+2]=rt) then begin p2[x*3]:=p1[x*3]; p2[x*3+1]:=p1[x*3+1]; p2[x*3+2]:=p1[x*3+2]; end else begin p2[x*3]:=round(0.7*p1[x*3]); p2[x*3+1]:=round(0.7*p1[x*3+1]); p2[x*3+2]:=round(0.7*p1[x*3+2]); end end; end; end; procedure TBitmapButton.CMMouseLeave(var Message: TMessage); begin FMouseOver:=false; Paint; end; procedure TBitmapButton.Loaded; begin inherited; if not FBitmap.Empty then begin MakeDarker; MakeLighter; end; end; procedure TBitmapButton.SetLatching(const Value: boolean); begin FLatching := Value; if not FLatching then begin FDown:=false; paint; end; end; procedure TBitmapButton.SetDown(const Value: boolean); begin if FLatching then begin FDown := Value; paint; end else begin FDown:=false; paint; end; end; procedure TBitmapButton.Resize; begin inherited; if assigned(Fbitmap) then begin width:=FBitmap.width; height:=FBitmap.Height ; end else begin width:=24; height:=24; end; end; procedure TBitmapButton.SetHotTrack(const Value: boolean); begin FHotTrack := Value; end; procedure TBitmapButton.MouseMove(Shift: TShiftState; X, Y: Integer); var Value:Boolean; begin inherited; Value:= FBitmap.canvas.pixels[x,y]<>Fbitmap.canvas.pixels[0,FBitmap.height-1]; if value<>FMouseOver then begin FMouseOver:=value; Paint; end; // if Assigned(OnMouseMove) then // OnMouseMove(self,shift,x,y); end; procedure TBitmapButton.ChangeUIColor(AColor: TColor); begin ConvertBitmapToColor(FBitmap, AColor); SetBitmap(FBitmap); Invalidate; end; procedure Register; begin RegisterComponents('ICQComponnets', [TBitmapButton]); end; end.