PngButton/PNGButton.pas

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.