TFrameのOnMouseWheelイベントが発生しない (ID:46398)

名前

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

本文

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.

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

戻る