从TMessage获取控制句柄的方式 [英] Way of getting control handle from TMessage

查看:115
本文介绍了从TMessage获取控制句柄的方式的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

无论如何,有没有我可以识别仅具有TMessage变量的控件来获取控件句柄或其他信息?问题与Delphi有关.

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.

我正在做的事情是,我用一个函数挂接了多个控件wndproc,我需要找到那是什么控制消息.

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

代码:

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;

这是钩子函数.

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索引...

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

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

推荐答案

不,TMessage只是一个打包的记录,其中包含传递给控件的值.

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

这篇关于从TMessage获取控制句柄的方式的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