onclickイベントの連続実行を (ID：16711)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

SampleのSpinButtonのソースコードを持っていれば
その中身が参考になりますよ。

Spin.pasの中にTimeSpeedButtonってのがあって
そこからTimeSpeedButton2というのを
つくってみました。
どぞ。

unit TimerSpeedButton2;

interface

uses
  Windows, ExtCtrls, Messages, SysUtils, 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);

TTimerSpeedButton2 = class(TSpeedButton)
  private
    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

procedure Register;
begin
  RegisterComponents('Samples', [TTimerSpeedButton2]);
end;

{TTimerSpeedButton}

destructor TTimerSpeedButton2.Destroy;
begin
  if FRepeatTimer <> nil then
    FRepeatTimer.Free;
  inherited Destroy;
end;

procedure TTimerSpeedButton2.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 TTimerSpeedButton2.MouseUp(Button: TMouseButton; Shift: TShiftState;
                                  X, Y: Integer);
begin
  inherited MouseUp (Button, Shift, X, Y);
  if FRepeatTimer <> nil then
    FRepeatTimer.Enabled  := False;
end;

procedure TTimerSpeedButton2.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 TTimerSpeedButton2.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;

end.

←解決時は質問者本人がここをチェックしてください。

戻る