这次真的要请高手来解决了， SubClass 无法拦截 CM_CANCELMODE ??? 真晕！300分！不管能不能解决，解释清楚就给分。 ( 积分: 10

  • 主题发起人 主题发起人 xuxiaohan
  • 开始时间 开始时间
X

xuxiaohan

Unregistered / Unconfirmed
GUEST, unregistred user!
这次真的要请高手来解决了， SubClass 无法拦截 CM_CANCELMODE ??? 真晕！300分！不管能不能解决，解释清楚就给分。 ( 积分: 100 )<br />我的目的是做一个PopWindow， 利用 CM_CANCELMODE 和 WM_KILLFOCUS 隐藏 popWindow.
因为有机会在很多不同的 控件上 下拉这个 popWindow， 所以我用SubClass拦截 popWindow的parent 的消息 CM_CANCELMODE 和 WM_KILLFOCUS ， WM_KILLFOCUS 能够拦截到，CM_CANCELMODE 不能拦截到， why？？？？。
下面是所有代码， 包括一个Form（测试用）。

TPopupWindow = class(TCustomControl)
private
FButton: TWinControl;
FoldBtnProc: TFarProc;
FBtnProc : TFarProc;
procedure btnWndProc(var message: TMessage);
procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
protected
procedure CreateParams(var Params: TCreateParams); override;
function GetValue: Variant; virtual; abstract;
procedure SetValue(const Value: Variant); virtual; abstract;
procedure CloseUp(Accept: Boolean); virtual;
public
constructor Create(AOwner: TComponent); override;
function GetPopupText: string; virtual;
procedure Hide;
procedure Show(Origin: TPoint);
end;
procedure TPopupWindow.btnWndProc(var message: TMessage);
var
s: string;
begin
with message do
begin
s:=inttohex(Msg, 8)+' ';
windows.TextOut(getDC(0), 10, 10, pchar(s), length(s));
case Msg of
[blue] CM_CANCELMODE : hide; // WHY ????[/blue]
WM_KILLFOCUS : hide;//hide;
end;
Result := CallWindowProc(FoldBtnProc, FButton.Handle, Msg, wParam, lParam);
end;
end;

procedure TPopupWindow.CloseUp(Accept: Boolean);
begin

end;

constructor TPopupWindow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FButton := TWinControl(AOwner);
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
csAcceptsControls];
Ctl3D := False;
ParentCtl3D := False;
Visible := False;
Parent := FButton;
width:=160;
height:=160;
FoldBtnProc:=Pointer(GetWindowLong(Fbutton.Handle, GWL_WNDPROC));
FBtnProc:=MakeObjectInstance(btnWndProc);
SetWindowLong(FButton.Handle, GWL_WNDPROC, LongInt(FBtnProc));
end;

procedure TPopupWindow.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do begin
Style := WS_POPUP or WS_BORDER or WS_CLIPCHILDREN;
ExStyle := WS_EX_TOOLWINDOW;
WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
end;
end;

function TPopupWindow.GetPopupText: string;
begin

end;

procedure TPopupWindow.Hide;
begin
SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
Visible := False;
end;

procedure TPopupWindow.Show(Origin: TPoint);
begin
SetWindowPos(Handle, HWND_TOP, Origin.X, Origin.Y, 0, 0,
SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOSIZE);
Visible := True;
end;

procedure TPopupWindow.WMMouseActivate(var Message: TMessage);
begin
Message.Result := MA_NOACTIVATE;
end;

...


unit testFace;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, myControls, srToolButton, StdCtrls, Mask, ToolEdit, ImgList;

type
txButton = class(TButton)
private
FFace: TPopupWindow;
procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
public
procedure click; override;
procedure PopupDropDown(DisableEdit: Boolean); virtual;
constructor create(Aowner: TComponent); override;

end;

TForm1 = class(TForm)
Button1: TButton;
ImageList1: TImageList;
srToolButton2: TsrToolButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
Fbutton: TxButton;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
Fbutton:=TxButton.create(self);
Fbutton.top:=10;
Fbutton.left:=10;
end;

