帮顶有分。制作组合控件，捕获事件的难题。

参考TLabeledEdit控件，我写了一个 TControl+TcxDBTreeList(类似树枝型的DBGrid），这样一个组合控件。
目的是，通过TControl控件点一下鼠标后，后者能下拉显示出来……基本类似TComboBox的下拉效果。
基本都ok了，唯独TControl.OnMouseDown事件的赋值不是在设定属性的时候，而是在调试界面上代码给的。
我尝试了GetWindowLong来截获消息。是TWinControl的时候是可以的。如果是TLabel之类的图形控件的时候，就没有Handle可抓。
我只是想捕获TControl的WM_LBUTTONDOWN，有什么办法吗？
以下贴出，主要结构代码。

18 个解决方案

#1

 TCustomDuoDBTreeList = class(TcxCustomDBTreeList)
  private
    FDropListControl: TControl;
    FOldProc:TFarProc;
    procedure SetDropListControl(const Value: TControl);
  protected
    procedure DropListProc(var Msg: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property DropListControl:TControl read FDropListControl write SetDropListControl;
  end;


procedure TCustomDuoDBTreeList.SetDropListControl(const Value: TControl);
var pp:TPoint;f:TCustomForm;//p:Pointer;
begin
  FDropListControl := Value;
//    FOldProc:=Pointer(FDropListControl.WindowProc);
//    FDropListControl.WindowProc:=DropListProc;
//      if FDropListControl is TWinControl then
//      begin
//        FOldProc:=Pointer(GetWindowLong((FDropListControl as TWinControl).Handle,GWL_WNDPROC));
//        p:=MakeObjectInstance(DropListProc);
//        SetWindowLong((FDropListControl as TWinControl).Handle,GWL_WNDPROC,LongInt(p));
//      end;
end;

procedure TCustomDuoDBTreeList.DropListProc(var Msg: TMessage);
begin
  case Msg.Msg of
    WM_LBUTTONDOWN:ShowMessage('鼠标按下');
  else
    Msg.Result:=DefWindowProc((FDropListControl as TWinControl).Handle,Msg.Msg,Msg.WParam,Msg.LParam);// 其它消息做默认处理
  end;
end;

#2

tcontrol  没有 handle  可以自己构造一个！ create的时候分配一个handle， destroy 时候销毁， 并修改一下winproc


    private
      F_Handle:integer;

      Procedure WriteSqlLog(const Str:String);


  f_Handle:=classes.AllocateHWnd(wndProc);
    classes.DeallocateHWnd(F_Handle);


procedure TSqlFuns.WndProc(var Msg: TMessage);
begin
  if Msg.Msg = MSG_RECV_DATA then //转发消息到调用窗口
  begin
.......
  end
  else
    DefWindowProc(F_Handle, Msg.Msg, Msg.wParam, Msg.lParam);
end;

#3

Mark

学习

#4

捕获TControl的WM_LBUTTONDOWN 是可以截下来的，是不是你的父窗口把那消息给截了，没有派发？
我早几天也碰到这问题，不过我的是把控件拉到非客户区去了，结果 CM_MOUSELEAVE类消息可以响应， WM_LBUTTONDOWN类的消息响应不到。

#5

象二楼说的，创建个句柄应该就可以响应那消息了

#6

我的意思是TControl可以是TLabel，TImage之类。
鼠标按一下它们，我就ShowList。
请注意一下结构。
TCustomDuoDBTreeList = class(TcxCustomDBTreeList)
  private
    FDropListControl: TControl;

我要的是FDropListControl的消息，而不是TCustomDuoDBTreeList的消息。

也可能是我理解错了。
请多一点指示。
愿意加分。

#7

你得检查 FDropListControl的PARENT是否处理了这个消息，他本身是可以触发的

#8

引用 2 楼 jason_28693 的回复:

tcontrol  没有 handle  可以自己构造一个！ create的时候分配一个handle， destroy 时候销毁， 并修改一下winproc 


    private 
      F_Handle:integer; 

      Procedure WriteSqlLog(const Str:String); 


  f_Handle:=classes.AllocateHWnd(wndProc); 
    classes.DeallocateHWnd(F_Handle); 


procedure TSqlFuns.WndProc(var Msg: TMessage); 
begin 
  if Msg.Msg = MSG_RECV_DATA then //转发消息…

支持

#9

引用 7 楼 sanguomi 的回复:

你得检查 FDropListControl的PARENT是否处理了这个消息，他本身是可以触发的

我查到的先是 WM_PARENTNOTIFY
然后是 TWMParentNotify
仔细研究一下，估计就有戏了。
待解决后赠分。

#10

对于TGraphicControl，可以拦截父控件的消息，然后判断鼠标位置是否在该控件上。

#11

共同学习
帮你顶

#12

找不到OnMouseDown的话可能是因为你没有在published区段中声明这个事件。
用GetWindowLong截获消息是不是舍近求远了？你直接重载TControl的Click方法不就行了？

#13

在帮顶,老哥,你的IBM买了没?

#14

顶上先,有等详研究

#15

帮你顶了。

#16

TControl有自己的消息的都以CM开头
至于，你说的那个可以直接转换一下应该
自己定义一个OnMouseDown事件，用来覆盖原来的事件就可以了

property OnMouseDown: TMouseEvent read GetOnMouseDown write SetOnMouseDown;

procedure GetOnMouseDown;
begin
  result := Label.OnMouseDown;
end;

procedure SetOnMouseDown(DownEvent: TMouseEvent);
begin
  Label.OnMouseDown : DownEvent;
end;

#17

    FTargetWCtrl:TWinControl;
    FTargetHWND:HWND;//保存DropDown的Handle
    FTargetProc:TFarProc;//保存DropDown的原有WndProc
//Assign控件的时候
    if not (csSubComponent in FDropListControl.ComponentStyle) then
    begin
      if FDropListControl is TWinControl then
        FTargetWCtrl:=(FDropListControl as TWinControl)
      else
        FTargetWCtrl:=FDropListControl.Parent;
      FTargetHWND:=FTargetWCtrl.Handle;
      FTargetProc:=Pointer(GetWindowLong(FTargetHWND,GWL_WNDPROC));
      {$WARN SYMBOL_DEPRECATED OFF}
      p:=MakeObjectInstance(DropListProc);
      {$WARN SYMBOL_DEPRECATED ON}
      SetWindowLong(FTargetHWND,GWL_WNDPROC,LongInt(p));
    end;
//点击目标控件，使我的TreeList下拉
procedure TCustomDuoDBTreeList.DropListProc(var Msg: TMessage);
  function IsControlMouseMsg(var Message: TWMMouse): Boolean;
  var Control:TControl;P:TPoint;
  begin
    Control:=FTargetWCtrl.ControlAtPos(SmallPointToPoint(Message.Pos), False);
    Result := False;
    if Control <> nil then
    begin
      P.X := Message.XPos - Control.Left;
      P.Y := Message.YPos - Control.Top;
      Message.Result := Control.Perform(Message.Msg, Message.Keys, Longint(PointToSmallPoint(P)));
      Result := True;
    end;
  end;
begin
  Msg.Result:=CallWindowProc(FTargetProc,FTargetHWND,Msg.Msg,Msg.WParam,Msg.LParam);
  case Msg.Msg of
    WM_LBUTTONDOWN:begin
      if IsControlMouseMsg(TWMMouse(Msg)) then
        self.DoDropDown
      else if FDropListControl=FTargetWCtrl then
        self.DoDropDown;
    end;
  end;
end;

destructor TCustomDuoDBTreeList.Destroy;
begin
  if Assigned(FTargetProc) then SetWindowLong(FTargetHWND,GWL_WNDPROC,LongInt(FTargetProc));
  inherited;
end;
//这里稍微说明一下，我有可能设置Button（TWinControl），也有可能设置成Label(TControl）
//前者的消息很好理解，而后者，其实消息是在它的Parent上的。所以，FTargetHWND是Parent.Handle
//只要截获到了消息，想干嘛就干嘛。
//谢谢各位D友。我的多选树枝，和多选下拉树枝同时完成了。

#18

引用 13 楼 dinoalex 的回复:

在帮顶,老哥,你的IBM买了没?

T400 A82，正在用莱。
总体还好，就是有时候键盘会丢失。
呵呵，我还是只懂软件皮毛，硬件一窍不通呐。