onclickイベントの連続実行を

解決

じおう 2005-07-29 10:01:29 No: 16709

ボタンをクリックして、マウスボタンを押している間はonclickイベントを連続で実行するようにしたいと思っています。
onmousedownからonclickに飛ばすようにしたりいろいろ試してみたのですが、うまくいきません。
ボタンを押してすぐに「押されていない状態」に戻すことができれば（マウスボタンが押されていても）、マウスボタンを押している間は自動で押す動作を繰り返してくれると考えたのですが・・・
ものすごく初歩的な気もするのですが、長時間調べ続けてもさっぱり分からずにいます。
よろしくお願いします。

ばいりんぎゃる 2005-07-29 17:45:42 No: 16710

ボタンのOnClickをタイマーのOnTimerイベントで実行
マウスダウンでタイマー起動して、マウスアップでタイマーオフ

こんな感じか？

Fusa 2005-07-29 18:34:03 No: 16711

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.

じおう 2005-07-30 08:52:00 No: 16712

ばいりんぎゃるさん、Fusaさんありがとうございます！
両方とも試してみます。
勉強になりました。