{ txButton }

procedure txButton.click;
begin
inherited;
PopupDropDown(true);
end;
procedure txButton.CMCancelMode(var Message: TCMCancelMode);
begin
inherited;
// FFace.Hide; 这里可以响应;
end;

constructor txButton.create(Aowner: TComponent);
begin
inherited Create(AOwner);
parent:=TWincontrol(AOwner);
FFace:=TpopupWindow.Create(self);
end;

procedure txButton.PopupDropDown(DisableEdit: Boolean);
var
P: TPoint;
Y: Integer;
begin
begin
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
end;
if P.X &amp;lt; 0 then P.X := 0 ;
FFace.Show(Point(P.X, Y));
end;

procedure txButton.WMKillFocus(var Message: TWMKillFocus);
begin
inherited;
// FFace.Hide;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
sendmessage(Fbutton.Handle, CM_CANCELMODE, 0, 0);
end;

end.
 
我的目的是做一个PopWindow， 利用 CM_CANCELMODE 和 WM_KILLFOCUS 隐藏 popWindow.
因为有机会在很多不同的 控件上 下拉这个 popWindow， 所以我用SubClass拦截 popWindow的parent 的消息 CM_CANCELMODE 和 WM_KILLFOCUS ， WM_KILLFOCUS 能够拦截到，CM_CANCELMODE 不能拦截到， why？？？？。
下面是所有代码， 包括一个Form（测试用）。

TPopupWindow = class(TCustomControl)
private
FButton: TWinControl;
FoldBtnProc: TFarProc;
FBtnProc : TFarProc;
procedure btnWndProc(var message: TMessage);
procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
protected
procedure CreateParams(var Params: TCreateParams); override;
function GetValue: Variant; virtual; abstract;
procedure SetValue(const Value: Variant); virtual; abstract;
procedure CloseUp(Accept: Boolean); virtual;
public
constructor Create(AOwner: TComponent); override;
function GetPopupText: string; virtual;
procedure Hide;
procedure Show(Origin: TPoint);
end;
procedure TPopupWindow.btnWndProc(var message: TMessage);
var
s: string;
begin
with message do
begin
s:=inttohex(Msg, 8)+' ';
windows.TextOut(getDC(0), 10, 10, pchar(s), length(s));
case Msg of
[blue] CM_CANCELMODE : hide; // WHY ????[/blue]
WM_KILLFOCUS : hide;//hide;
end;
Result := CallWindowProc(FoldBtnProc, FButton.Handle, Msg, wParam, lParam);
end;
end;

procedure TPopupWindow.CloseUp(Accept: Boolean);
begin

end;

constructor TPopupWindow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FButton := TWinControl(AOwner);
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
csAcceptsControls];
Ctl3D := False;
ParentCtl3D := False;
Visible := False;
Parent := FButton;
width:=160;
height:=160;
FoldBtnProc:=Pointer(GetWindowLong(Fbutton.Handle, GWL_WNDPROC));
FBtnProc:=MakeObjectInstance(btnWndProc);
SetWindowLong(FButton.Handle, GWL_WNDPROC, LongInt(FBtnProc));
end;

procedure TPopupWindow.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do begin
Style := WS_POPUP or WS_BORDER or WS_CLIPCHILDREN;
ExStyle := WS_EX_TOOLWINDOW;
WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
end;
end;

function TPopupWindow.GetPopupText: string;
begin

end;

procedure TPopupWindow.Hide;
begin
SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
Visible := False;
end;

procedure TPopupWindow.Show(Origin: TPoint);
begin
SetWindowPos(Handle, HWND_TOP, Origin.X, Origin.Y, 0, 0,
SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOSIZE);
Visible := True;
end;

procedure TPopupWindow.WMMouseActivate(var Message: TMessage);
begin
Message.Result := MA_NOACTIVATE;
end;

...


unit testFace;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, myControls, srToolButton, StdCtrls, Mask, ToolEdit, ImgList;

type
txButton = class(TButton)
private
FFace: TPopupWindow;
procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
public
procedure click; override;
procedure PopupDropDown(DisableEdit: Boolean); virtual;
constructor create(Aowner: TComponent); override;

