[原创]在Delphi7中实现What is this?! ( 积分: 5 )

[原创]在Delphi7中实现What is this?!
Windwos下的通用对话框，如查找，替换，字体选择等等对话框都有一个共同特点：在屏幕的右上角有一个“问号”按钮，当点击这个“问号”时，当前鼠标变为一个?号，用这个?号点击对话框上的控件时，会出现一个带阴影的提示框，显示提示性的文字。
这就是“这是什么？”功能。英文叫"What is this?"功能。
原理：当用?号点击对话框上的控件时,被点击的控件产生WM_HELP消息，Delphi自动检查窗体的helpFile和helpcontext属性，如果都设置了，就显示相应的hlp帮助文件（这个要自己制作）。这种方法在d6以下都可行，可是在Delphi7中，就不灵了。。。
目前，在D7中的解决办法是用EC控件，使用时需在窗体上放置一夽控件中的三个控件，然后设置相应的属性。这种方法的优点是可完成的功能比较强大。
不过，我对上述方法比较烦感的地方是：一个对话框才有多大，为了解决这个What is this问题，就要放上三个控件才能解决问题。而且上述方法要改变用户在Delphi中制作What is this的使用习惯！
对于上述问题，我的解决方法是自己做了一个TWhat组件，只要将这个组件拖放到窗体上，就可以保证弹出标准的Windows提示框！

TWhat源代码：

Unit What;

Interface

Uses
SysUtils, Classes, windows, controls, messages, Forms, Dialogs;

Type
TWhat = Class(TComponent)
Private
OldWindowProc: TWndMethod;
FHelpFile: String;
Protected
{ Protected declarations }
Public
Constructor Create(AOwner: TComponent); Override;
Published
Procedure NewWindowProc(Var message: Tmessage);
Property HelpFile: String Read FHelpFile Write FHelpFile; //这有特殊的用途
End;

Procedure Register;

Implementation

Procedure Register;
Begin
RegisterComponents('GenCheng', [TWhat]);
End;

{ TWhat }

Constructor TWhat.Create(AOwner: TComponent);
Var
Fform: TForm;
Begin
Inherited Create(AOwner);
If Not (csDesigning In ComponentState) Then //设计期不执行
If AOwner Is TForm Then
Begin
Fform := TForm(AOwner);
OldWindowProc := Fform.WindowProc;
Fform.WindowProc := NewWindowProc;
FHelpFile := Fform.HelpFile;
End
Else
showmessage('"AOwner" should be a "Tform"!');
End;

Procedure TWhat.NewWindowProc(Var message: Tmessage);
Var
Control: TWinControl;
myrect: Trect; //存放控件坐标
Begin
If message.Msg = WM_HELP Then
Begin
Control := FindControl(TWMHelp(message).HelpInfo.hItemHandle);
Getwindowrect(Control.Handle, myrect); //取得控件在屏幕的坐标
If assigned(Control) And (Control Is TWinControl) Then
Begin
windows.WinHelp(TWinControl(Control).Handle, PAnsiChar(HelpFile), HELP_SETPOPUP_POS, MakeLong((myrect.Left + myrect.Right) Div 2, (myrect.Top + myrect.Bottom) Div 2)); //设置弹出帮助窗口的坐标为控件中央
windows.WinHelp(TWinControl(Control).Handle, PAnsiChar(HelpFile), HELP_CONTEXTPOPUP, Control.HelpContext); //弹出帮助窗口
End;
End
Else
OldWindowProc(message);
End;

End.

FindControl得到的就是TWinControl
所以TWinControl(Control) 和 Control is TWinControl似乎是多余的

如果FindControl没找到Control，即Control = nil，那么GetWindowRect就会出错
Control.ClientOrigin就可以得到Control的左上角屏幕坐标
Windows.WinHelp(Control.Handle, PChar(FHelpFile), HELP_SETPOPUP_POS, Longint(PointToSmallPoint(Control.ClientOrigin)));

TCustomForm好象用的是Form的Handle，如果Form没有或不可用，则用Application.Handle
我试了一下用Control.Handle也行，不知道有什么区别

另，是否要判断一下 TWMHelp(Message).HelpInfo.iContextType 是HELPINFO_WINDOW还是HELPINFO_MENUITEM

还有，是否加入OnHelp事件，或者直接加入Form或Application的OnHelp事件

高手!
我再修改一下，把代码写的好一些。
要做好一个好的组件，确实要反复仔细的修改。谢谢你花时间为我指点!

unit What;

interface

uses
SysUtils, Classes, windows, controls, messages, Forms, Dialogs;

type
TWhat = class(TComponent)
private
OldWindowProc: TWndMethod;
FHelpFile: string;
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
published
procedure NewWindowProc(var message: Tmessage);
property HelpFile: string read FHelpFile write FHelpFile; //这有特殊的用途
end;

procedure Register;

implementation
{$R *.dcr}

procedure Register;
begin
RegisterComponents('GenCheng', [TWhat]);
end;

{ TWhat }

constructor TWhat.Create(AOwner: TComponent);
var
Fform: TForm;
begin
inherited Create(AOwner);
if not (csDesigning in ComponentState) then //设计期不执行
if AOwner is TForm then
begin
Fform := TForm(AOwner);
OldWindowProc := Fform.WindowProc;
Fform.WindowProc := NewWindowProc;
FHelpFile := Fform.HelpFile;
end
else
showmessage('"AOwner" should be a "Tform"!');
end;

procedure TWhat.NewWindowProc(var message: Tmessage);
var
Control: TWinControl;
begin
if message.Msg = WM_HELP then
begin
Control := FindControl(TWMHelp(message).HelpInfo.hItemHandle); //FindControl得到的就是TWinControl
if assigned(Control) then
begin
Windows.WinHelp(Control.Handle, PChar(HelpFile), HELP_SETPOPUP_POS, Longint(PointToSmallPoint(Control.ClientOrigin)));
windows.WinHelp(Control.Handle, PAnsiChar(HelpFile), HELP_CONTEXTPOPUP, Control.HelpContext); //弹出帮助窗口
end
end
else
OldWindowProc(message);
end;

end.


另：还可以增加Onhelp事件,以实现更强大的功能!

http://www.51zhan.com 最好的网址站
http://www.51zhan.com 最好的网址站
http://www.51zhan.com 最好的网址站

接受答案了.