掲示板システム
ホーム
アクセス解析
カテゴリ
ログアウト
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.
←解決時は質問者本人がここをチェックしてください。
戻る
掲示板システム
Copyright 2021 Takeshi Okamoto All Rights Reserved.