end;

TForm1 = class(TForm)
Button1: TButton;
ImageList1: TImageList;
srToolButton2: TsrToolButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
Fbutton: TxButton;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
Fbutton:=TxButton.create(self);
Fbutton.top:=10;
Fbutton.left:=10;
end;

{ txButton }

procedure txButton.click;
begin
inherited;
PopupDropDown(true);
end;
procedure txButton.CMCancelMode(var Message: TCMCancelMode);
begin
inherited;
// FFace.Hide; 这里可以响应;
end;

constructor txButton.create(Aowner: TComponent);
begin
inherited Create(AOwner);
parent:=TWincontrol(AOwner);
FFace:=TpopupWindow.Create(self);
end;

procedure txButton.PopupDropDown(DisableEdit: Boolean);
var
P: TPoint;
Y: Integer;
begin
begin
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
end;
if P.X &amp;lt; 0 then P.X := 0 ;
FFace.Show(Point(P.X, Y));
end;

procedure txButton.WMKillFocus(var Message: TWMKillFocus);
begin
inherited;
// FFace.Hide;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
sendmessage(Fbutton.Handle, CM_CANCELMODE, 0, 0);
end;

end.
 
高手通常晚上才出现，只能等！等！
 
CM_CANCELMODE 不是标准的 windows 消息吧， 看看这个 Hint 窗口是否符合要求 ？ http://www.2ccc.com/article.asp?articleid=1794
 
麻子兄你好，好久不见了
什么原因我想不通， 但是通过
sendmessage(Fbutton.Handle, CM_CANCELMODE, 0, 0);
又可以拦截到， 就的单击popWindow 的 范围外，没有 CM_CANCELMODE 送到
procedure TPopupWindow.btnWndProc(var message: TMessage);
结论是：不是没有拦截到，是没有送到 btnWndProc， 是不是什么地方过滤了？
用下面这个就可以
procedure txButton.CMCancelMode(var Message: TCMCancelMode);
begin
inherited;
// FFace.Hide; 这里可以响应;
end;
真百思不解！



 
CM_CANCELMODE可能是VCL收到某个消息之后刻意产生的吧,另,老大能不能说说具体想作什么. :~)
 
我没时间看，不知是不是这个原因，声明成 TCustomForm

procedure TControl.SendCancelMode(Sender: TControl);
var
Control: TControl;
begin
Control := Self;
while Control &amp;lt;&amp;gt; nil do
begin
if Control is TCustomForm then
^^^^^^^^^^^
TCustomForm(Control).SendCancelMode(Sender);
Control := Control.Parent;
end;
end;
 
看看这个http://www.web-one.org/new-6552876-4938.html
看来得用替换WndMethod的方法。
 
刘麻子：
我是想做个 popWindow， 当鼠标点击popwindow 的 范围外面的Form部分（这时 popWindow 的parent会收到一个CM_CANCELMODE, 但是我不了解这个消息在哪里发送的），popwindow 的 parent 收到 CM_CANCELMODE后， hide popWindow。就这么简单。


这里还有个帖子。
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2959698
 
问题解决，简单到不好意思说， 就是 realLearning, 说对了大半。
 
接受答案了.
 
您必须登录或注册才可回复。

Similar threads

曾
为什么我的的自己做的控件不能获得焦点啊？我快急死了！高手指教啊！（在线给分）(55分)
回复
15
查看
328
曾阿牛
曾
P
谁能帮我把这个TcolorButton程序做一个注解,谢谢!(100分)
回复
3
查看
254
wr960204
W
S
思考半年都未解决的问题(奉献全部积分)(200分)
2
回复
30
查看
440
scLizongliang
S
陈
给shape控件加上运行时改变大小的特性（帮忙找找错误谢谢）。(100分)
回复
13
查看
241
Another_eYes
A
J
请问下列控件的下拉框（Grid）为什么不能获得焦点？请各位帮忙！！这是我所有的分数了！！(49分)
回复
6
查看
305
jack.shi
J
后退
顶部