unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.Platform.Win, FMX.Layouts, FMX.Memo; type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
FHwnd: HWND; // 保存窗口句柄
FOldWndProc: LONG; // 保存原始的消息处理函数
public
{ Public declarations }
function WndProc(HWND: HWND; Msg: UINT; wParam: wParam; lParam: lParam): LRESULT;
end; var
Form1: TForm1; implementation {$R *.fmx}
function WindowProc(HWND: HWND; Msg: UINT; wParam: wParam; lParam: lParam): LRESULT; stdcall;
begin
// 因为在通常开发时,需要访问窗口内部的方法或控件等
// 为了方便起见,所以在这里做一个消息转发
Result := Form1.WndProc(HWND, Msg, wParam, lParam);
end; procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('Button1');
end; procedure TForm1.FormCreate(Sender: TObject);
begin
// 获得主窗口句柄,在FMX框架下,Handle已经不是本窗口的句柄了,需要转换一下
FHwnd := FmxHandleToHwnd(Handle); // FMX平台提供的函数,但不适用于WIN以外的平台
// 保存原始的WindowProc地址
FOldWndProc := GetWindowLongPtr(FHwnd, GWL_WNDPROC); // 纯粹WINAPI函数
// 获得消息处理权
SetWindowLongPtr(FHwnd, GWL_WNDPROC, NativeInt(@WindowProc));
end; procedure TForm1.FormDestroy(Sender: TObject);
begin
// 因为窗口销毁后无法再处理Windows传递来的消息,从而会发生内存访问错误
// 所以在窗口销毁前要把消息处理权移交给原始的WindowProc
SetWindowLongPtr(FHwnd, GWL_WNDPROC, FOldWndProc);
end; function TForm1.WndProc(HWND: HWND; Msg: UINT; wParam: wParam;
lParam: lParam): LRESULT;
begin
Result := ;
// 这里测试处理鼠标滚轮消息
if Msg = WM_MOUSEWHEEL then
begin
Memo1.Lines.Add('亲~!你使用了鼠标滚轮哦~!');
Exit; // 加上这句后,后续不再处理
end;
if Msg = WM_LBUTTONDOWN then
begin
Memo1.Lines.Add('亲~!你使用了WM_LBUTTONDOWN~!');
//Exit; // 屏蔽这句后,后续接着处理。否则,不再执行点击鼠标按钮后的代码。
end;
Result := CallWindowProc(Ptr(FOldWndProc), HWND, Msg, wParam, lParam);
end; end.

参考:

http://blog.csdn.net/aqtata/article/details/7710684

FireMonkey下的WndProc实现的更多相关文章

  1. FireMonkey下的异形窗体拖动(句柄转换)

    DelphiXE2 Firemoney FMX 的窗体不只是为windows的, 所以很多功能都没有了. 最常见的就是拖拽了 先看 VCL时代 一个经典拖动代码 ReleaseCapture(); S ...

  2. FireMonkey下的异形窗体拖动(需要使用FmxHandleToHwnd函数转化一下句柄)

    DelphiXE2 Firemoney FMX 的窗体不只是为windows的, 所以很多功能都没有了. 最常见的就是拖拽了 先看 VCL时代 一个经典拖动代码 ReleaseCapture(); S ...

  3. Delphi FireMonkey使用UniDAC 连接MySQL

    首次用Delphi XE6 开发安卓程序,并没有在网上找到连接远程MySQL服务器的文档,自己摸索一番,发现UniDAC控件新版本也已支持了FireMonkey下的开发.遂记下连接方法和大家分享. 1 ...

  4. Firemonkey的旁门左道[四]

    做开发,就是发现问题,解决问题,又发现问题...周而复始的循环 下面又应该是Firemonkey下的bug. 官方文档中描述: Using the FireMonkey TMenuBar's OSMe ...

  5. Bitmap Style Designer非官方说明

    Bitmap Style Designer Bitmap Style Designer给我的第一印象就是简陋,估计也是为了赶工.大致体会了一下,还是能够使用.因为目前没有对此有比较详细的中文资料,就把 ...

  6. 【转】簡單講講 USB Human Interface Device

    原地址http://213style.blogspot.com/2013/09/usb-human-interface-device.html 恩,發本文的原因是看到了以前畢業的朋友在旁邊的對話框問了 ...

  7. FMX ScrollBox 拖拽控制

    Firemonkey下的ScrollBox 拖拽控制,滚动控制,拖拽,滚动条 AniCalculations 仅允许纵向拖拽,拖拽 scrlbx.AniCalculations.TouchTracki ...

  8. Delphi RAD Berlin OutputDebugString 输出调试信息

    Delphi RAD Berlin Event Log.OutputDebugString 输出调试信息,仅在win VCL下可以用.OutputDebugString(PChar('hellowor ...

  9. LiveBinding应用 dataBind 数据绑定

    http://blog.csdn.net/embarcaderochina/article/details/50352193 firemonkey grid/listview dataBind,数据绑 ...

随机推荐

  1. c#FileStream文件读写

    //C#文件流写文件,默认追加FileMode.Append             string msg = "okffffffffffffffff";            b ...

  2. LeetCode OJ——Two Sum

    http://oj.leetcode.com/problems/two-sum/ 求是否存在两个数的和为target,暴力法,两层循环 #include <iostream> #inclu ...

  3. Codeforces Gym101606 D.Deranging Hat (2017 United Kingdom and Ireland Programming Contest (UKIEPC 2017))

    D Deranging Hat 这个题简直了,本来想的是冒泡排序然后逆着输出来的,后来发现不对,因为题目上求的是最优解,而且冒泡的话,输出结果有的超出10000行了,所以就是把一开始的,排好序的字母标 ...

  4. codevs——3344 迷宫

    3344 迷宫  时间限制: 1 s  空间限制: 32000 KB  题目等级 : 黄金 Gold 题解       题目描述 Description 小刚在迷宫内,他需要从A点出发,按顺序经过B, ...

  5. 树讲解——牧场行走( lca )

    大视野   1602: [Usaco2008 Oct]牧场行走 Time Limit: 5 Sec  Memory Limit: 64 MBSubmit: 1947  Solved: 1021[Sub ...

  6. Xamarin.Forms的相对布局RelativeLayout

    Xamarin.Forms的相对布局RelativeLayout   相对布局RelativeLayout是App中常用的布局方式.它是以界面中的某个元素为基准,设置另外一个元素的位置和大小.通过这种 ...

  7. Centos7源码安装MySQL5.7

    a.连接数据库报111 从一台linux远程连接另一台linux上的MySQL,出现ERROR 2003 (HY000): Can't connect to MySQL server on 'xxx. ...

  8. SQL 列转行与行转列

    假设有张学生成绩表(tb)如下:Name Subject Result张三 语文 74张三 数学 83张三 物理 93李四 语文 74李四 数学 84李四 物理 94*/ -------------- ...

  9. spring-boot实战【01】:Hello World项目搭建

    原文:http://www.cnblogs.com/yucongblog/p/7355519.html 简介 在您第1次接触和学习Spring框架的时候,是否因为其繁杂的配置而退却了?在你第n次使用S ...

  10. win7 32位安装pyqt

    参考 http://blog.csdn.net/fairyeye/article/details/6607981 http://www.cnblogs.com/toSeek/p/6363036.htm ...