この発言に対し以下のコメントが寄せられています

#00595　おじちゃま      さん　RE:インテリマウスのオートスクロールもど




インテリマウスのオートスクロールもどきをTMemoで実現するサンプル



・縦方向のオートスクロール
・基準マウス位置の残像(？)未サポート

フォーム上にTmemo,TTimerコンポーネントを貼り付けてください。
内容は簡単ですから、とくに説明は要らないと思います。

======================================================================

var
    FX,    FY,          //基準位置(ホイールボタン押下位置)
    FSaX,  FSaY,        //マウス移動位置
    FBsTmr: integer;    //基準タイマイベント間隔

procedure TForm1.FormCreate(Sender: TObject);
var       cnt: integer;
begin
  FBsTmr := 500;
  FX:=0; FY:=0; FSaX:=0; FSaY:=0;
  for cnt := 0 to 1000 do
    Memo1.Lines.Append(IntToStr(cnt));
end;

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Screen.Cursor = crSizeNS then
    Screen.Cursor := crDefault;
  FX:=X; FY:=Y;                       //基準座標取得
  if Button = mbMiddle then
  begin
    if Shift = [ssMiddle] then
    begin
      if Timer1.Enabled then
      begin
        Timer1.Enabled := False;      //タイマーイベント無効
        FSaX := 0; FSaY := 0;         //差分値の初期化
      end else begin
        //オートスクロール状態に
        Timer1.Enabled := True;       //タイマーイベント有効
        Screen.Cursor  := crSizeNS;   //カーソル変更
      end;
    end else begin
      Timer1.Enabled := False;        //タイマーイベント無効
      FSaX := 0; FSaY := 0;           //差分値の初期化
    end;
  end else begin
    Timer1.Enabled := False;          //タイマーイベント無効
    FSaX := 0; FSaY := 0;             //差分値の初期化
  end;
end;

procedure TForm1.Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Timer1.Enabled then
  begin
    //差分値取得
    FSaX := Round((X - FX) * 0.1);                
    FSaY := Round((Y - FY) * 0.1);
    if FSaY <> 0 then
    begin
      if FSaY > 0 then
      begin
        //差分値によるタイマイベント間隔の最適化
        Timer1.Interval := Round(FBsTmr / FSaY);  
        Application.ProcessMessages;              
        Caption := IntToStr(Timer1.Interval);
      end else begin
        //差分値によるイベント間隔の最適化
        Timer1.Interval := Round(FBsTmr / -FSaY); 
        Caption := IntToStr(Timer1.Interval);
      end;
    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if Timer1.Enabled then
  begin
    if FSaY <> 0 then
    begin
      if (Memo1.ScrollBars = ssVertical) or
         (Memo1.ScrollBars = ssBoth)     then
      begin
        //スクロールバーの移動
        if FSaY < 0 then Memo1.Perform(WM_VSCROLL,SB_LINEUP,0);
        if FSaY > 0 then Memo1.Perform(WM_VSCROLL,SB_LINEDOWN,0);
      end;
    end;
  end;
end;

======================================================================

個々の手続きは動作しますが、動作するサンプルのサブセット的なコーディン
グ部分を抜き出したものですので、上記だけでは動きません。(^^ゞ悪しから
ず。
動作保証できるサンプル本体は、
        http://www.infonia.ne.jp/~triple/
の「フリーウェア」に置いてあります。

ぼやき．．．
・ライブラリにアップしたいけど何処に揚げれば良いんだろう？
・基準になるマウス位置に、残像を残す方法が、わかる方がいましたら
続けていただければ幸いです。

おじちゃま


Original document by おじちゃま      氏 ID:(BYY01245)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。