如何给自己开发的控件（直接继承TComponent）增加Handle属性？？？或者是让控件可以接收消息。

Question

如何给自己开发的控件（直接继承TComponent）增加Handle属性？？？或者是让控件可以接收消息。

Answer 1

TMsgObject = Class;
  TMsgProcedure = Procedure(Sender : TMsgObject; var Msg : TMessage) of object;
  TMsgObject = Class(TComponent)
  private
    fHandle  : THandle;
    fMsgProc : TMsgProcedure;
  public
    constructor Create(AOwner : TComponent); override;
    destructor  Destroy; override;
    property    Handle : THandle read fHandle;
  published
    property OnMsg : TMsgProcedure read fMsgProc write fMsgProc;
  end;
{TMsgObject}
function TMsgObjectMProc(ahWnd   : HWND;auMsg   : Integer;awParam : WPARAM; alParam : LPARAM): Integer; stdcall;
var
  Obj    : TMsgObject;
  MsgRec : TMessage;
begin
  Obj := TMsgObject(GetWindowLong(ahWnd, 0));
  if not Assigned(Obj) then
    Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
  else begin
    MsgRec.Msg    := auMsg;
    MsgRec.wParam := awParam;
    MsgRec.lParam := alParam;
    if Assigned(OBJ.fMsgProc) then
      OBJ.fMsgProc(OBJ,MsgRec);
    Result := MsgRec.Result;
  end;
end;var
  TMsgObjectClass : TWndClass = (
    style         : 0;
    lpfnWndProc   : @TMsgObjectMProc;
    cbClsExtra    : 0;
    cbWndExtra    : SizeOf(Pointer);
    hInstance     : 0;
    hIcon         : 0;
    hCursor       : 0;
    hbrBackground : 0;
    lpszMenuName  : nil;
    lpszClassName : 'TMsgObject');function TMsgObjectAllocateHWnd(Obj : TObject): HWND;
var
  TempClass       : TWndClass;
  ClassRegistered : Boolean;
begin
  TMsgObjectClass.hInstance := HInstance;
  ClassRegistered := GetClassInfo(HInstance,
                                  TMsgObjectClass.lpszClassName,
                                  TempClass);
  if not ClassRegistered then begin
     Result := Windows.RegisterClass(TMsgObjectClass);
     if Result = 0 then
         Exit;
  end;  Result := CreateWindowEx(WS_EX_TOOLWINDOW,
                         TMsgObjectClass.lpszClassName,
                         '',0,0,0,0,0,0,0,HInstance,nil);
  if (Result <> 0) and Assigned(Obj) then
    SetWindowLong(Result, 0, Integer(Obj));
end;constructor TMsgObject.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  fHandle := TMsgObjectAllocateHWnd(Self);
end;destructor TMsgObject.Destroy;
begin
  DestroyWindow(fHandle);
  inherited Destroy;
end;

Answer 2

你需要定义一个消息接收窗口，提供一个消息处理过程
eg:TSupperLED = class(TComponent)
  private
  FWindowHandle: HWND;                 //非可见的消息接收窗口//Create the Component........
 FWindowHandle := AllocateHWnd(WndProc);//process the message...
procedure TSupperLED.WndProc(var Msg: TMessage);
begin
    with Msg do
    if (Msg = CM_MARQUEE) AND (WParam = FWindowHandle) AND (LParam = FTimeID) then
      try
        MarqueeTimer(nil);                  //走马灯步进
      except
        Application.HandleException(Self);
      end
    else
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;