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. macOS(Sierra 10.12)上Android源码(AOSP)的下载、编译与导入到Android Studio

    @import url(http://i.cnblogs.com/Load.ashx?type=style&file=SyntaxHighlighter.css);@import url(/c ...

  2. 关于nginx所遇问题

    1. 如果出现 nginx: [error] invalid PID number “” in “/usr/local/var/run/nginx/nginx.pid” 错误重新加载配置文件 /usr ...

  3. 网站robots.txt探测工具Parsero

    网站robots.txt探测工具Parsero   robots.txt文件是网站根目录下的一个文本文件.robots.txt是搜索引擎中访问网站的时候要查看的第一个文件.当搜索引擎访问一个站点时,它 ...

  4. Javao中使用Jackson反序列时,将LinkedHashMap转成对象的方法(将任何Object类型转成实体)

    可能存在这样一种情况,Jackson已经满足了大部分的序列化和反序列化工作,但是对于复杂的泛型实体估计未必能如愿的正常反序列,而此时对于一些泛型里面的实体对象就会反序列化成LinkedHashMap类 ...

  5. linux的history命令设置

    history的历史记录,同一个用户的各个会话,读取到的内容也是不一样的,原因是它读取的是shell会话缓存里的内容.只有当用户退出当前会话的时候,会话里的缓存内容才会写入~/.bash_histor ...

  6. android wifi state and wifi ap state

    /** * Wi-Fi is currently being disabled. The state will change to {@link #WIFI_STATE_DISABLED} if * ...

  7. Lazarus安装使用

    Lazarus安装使用 最后还是安装了Lazarus: 安装之后,新建了项目,还引入了Unit,就可以跑了: 学习:http://tieba.baidu.com/p/3164001113 progra ...

  8. vue2.0 自定义 下拉刷新和上拉加载更多(Scroller) 组件

    1.下拉刷新和上拉加载更多组件 Scroller.vue <!-- 下拉刷新 上拉加载更多 组件 --> <template> <div :style="mar ...

  9. mac os PHP 访问MSSQL

    写在前: 项目的数据库是sql server,但是自己的系统是mac os.这样导致了需要一个烦人的系统环境搭建过程.目前要在mac 上的php环境中支持mssql环境访问,经过自己了解,有两种方式: ...

  10. import caffe时出错:can not find module skimage.io

    import caffe时出错:can not find module skimage.io  //以下内容在ubuntu16.4上实际验证过.注意大小写的.----20170605 在命令行输入Py ...