Index
» Empathy Jukebox : Blob e54900 / Standalone_Components / Tbitmapcheckbox / bitmapcheckbox.pas
unit bitmapcheckbox; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms; type tmatrix = record x1,y1,x2,y2 : integer; item : integer; end; const DEFAULTFONT='Garamond'; type TBitmapCheckbox = class(TGraphicControl) private fcolor : Tcolor; ftext : string; fchecked : boolean; procedure setcolor(_color : tcolor); procedure settext(txt : string); procedure setchecked (check : boolean); procedure autosize; { Private declarations } protected { Protected declarations } public constructor Create(AOwner : TComponent); override; procedure Paint; override; procedure Resize; override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);override; procedure Click; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);override; { Public declarations } published property color : Tcolor read Fcolor write setcolor default clred; property Font; property ParentFont; property caption : string read ftext write settext; property checked : boolean read fchecked write setchecked; property OnClick; { Published declarations } end; const ICONWIDTH=32; procedure Register; implementation {$R ICONS.RES} procedure TBitmapCheckBox.autosize; begin canvas.font.name:=font.name; canvas.font.size:=font.size; if (canvas.textwidth(ftext)+ICONWIDTH+16)>=width then width:=(canvas.textwidth(caption)+ICONWIDTH+19); if (canvas.textheight(ftext))>=height then height:=(canvas.textheight(ftext)); if height<ICONWIDTH then height:=iconWIDTH; end; procedure TBitmapCheckBox.setcolor(_color : tcolor); begin Fcolor:=_color; autosize; invalidate; end; procedure TBitmapCheckBox.settext(txt : string); begin ftext:=txt; autosize; invalidate; end; procedure TBitmapCheckBox.setchecked(check: boolean); begin fchecked:=check; invalidate; end; constructor TBitmapCheckBox.Create(AOwner : TComponent); begin inherited Create(AOwner); Parent := (AOwner AS TWinControl); controlstyle:=controlstyle-[csOpaque]; fcolor:=clWindow; canvas.pen.style:=psSolid; height:=32; width:=50; end; procedure TBitmapCheckBox.Paint; var vicon : tbitmap; textcentre : integer; tr,dr : trect; begin inherited Paint; vicon:=tbitmap.create; if fchecked=true then begin vicon.loadfromresourcename(hinstance,'TICK'); end else vicon.loadfromresourcename(hinstance,'CROSS'); canvas.Brush.color:=fcolor; tr.Left:=0; tr.Top:=0; tr.Right:=vicon.width; tr.Bottom:=vicon.height; dr.Left:=2; dr.Top:=2; dr.Right:=vicon.width+2; dr.Bottom:=vicon.height; canvas.Brush.Style:=bsClear; canvas.brushcopy(dr,vicon,tr,rgb(255,255,255)); textcentre:=(height div 2) - (canvas.textheight(ftext) div 2); canvas.font.style:=font.style; canvas.font.name:=font.name; canvas.font.size:=font.size; canvas.font.color:=font.color; canvas.textout(vicon.width+16,textcentre,ftext); vicon.free; end; procedure Register; begin RegisterComponents('LibrarySmith', [TBitmapCheckBox]); end; procedure TBitmapCheckBox.Resize; begin inherited resize; canvas.Font:=font; end; procedure TBitmapCheckBox.click; begin if fchecked=true then fchecked:=false else fchecked:=true; invalidate; inherited click; end; procedure TBitmapCheckBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin end; procedure TBitmapCheckBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin end; end.