从TMessage获取控制句柄的方法

时间：2012-01-06 20:55:38

标签： delphi handle wndproc

无论如何获得控制句柄或其他信息我可以识别只有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;

1 个答案:

答案 0 :(得分：2)

不，TMessage只是一个打包记录，其中包含通过传递给控件的值。

相关问题
最新问题