有没有办法获得控制句柄或其他信息，我可以识别只有 TMessage 变量的控件？问题与德尔福有关。
我正在做的事情是，我将几个控件 wndproc 与一个函数挂钩，我需要找到那是什么控制消息。
代码：
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, XML.VerySimple,
Vcl.StdCtrls, Vcl.Samples.Spin;
type
TxmlDataType = ( xdStatic, xdBoolean, xdInteger, xdRange, xdList, xdText, xdTextList, xdScript, xdWayPoint );
TTreeData = record
name: string;
value: string;
dataType: TxmlDataType;
end;
TPropertyEditLink = class(TInterfacedObject, IVTEditLink)
private
FEdit: array[0..7] of TWinControl; // One of the property editor classes.
FEditCount: integer;
FTree: TVirtualStringTree; // A back reference to the tree calling.
FNode: PVirtualNode; // The node being edited.
FColumn: Integer; // The column of the node being edited.
FOldEditProc: array[0..7] of TWndMethod; // Used to capture some important messages
FRect: TRect;
protected
procedure EditWindowProc(var Message: TMessage);
//procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
public
destructor Destroy; override;
function BeginEdit: Boolean; stdcall;
function CancelEdit: Boolean; stdcall;
function EndEdit: Boolean; stdcall;
function GetBounds: TRect; stdcall;
function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;
procedure ProcessMessage(var Message: TMessage); stdcall;
procedure SetBounds(R: TRect); stdcall;
end;
TForm1 = class(TForm)
PropTree: TVirtualStringTree;
procedure FormCreate(Sender: TObject);
procedure PropTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure PropTreeCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; out EditLink: IVTEditLink);
procedure PropTreeEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var Allowed: Boolean);
procedure PropTreeNodeDblClick(Sender: TBaseVirtualTree;
const HitInfo: THitInfo);
private
{ Private declarations }
public
procedure RecursivePropTree( node: PVirtualNode; xmlNode: TXmlNode; first: boolean = false );
end;
var
Form1: TForm1;
settings: TVerySimpleXML;
implementation
{$R *.dfm}
//----------------------------------------------------------------------------------------------------------------------
destructor TPropertyEditLink.Destroy;
var
i: integer;
begin
for i := 0 to FEditCount-1 do
begin
FEdit[i].Free;
end;
inherited;
end;
procedure TPropertyEditLink.EditWindowProc(var Message: TMessage);
begin
case Message.Msg of
WM_KILLFOCUS:
//FTree.EndEditNode;
//else
//FOldEditProc[0](Message);
end;
// HEREE i need to find the FEdit index!!!!!!!
FOldEditProc[0](Message);
end;
function TPropertyEditLink.BeginEdit: Boolean;
var
i: integer;
begin
Result := True;
for i := 0 to FEditCount-1 do
begin
FEdit[i].Show;
FEdit[i].SetFocus;
FOldEditProc[i] := FEdit[i].WindowProc;
FEdit[i].WindowProc := EditWindowProc;
end;
end;
function TPropertyEditLink.CancelEdit: Boolean;
var
i: integer;
begin
Result := True;
for i := 0 to FEditCount-1 do
begin
FEdit[i].WindowProc := FOldEditProc[i];
FEdit[i].Hide;
end;
end;
function TPropertyEditLink.EndEdit: Boolean;
//var
{ Data: PPropertyData;
Buffer: array[0..1024] of Char;
S: WideString;
P: TPoint;
Dummy: Integer;
}
begin {
// Check if the place the user click on yields another node as the one we
// are currently editing. If not then do not stop editing.
GetCursorPos(P);
P := FTree.ScreenToClient(P);
Result := FTree.GetNodeAt(P.X, P.Y, True, Dummy) <> FNode;
if Result then
begin
// restore the edit's window proc
FEdit.WindowProc := FOldEditProc;
Data := FTree.GetNodeData(FNode);
if FEdit is TComboBox then
S := TComboBox(FEdit).Text
else
begin
GetWindowText(FEdit.Handle, Buffer, 1024);
S := Buffer;
end;
if S <> Data.Value then
begin
Data.Value := S;
Data.Changed := True;
FTree.InvalidateNode(FNode);
end;
FEdit.Hide;
end; }
end;
function TPropertyEditLink.GetBounds: TRect;
begin
Result := FEdit[0].BoundsRect;
end;
function TPropertyEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
var
Data: ^TTreeData;
i: integer;
begin
Result := True;
FTree := Tree as TVirtualStringTree;
FNode := Node;
FColumn := Column;
for i := 0 to FEditCount-1 do
begin
FEdit[i].Free;
FEdit[i] := nil;
end;
Data := FTree.GetNodeData(Node);
{FEdit := TEdit.Create(nil);
with FEdit as TEdit do
begin
Visible := False;
Parent := Tree;
Text := Data.Value;
//OnKeyDown := EditKeyDown;
end; }
case Data.dataType of
xdInteger:
begin
FEditCount := 1;
FEdit[0] := TSpinEdit.Create(nil);
with FEdit[0] as TSpinEdit do
begin
AutoSize := false;
Visible := False;
Parent := Tree;
Text := Data.Value;
width := 50;
end;
end;
else
begin
FEditCount := 1;
FEdit[0] := TEdit.Create(nil);
with FEdit[0] as TEdit do
begin
Visible := False;
Parent := Tree;
Text := Data.Value;
//OnKeyDown := EditKeyDown;
end;
end;
end;
{case Data.ValueType of
vtString:
begin
FEdit := TEdit.Create(nil);
with FEdit as TEdit do
begin
Visible := False;
Parent := Tree;
Text := Data.Value;
OnKeyDown := EditKeyDown;
end;
end;
vtPickString:
begin
FEdit := TComboBox.Create(nil);
with FEdit as TComboBox do
begin
Visible := False;
Parent := Tree;
Text := Data.Value;
Items.Add(Text);
Items.Add('Standard');
Items.Add('Additional');
Items.Add('Win32');
OnKeyDown := EditKeyDown;
end;
end;
vtNumber:
begin
FEdit := TMaskEdit.Create(nil);
with FEdit as TMaskEdit do
begin
Visible := False;
Parent := Tree;
EditMask := '9999';
Text := Data.Value;
OnKeyDown := EditKeyDown;
end;
end;
vtPickNumber:
begin
FEdit := TComboBox.Create(nil);
with FEdit as TComboBox do
begin
Visible := False;
Parent := Tree;
Text := Data.Value;
OnKeyDown := EditKeyDown;
end;
end;
vtMemo:
begin
FEdit := TComboBox.Create(nil);
// In reality this should be a drop down memo but this requires
// a special control.
with FEdit as TComboBox do
begin
Visible := False;
Parent := Tree;
Text := Data.Value;
Items.Add(Data.Value);
OnKeyDown := EditKeyDown;
end;
end;
vtDate:
begin
FEdit := TDateTimePicker.Create(nil);
with FEdit as TDateTimePicker do
begin
Visible := False;
Parent := Tree;
CalColors.MonthBackColor := clWindow;
CalColors.TextColor := clBlack;
CalColors.TitleBackColor := clBtnShadow;
CalColors.TitleTextColor := clBlack;
CalColors.TrailingTextColor := clBtnFace;
Date := StrToDate(Data.Value);
OnKeyDown := EditKeyDown;
end;
end;
else
Result := False;
end; }
end;
procedure TPropertyEditLink.ProcessMessage(var Message: TMessage);
begin
FEdit[0].WindowProc(Message);
end;
procedure TPropertyEditLink.SetBounds(R: TRect);
var
Dummy: Integer;
begin
FTree.Header.Columns.GetColumnBounds(FColumn, Dummy, R.Right);
FEdit[0].BoundsRect := R;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TForm1.RecursivePropTree( node: PVirtualNode; xmlNode: TXmlNode; first: boolean = false );
var
xmlChildNode: TXmlNode;
nodeData: ^TTreeData;
i: integer;
typ: Char;
begin
if first then
node := PropTree.AddChild( nil )
else
node := PropTree.AddChild( node );
nodeData := PropTree.GetNodeData( node );
typ := xmlNode.NodeName[1];
nodeData.name := xmlNode.NodeName;
delete( nodeData.name, 1, 1 );
case ord(typ) of
ord('s'): // static
begin
nodeData.dataType := xdStatic;
nodeData.value := '';
end;
ord('b'): // boolean
begin
nodeData.dataType := xdBoolean;
nodeData.value := xmlNode.Text;
end;
ord('i'): // integer
begin
nodeData.dataType := xdInteger;
nodeData.value := xmlNode.Text;
end;
ord('r'): // range
begin
nodeData.dataType := xdRange;
nodeData.value := xmlNode.Text;
end;
ord('l'): // list
begin
nodeData.dataType := xdList;
nodeData.value := '..';
end;
ord('u'): // text list
begin
nodeData.dataType := xdTextList;
nodeData.value := xmlNode.Text;
end;
ord('t'): // text
begin
nodeData.dataType := xdText;
nodeData.value := xmlNode.Text;
end;
ord('w'): // text
begin
nodeData.dataType := xdWayPoint;
nodeData.value := xmlNode.Text;
if length(nodeData.name) = 0 then
nodeData.name := copy( nodeData.value, 1, pos(' ', nodeData.value)-1 );
end;
end;
if xmlNode.ChildNodes.Count > 0 then
begin
for i := 0 to xmlNode.ChildNodes.Count-1 do
begin
xmlChildNode := xmlNode.ChildNodes.Items[i];
RecursivePropTree( node, xmlChildNode );
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
node: PVirtualNode;
nodeData: ^TTreeData;
xmlNode, xmlChildNode: TXmlNode;
xmlNodeList: TXmlNodeList;
begin
settings := TVerySimpleXML.Create;
settings.LoadFromFile('c:\neobot.xml');
PropTree.NodeDataSize := sizeof(TVirtualNode);
RecursivePropTree(node, settings.Root, true);
end;
procedure TForm1.PropTreeCreateEditor(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
begin
EditLink := TPropertyEditLink.Create;
end;
procedure TForm1.PropTreeEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var Allowed: Boolean);
var
Data: ^TTreeData;
begin
with Sender do
begin
Data := GetNodeData(Node);
Allowed := (Node.Parent <> RootNode) and (Column = 1) and not (Data.dataType in [xdStatic]);
end;
end;
procedure TForm1.PropTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
nodeData: ^TTreeData;
begin
nodeData := Sender.GetNodeData(node);
if Column = 0 then
CellText := nodeData.name
else
begin
CellText := nodeData.value;
end;
end;
procedure TForm1.PropTreeNodeDblClick(Sender: TBaseVirtualTree;
const HitInfo: THitInfo);
begin
with Sender do
begin
// Start immediate editing as soon as another node gets focused.
if Assigned(HitInfo.HitNode) and (HitInfo.HitNode.Parent <> RootNode) and not (tsIncrementalSearching in TreeStates) then
begin
// Note: the test whether a node can really be edited is done in the OnEditing event.
EditNode(HitInfo.HitNode, 1);
end;
end;
end;
end.
“挂钩”的方式（虚拟树视图需要）
function TPropertyEditLink.BeginEdit: Boolean;
var
i: integer;
begin
Result := True;
for i := 0 to FEditCount-1 do
begin
FEdit[i].Show;
FEdit[i].SetFocus;
FOldEditProc[i] := FEdit[i].WindowProc;
FEdit[i].WindowProc := EditWindowProc;
end;
end;
这是钩子函数。
procedure TPropertyEditLink.EditWindowProc(var Message: TMessage);
begin
case Message.Msg of
WM_KILLFOCUS:
//FTree.EndEditNode;
//else
//FOldEditProc[0](Message);
end;
// HEREE i need to find the FEdit index!!!!!!!
FOldEditProc[0](Message);
end;
第二个函数也需要 FEdit 索引...
procedure TPropertyEditLink.ProcessMessage(var Message: TMessage);
begin
FEdit[0].WindowProc(Message);
end;