TFrameのOnMouseWheelイベントが発生しない

解決

ひろし 2014-06-14 10:18:45 No: 46397

フレームを使用してプログラムを作成しているのですが、
OnMouseWheelのイベントで画像の拡大・縮小をさせようとしているのですが、
このイベントが発生しませんでした。

テストとして下記の作業をしてみましたがダメでした。
１．Frameを1つ作成し、FrameのOnMouseWheelイベントでShowMessageでメッセージボックスを表示
２．１で作成したFrameをFormに貼り付け
３．Formに貼り付けたFrameのOnMouseWheelイベントでShowMessageでメッセージボックスを表示
４．Form自体のOnMouseWheelイベントでShowMessageでメッセージボックスを表示

１と３のメッセージボックスは表示されませんでしたが、４のメッセージボックスは表示されました。

ちなみに、OnMouseWheelUp、OnMouseWheelDownも発生しませんでした。

開発環境はDelphi XE4です。

OnMouseWheelイベントを発生させる方法を教えてください。
よろしくお願いします。

マッコ 2014-06-15 09:46:49 No: 46398

TApplicationEventsを使用した例です
TApplicationEventsのイベントOnMessageをいじくってください
エリア判定はしていません

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls, Unit2, ExtCtrls, AppEvnts;

type
  TForm1 = class(TForm)
    Frame1: TFrame1;
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
  private
    { Private 宣言 }
  protected
  public
    { Public 宣言 }
    procedure DecZoom;//縮小
    procedure IncZoom;//拡大
  end;
var
  Form1: TForm1;

implementation
uses
Dialogs;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
Frame1.Image1.Canvas.TextOut(1,1,'拡大');
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  //Re: HRESULT;
  fwKeys: LOWORD;
  zDelta: ShortInt;
begin
  if Msg.message = WM_MOUSEWHEEL then
  begin
    //if IsChild(Frame1.Image1.Canvas.Handle, GetFocus) then
    begin
      fwKeys := LOWORD(Msg.wParam);
      //if fwKeys = 8 then //Ctrlキー
      begin
        zDelta := HIWORD(Msg.wParam);
        if zDelta > 0 then
        begin
          //拡大
          IncZoom;
        end
        else
        begin
          //縮小
          DecZoom;
        end;
      end;
      Handled := true;
    end;
  end;
end;
procedure TForm1.DecZoom;//縮小
begin
  if Frame1.Image1.Canvas.Font.Height < -1 then
  begin
    Frame1.Image1.Canvas.Font.Height := Frame1.Image1.Canvas.Font.Height + 1;
    Frame1.Image1.Canvas.TextOut(1, 1, '拡大');
  end;
end;
procedure TForm1.IncZoom;//拡大
begin
  if Frame1.Image1.Canvas.Font.Height > -96 then
  begin
    Frame1.Image1.Canvas.Font.Height := Frame1.Image1.Canvas.Font.Height - 1;
    Frame1.Image1.Canvas.TextOut(1, 1, '拡大');
  end;
end;
end.

unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;

type
  TFrame1 = class(TFrame)
    Image1: TImage;
  private
    { Private 宣言 }

  public
    { Public 宣言 }
  end;

implementation

{$R *.dfm}
end.

Mr.XRAY 2014-06-16 17:41:53 No: 46399

>OnMouseWheelイベントを発生させる方法を教えてください。

フォームに配置したフレームで OnMouseWheelイベントが検出されればいいのでしょうか．
でしたら，

(1) 以下の手順で新規にプロジェクトを作成するものとします．
http://mrxray.on.coocan.jp/Delphi/plSamples/030_CaptionBar_Button.htm#01

(2) フレームを配置した Form1 の OnMouseWheelイベントを作成する
(3) イベントのコードを次のようにする

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  aPos : TPoint;
begin
  aPos := Frame11.ScreenToClient(MousePos);
  if PtInRect(Frame11.ClientRect, aPos) then begin
    Memo1.Lines.Add('AAAA')
  end else begin
    Handled := True;
  end;
end;

というのはどうでしょうか．
Memo1 は確認用に配置した TMemo コンポーネントです．

ひろし 2014-06-25 16:31:03 No: 46400

マッコ様、Mr.XRAY様返信遅くなり、すみません。

Mr.XRAY様の方法で作業をしました。

これで、目的は達成できました。
ありがとうございます。

ホイールのイベントは色々大変なようですね。