Browse Source

release button after click

Johann ELSASS 5 years ago
parent
commit
f4297ca459
1 changed files with 27 additions and 14 deletions
  1. 27 14
      bgrathemebutton.pas

+ 27 - 14
bgrathemebutton.pas

@@ -7,7 +7,7 @@ interface
 
 
 uses
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
-  BGRATheme, Types;
+  BGRATheme, Types, ExtCtrls;
 
 
 type
 type
 
 
@@ -17,7 +17,9 @@ type
   private
   private
     FModalResult: TModalResult;
     FModalResult: TModalResult;
     FState: TBGRAThemeButtonState;
     FState: TBGRAThemeButtonState;
+    FTimerHover: TTimer;
     procedure SetState(AValue: TBGRAThemeButtonState);
     procedure SetState(AValue: TBGRAThemeButtonState);
+    procedure TimerHoverElapse(Sender: TObject);
   protected
   protected
     class function GetControlClassDefaultSize: TSize; override;
     class function GetControlClassDefaultSize: TSize; override;
     procedure MouseEnter; override;
     procedure MouseEnter; override;
@@ -25,12 +27,12 @@ type
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
       X, Y: integer); override;
       X, Y: integer); override;
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
-    procedure DoMouseMove({%H-}x, {%H-}y: integer); virtual;
     procedure Click; override;
     procedure Click; override;
     procedure SetEnabled(Value: boolean); override;
     procedure SetEnabled(Value: boolean); override;
     procedure TextChanged; override;
     procedure TextChanged; override;
     procedure Paint; override;
     procedure Paint; override;
     procedure Resize; override;
     procedure Resize; override;
+    procedure UpdateHoverState;
     property State: TBGRAThemeButtonState read FState write SetState;
     property State: TBGRAThemeButtonState read FState write SetState;
   public
   public
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
@@ -63,9 +65,15 @@ procedure TBGRAThemeButton.SetState(AValue: TBGRAThemeButtonState);
 begin
 begin
   if FState=AValue then Exit;
   if FState=AValue then Exit;
   FState:=AValue;
   FState:=AValue;
+  FTimerHover.Enabled := (FState = btbsHover);
   Invalidate;
   Invalidate;
 end;
 end;
 
 
+procedure TBGRAThemeButton.TimerHoverElapse(Sender: TObject);
+begin
+  UpdateHoverState;
+end;
+
 class function TBGRAThemeButton.GetControlClassDefaultSize: TSize;
 class function TBGRAThemeButton.GetControlClassDefaultSize: TSize;
 begin
 begin
   Result.CX := 125;
   Result.CX := 125;
@@ -97,26 +105,16 @@ end;
 
 
 procedure TBGRAThemeButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
 procedure TBGRAThemeButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
   X, Y: integer);
   X, Y: integer);
-var
-  p: TPoint;
 begin
 begin
   inherited MouseUp(Button, Shift, X, Y);
   inherited MouseUp(Button, Shift, X, Y);
-  p := ScreenToClient(Mouse.CursorPos);
-
-  if (p.x >= 0) and (p.x <= Width) and (p.y >= 0) and (p.y <= Height) then
-   State := btbsHover
-   else State := btbsNormal;
-end;
-
-procedure TBGRAThemeButton.DoMouseMove(x, y: integer);
-begin
-  inherited;
+  UpdateHoverState;
 end;
 end;
 
 
 procedure TBGRAThemeButton.Click;
 procedure TBGRAThemeButton.Click;
 var
 var
   Form: TCustomForm;
   Form: TCustomForm;
 begin
 begin
+  UpdateHoverState;
   if ModalResult <> mrNone then
   if ModalResult <> mrNone then
   begin
   begin
     Form := GetParentForm(Self);
     Form := GetParentForm(Self);
@@ -161,6 +159,16 @@ begin
   inherited Resize;
   inherited Resize;
 end;
 end;
 
 
+procedure TBGRAThemeButton.UpdateHoverState;
+var
+  p: TPoint;
+begin
+  p := ScreenToClient(Mouse.CursorPos);
+  if (p.x >= 0) and (p.x <= Width) and (p.y >= 0) and (p.y <= Height) then
+   State := btbsHover
+   else State := btbsNormal;
+end;
+
 constructor TBGRAThemeButton.Create(AOwner: TComponent);
 constructor TBGRAThemeButton.Create(AOwner: TComponent);
 begin
 begin
   inherited Create(AOwner);
   inherited Create(AOwner);
@@ -170,6 +178,11 @@ begin
 
 
   with GetControlClassDefaultSize do
   with GetControlClassDefaultSize do
     SetInitialBounds(0, 0, CX, CY);
     SetInitialBounds(0, 0, CX, CY);
+
+  FTimerHover := TTimer.Create(self);
+  FTimerHover.Enabled := false;
+  FTimerHover.Interval := 100;
+  FTimerHover.OnTimer:=@TimerHoverElapse;
 end;
 end;
 
 
 end.
 end.