FireMonkey下的WndProc实现
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实现的更多相关文章
- FireMonkey下的异形窗体拖动(句柄转换)
DelphiXE2 Firemoney FMX 的窗体不只是为windows的, 所以很多功能都没有了. 最常见的就是拖拽了 先看 VCL时代 一个经典拖动代码 ReleaseCapture(); S ...
- FireMonkey下的异形窗体拖动(需要使用FmxHandleToHwnd函数转化一下句柄)
DelphiXE2 Firemoney FMX 的窗体不只是为windows的, 所以很多功能都没有了. 最常见的就是拖拽了 先看 VCL时代 一个经典拖动代码 ReleaseCapture(); S ...
- Delphi FireMonkey使用UniDAC 连接MySQL
首次用Delphi XE6 开发安卓程序,并没有在网上找到连接远程MySQL服务器的文档,自己摸索一番,发现UniDAC控件新版本也已支持了FireMonkey下的开发.遂记下连接方法和大家分享. 1 ...
- Firemonkey的旁门左道[四]
做开发,就是发现问题,解决问题,又发现问题...周而复始的循环 下面又应该是Firemonkey下的bug. 官方文档中描述: Using the FireMonkey TMenuBar's OSMe ...
- Bitmap Style Designer非官方说明
Bitmap Style Designer Bitmap Style Designer给我的第一印象就是简陋,估计也是为了赶工.大致体会了一下,还是能够使用.因为目前没有对此有比较详细的中文资料,就把 ...
- 【转】簡單講講 USB Human Interface Device
原地址http://213style.blogspot.com/2013/09/usb-human-interface-device.html 恩,發本文的原因是看到了以前畢業的朋友在旁邊的對話框問了 ...
- FMX ScrollBox 拖拽控制
Firemonkey下的ScrollBox 拖拽控制,滚动控制,拖拽,滚动条 AniCalculations 仅允许纵向拖拽,拖拽 scrlbx.AniCalculations.TouchTracki ...
- Delphi RAD Berlin OutputDebugString 输出调试信息
Delphi RAD Berlin Event Log.OutputDebugString 输出调试信息,仅在win VCL下可以用.OutputDebugString(PChar('hellowor ...
- LiveBinding应用 dataBind 数据绑定
http://blog.csdn.net/embarcaderochina/article/details/50352193 firemonkey grid/listview dataBind,数据绑 ...
随机推荐
- macOS(Sierra 10.12)上Android源码(AOSP)的下载、编译与导入到Android Studio
@import url(http://i.cnblogs.com/Load.ashx?type=style&file=SyntaxHighlighter.css);@import url(/c ...
- 关于nginx所遇问题
1. 如果出现 nginx: [error] invalid PID number “” in “/usr/local/var/run/nginx/nginx.pid” 错误重新加载配置文件 /usr ...
- 网站robots.txt探测工具Parsero
网站robots.txt探测工具Parsero robots.txt文件是网站根目录下的一个文本文件.robots.txt是搜索引擎中访问网站的时候要查看的第一个文件.当搜索引擎访问一个站点时,它 ...
- Javao中使用Jackson反序列时,将LinkedHashMap转成对象的方法(将任何Object类型转成实体)
可能存在这样一种情况,Jackson已经满足了大部分的序列化和反序列化工作,但是对于复杂的泛型实体估计未必能如愿的正常反序列,而此时对于一些泛型里面的实体对象就会反序列化成LinkedHashMap类 ...
- linux的history命令设置
history的历史记录,同一个用户的各个会话,读取到的内容也是不一样的,原因是它读取的是shell会话缓存里的内容.只有当用户退出当前会话的时候,会话里的缓存内容才会写入~/.bash_histor ...
- android wifi state and wifi ap state
/** * Wi-Fi is currently being disabled. The state will change to {@link #WIFI_STATE_DISABLED} if * ...
- Lazarus安装使用
Lazarus安装使用 最后还是安装了Lazarus: 安装之后,新建了项目,还引入了Unit,就可以跑了: 学习:http://tieba.baidu.com/p/3164001113 progra ...
- vue2.0 自定义 下拉刷新和上拉加载更多(Scroller) 组件
1.下拉刷新和上拉加载更多组件 Scroller.vue <!-- 下拉刷新 上拉加载更多 组件 --> <template> <div :style="mar ...
- mac os PHP 访问MSSQL
写在前: 项目的数据库是sql server,但是自己的系统是mac os.这样导致了需要一个烦人的系统环境搭建过程.目前要在mac 上的php环境中支持mssql环境访问,经过自己了解,有两种方式: ...
- import caffe时出错:can not find module skimage.io
import caffe时出错:can not find module skimage.io //以下内容在ubuntu16.4上实际验证过.注意大小写的.----20170605 在命令行输入Py ...