Way of getting control handle from TMessage

Question

Is there anyway to get the control handle or other information with i can indentify a control having only TMessage variable? Question is Delphi related.

the thing im doing is that im hooking several controls wndproc with one function and i need to find what control message is that.

code:

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.

way of "hooking" (needed by virtual treeview)

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;

here is the hooked function.

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;

the second function that needs the FEdit index too...

procedure TPropertyEditLink.ProcessMessage(var Message: TMessage);
begin
  FEdit[0].WindowProc(Message);
end;

Simple answer, no. If you want the `HWND` then you'll have to capture that at the time you capture the message. Of course some messages, e.g. notifications get redirected from parent to child but then that's probably the window you want to know about in any case. What's the underlying problem? — David Heffernan, Jan 06 '12 at 20:58
the thing im doing is that im hooking several controls wndproc with one function and i need to find what control message is that. edited first post... added the code — Knobik, Jan 06 '12 at 21:00
With `WindowProc` hooking you'll need to create a separate instance of a class for each control that you hook. That class can be very small. You just need a reference to the `TPropertyEditLink` instance and a reference to the control that you hooked. — David Heffernan, Jan 06 '12 at 21:13

score 2 · Accepted Answer · answered Jan 06 '12 at 20:58

2

No, a TMessage is just a packed record containing values passed to the control.

answered Jan 06 '12 at 20:58

Mike W

1,276
8
10

.. unless it already contains the control instance inside those values, in wParam/lParam or something accssible from those values. – Martin James Jan 06 '12 at 21:06

Way of getting control handle from TMessage

1 Answers1

Linked