2012-01-06 51 views
1

有沒有辦法獲得控制句柄或其他信息,我可以識別只有TMessage變量的控件?問題是德爾福相關。從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; 
+0

簡單的答案,沒有。如果你想要'HWND',那麼你必須在捕獲消息時捕獲它。當然,一些消息,例如通知會從父母轉到孩子,但這可能是您想要了解的任何情況。根本問題是什麼? – 2012-01-06 20:58:27

+0

im正在做的事情是,我用一個函數鉤住幾個控件wndproc,我需要找到那個控制信息。編輯的第一篇文章...添加了代碼 – Knobik 2012-01-06 21:00:48

+0

你是怎麼掛鉤的? – 2012-01-06 21:06:25

回答

2

不,TMessage只是包含傳遞控制填充記錄。

+0

..除非它已經包含在這些值內的控制實例,在wParam/lParam或從這些值可以解釋的東西。 – 2012-01-06 21:06:01

+0

不,它不。 – Knobik 2012-01-06 21:07:07