www.pudn.com > d4psp31.zip > cmpTimerSpeedButton.pas, change:1997-07-01,size:2442b


unit cmpTimerSpeedButton; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, ExtCtrls, Classes, Graphics, Controls, Forms, Dialogs, 
  Buttons; 
 
const 
  InitRepeatPause = 400;  { pause before repeat timer (ms) } 
  RepeatPause     = 100;  { pause before hint window displays (ms)} 
 
type 
  TTimeBtnState = set of (tbFocusRect, tbAllowTimer); 
 
  TTimerSpeedButton = class(TSpeedButton) 
  public 
    FRepeatTimer: TTimer; 
    FTimeBtnState: TTimeBtnState; 
    procedure TimerExpired(Sender: TObject); 
  protected 
    procedure Paint; override; 
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; 
      X, Y: Integer); override; 
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; 
      X, Y: Integer); override; 
  public 
    destructor Destroy; override; 
 
  published 
    property TimeBtnState: TTimeBtnState read FTimeBtnState write FTimeBtnState; 
  end; 
 
procedure Register; 
 
implementation 
 
destructor TTimerSpeedButton.Destroy; 
begin 
  if FRepeatTimer <> nil then 
    FRepeatTimer.Free; 
  inherited Destroy; 
end; 
 
procedure TTimerSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; 
  X, Y: Integer); 
begin 
  inherited MouseDown (Button, Shift, X, Y); 
  if tbAllowTimer in FTimeBtnState then 
  begin 
    if FRepeatTimer = nil then 
      FRepeatTimer := TTimer.Create(Self); 
 
    FRepeatTimer.OnTimer := TimerExpired; 
    FRepeatTimer.Interval := InitRepeatPause; 
    FRepeatTimer.Enabled  := True; 
  end; 
end; 
 
procedure TTimerSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; 
                                  X, Y: Integer); 
begin 
  inherited MouseUp (Button, Shift, X, Y); 
  if FRepeatTimer <> nil then 
    FRepeatTimer.Enabled  := False; 
end; 
 
procedure TTimerSpeedButton.TimerExpired(Sender: TObject); 
begin 
  FRepeatTimer.Interval := RepeatPause; 
  if (FState = bsDown) and MouseCapture then 
  begin 
    try 
      Click; 
    except 
      FRepeatTimer.Enabled := False; 
      raise; 
    end; 
  end; 
end; 
 
procedure TTimerSpeedButton.Paint; 
var 
  R: TRect; 
begin 
  inherited Paint; 
  if tbFocusRect in FTimeBtnState then 
  begin 
    R := Bounds(0, 0, Width, Height); 
    InflateRect(R, -3, -3); 
    if FState = bsDown then 
      OffsetRect(R, 1, 1); 
    DrawFocusRect(Canvas.Handle, R); 
  end; 
end; 
 
procedure Register; 
begin 
  RegisterComponents('Samples', [TTimerSpeedButton]); 
end; 
 
end.