unit PNGButton; interface uses System.SysUtils, WinApi.Messages, System.Classes, System.Types, Vcl.Forms, Vcl.Graphics, Vcl.Controls, Vcl.imaging.pngImage; type TPNGButton = class(TGraphicControl) private FOnMouseEnter:TNotifyEvent;//on mouse enter notify event FOnMouseLeave:TNotifyEvent;//on mouse leave notify event FModalResult: TModalResult; //this events are triggered and it will execute a user procedure if is assigned protected EtatBtn: Integer; // 0=Normal 1=Mouse entered 2=Pressed 3=Disabled FDown: Boolean; // value to know if we painting mouse down FUp: Boolean; // value to know if we painting mouse up FStateCount: Integer; // state number FPngImg : TPngImage; //our 4 states image FVisible: Boolean; procedure MouseDown(Button:TMouseButton; Shift:TShiftState; X, Y :integer); override; procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X, Y :integer); override; procedure MouseEnter(var Msg:TMessage); message CM_MOUSEENTER; // to know when mouse is entered procedure MouseLeave(var Msg:TMessage); message CM_MOUSELEAVE; // to know when mouse is leaved procedure SetEnabled(Value:Boolean); override; public Constructor Create(AOwner:TComponent); override; // creation of the component Destructor Destroy; override; // destruction of the component procedure SetStateCount(value: Integer); // set the state number procedure SetPngImg(value:TPngImage); // we set the png image procedure SetDown(value:boolean); // to know if mouse is down or not procedure SetUp(value:boolean); // to know if mouse is up or not procedure Paint; override; // we override the painting of the component procedure Click; override; published property Action; property Anchors; property Down:Boolean read FDown write SetDown default False; property Up:Boolean read FUp write SetUp default False; property Enabled; property ImgStates:Integer read FStateCount write SetStateCount default 4; property ModalResult: TModalResult read FModalResult write FModalResult default 0; property ParentShowHint; property PngImg:TPngImage read FPngImg write SetPngImg; property PopupMenu; property ShowHint; property Visible; property OnClick; property OnContextPopup; property OnMouseDown; property OnMouseUp; property OnMouseMove; property OnMouseEnter:TNotifyEvent read FOnMouseEnter write FOnMouseEnter; property OnMouseLeave:TNotifyEvent read FOnMouseLeave write FOnMouseLeave; end; procedure Register; implementation procedure Register; begin RegisterComponents('Samples', [TPNGButton]); end; //------ Creation of the component ------ Constructor TPNGButton.Create(AOwner:TComponent); begin Inherited Create(AOwner); Height:=25; //a default Height Width:=75; //a default Width FStateCount:=4; //default state count FPngImg:=TPngImage.Create; //we create our png FDown:=False; FVisible:=True; end; //-- Destruction of the component -- Destructor TPNGButton.Destroy; begin FPngImg.Free; //destroy our png Inherited Destroy; end; //------ Function used to set the number of state procedure TPNGButton.SetStateCount(value: Integer); begin if value>4 then value := 4; if value<2 then value := 2; FStateCount := value; end; //------ Function unsed to set the PNG image to draw Procedure TPNGButton.SetPngImg(value:TPngImage); begin FPngImg.Assign(value); {Now we are setting the component width and height} {by the png image used} Height:=FPngImg.Height; Width:=FPngImg.Width div FStateCount; With Constraints do begin MaxHeight:=Height; MinHeight:=Height; MaxWidth:=Width; MinWidth:=Width; end; EtatBtn:=0; {we reset the component state to normal} end; //------ Function to set the component state: mouse down ------ procedure TPNGButton.SetDown(value:boolean); begin if FDown<>value then begin if FStateCount<3 then value := FALSE; FDown:=value; if FDown=False then EtatBtn:=0; {is the mouse down is false then we reset the component state to normal} paint; Refresh; //we repaint the componet) end; end; //------ Function to set the component state: mouse up ------ procedure TPNGButton.SetUp(value:boolean); begin if FUp<>value then begin if FStateCount<3 then value := FALSE; FUp:=value; if FUp=False then EtatBtn:=0; {is the mouse up is false then we reset the component state to normal} paint; Refresh; //we repaint the componet) end; end; //------ Our paint component procedure Procedure TPNGButton.Paint; begin If csDesigning In ComponentState then begin If FPngImg<>nil then begin With Constraints do begin MaxHeight:=FPngImg.Height; MinHeight:=FPngImg.Height; MaxWidth:=FPngImg.Width div FStateCount; MinWidth:=FPngImg.Width div FStateCount; end; end; {get component state: down, enabled/disabled} If (FPngImg<>nil) and (Enabled) then FPngImg.Draw(Canvas,Rect(0, 0, FStateCount*Width, Height)); // Normal If (FPngImg<>nil) and (Enabled) and (FUp) then FPngImg.Draw(Canvas,Rect(-(Width), 0, (FStateCount-1)*Width, Height)); // the component is pressed If (FPngImg<>nil) and (Enabled) and (FDown) then FPngImg.Draw(Canvas,Rect(-(Width*2), 0, (FStateCount-2)*Width, Height)); // the component is pressed If (FPngImg<>nil) and not(Enabled) then FPngImg.Draw(Canvas,Rect(-(Width*3), 0, (FStateCount-3)*Width, Height)); // Disabled {we design a rectangle for our component} {this can be removed to achieve cool rounded buttons} // Canvas.Pen.Style:=psDot; // Canvas.Brush.Style:=bsClear; // Canvas.Rectangle(0,0,Width,Height); end else begin if Visible then begin if (FUp=True) then EtatBtn:=1; if (FDown=True) then EtatBtn:=2; if not(Enabled) then EtatBtn:=3; if FPngImg<>nil then Case EtatBtn of 0: FPngImg.Draw(Canvas,Rect(0,0,FStateCount*Width,Height)); // Normal 1: FPngImg.Draw(Canvas,Rect(-Width,0,(FStateCount-1)*Width,Height)); // Mouse Entered 2: FPngImg.Draw(Canvas,Rect(-(Width*2),0,(FStateCount-2)*Width,Height)); // Pressed 3: FPngImg.Draw(Canvas,Rect(-(Width*3),0,(FStateCount-3)*Width,Height)); // Disabled end; end; end; end; //Set components state: enabled/disabled procedure TPNGButton.SetEnabled(Value:Boolean); begin if Enabled<>Value then begin if FStateCount<4 then //can't be disable Value := TRUE; Inherited SetEnabled(Value); If (Enabled) then EtatBtn:=0 else EtatBtn:=3; paint; Refresh; //we repaint the componet) end; end; //---- Used to know when mouse entered on the our component area---- procedure TPNGButton.MouseDown(Button:TMouseButton; Shift:TShiftState; X,Y:integer); var Form: TCustomForm; pt: TPoint; msg: Integer; begin Inherited MouseDown(Button,Shift,X,Y); if (Button = mbLeft) and (Enabled) and (FStateCount>2) then begin EtatBtn:=2; // press¨¦ paint; Refresh; //permet d'¨¦ffacer le canvas et de redessiner dessus (pour g¨¦rer la transparence) end; end; //---- Used to know when user clicked on the our component area---- procedure TPNGButton.MouseUp(Button:TMouseButton; Shift:TShiftState; X,Y:integer); begin Inherited MouseUp(Button,Shift,X,Y); if (Button = mbLeft) and (Enabled) then begin If (X in [0..Width]) and (Y in [0..Height]) then EtatBtn:=1 {Mouse Entered} else EtatBtn:=0;{normal} paint; Refresh; //we repaint our component end; end; //---- Used to know when mouse entered on the our component area---- procedure TPNGButton.MouseEnter(var Msg: TMessage); begin if Enabled and not(csDesigning In ComponentState) then begin EtatBtn:=1; // Mouse Entered paint; Refresh; //repainting the component end; if Assigned(FOnMouseEnter) then FOnMouseEnter(Self); //if user set a mouse enter procedure then we execute it end; // To know when user exit the component area procedure TPNGButton.MouseLeave(var Msg: TMessage); begin if Enabled and not(csDesigning In ComponentState) then begin EtatBtn:=0; //Normal paint; Refresh; //repainting the component end; if Assigned(FOnMouseLeave) then FOnMouseLeave(Self); //if user set a mouse leave procedure then we execute it end; procedure TPNGButton.Click; var Form: TCustomForm; begin Form := GetParentForm(Self); if Form <> nil then Form.ModalResult := ModalResult; inherited Click; end; end.