Initial commit
This commit is contained in:
+286
@@ -0,0 +1,286 @@
|
||||
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.
|
||||
Reference in New Issue
Block a user