句柄问题(200分)

如何编一个 有句柄的 Label
本人研究到原子函数
但是不成功
是否有人会 就是给不是从 Wincontrol 继承下来的 写一个handle

用CreateWindow API自己Create一个Window
你自己把这个Handle与你的Label联系起来

不是有现成的嘛：TStaticText

我要的是 不是从 Wincontrol 继承下来的控件
要一个handle
CreateWindow 是建了一个窗口 但怎么和 label关联呢

up

uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls,Dialogs;
var
WindowAtom: TAtom;
ControlAtom: TAtom;
type
TCreateParams = record
Caption: PChar;
Style: DWORD;
ExStyle: DWORD;
X, Y: Integer;
Width, Height: Integer;
WndParent: HWnd;
Param: Pointer;
WindowClass: TWndClass;
WinClassName: array[0..63] of Char;
end ;
type
ThandleLabel1 = class(TLabel)
private
FHandle: HWnd;
{ Private declarations }
protected
procedure CreateParams(var Params: TCreateParams); virtual;
procedure CreateWindowHandle(const Params: TCreateParams); virtual;
function GetHandle: HWnd;
procedure CreateHandle; virtual;
procedure AddBiDiModeExStyle(var ExStyle: DWORD);
procedure CreateWnd; virtual;
procedure TWMMOUSEMove (var msg :TWMMOUSEMove);message WM_MOUSEMOVE ;
{ Protected declarations }
public
property Handle: HWnd read GetHandle;
{ Public declarations }
published
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Additional', [ThandleLabel1]);
end;

{ ThandleLabel1 }

procedure ThandleLabel1.AddBiDiModeExStyle(var ExStyle: DWORD);
begin
if UseRightToLeftReading then
ExStyle := ExStyle or WS_EX_RTLREADING;
if UseRightToLeftScrollbar then
ExStyle := ExStyle or WS_EX_LEFTSCROLLBAR;
if UseRightToLeftAlignment then
if GetControlsAlignment = taLeftJustify then
ExStyle := ExStyle or WS_EX_RIGHT
else if GetControlsAlignment = taRightJustify then
ExStyle := ExStyle or WS_EX_LEFT;
end;

procedure ThandleLabel1.CreateHandle;
begin
if FHandle = 0 then
begin
SetProp(FHandle, MakeIntAtom(ControlAtom), THandle(Self));
SetProp(FHandle, MakeIntAtom(WindowAtom), THandle(Self));

end;
end;

procedure ThandleLabel1.CreateParams(var Params: TCreateParams);
begin
FillChar(Params, SizeOf(Params), 0);
with Params do
begin
Caption := Pchar(self.Caption);
Style := WS_CHILD or WS_CLIPSIBLINGS;
AddBiDiModeExStyle(ExStyle);
Style := Style or WS_CLIPCHILDREN;
ExStyle := ExStyle or WS_EX_CONTROLPARENT;
if not (csDesigning in ComponentState) and not Enabled then
Style := Style or WS_DISABLED;

X := self.Left ;
Y := self.Top ;
Width := self.Width ;
Height := self.Height;
WndParent := self.Parent.Handle ;
WindowClass.style := CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS;
WindowClass.lpfnWndProc := @DefWindowProc;
WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
WindowClass.hbrBackground := 0;
WindowClass.hInstance := HInstance;
StrPCopy(WinClassName, ClassName);
end;
end;
procedure ThandleLabel1.CreateWindowHandle(const Params: TCreateParams);
begin
FHandle := CreateWindowEx(Params.ExStyle, Params.WinClassName, Params.Caption, Params.Style,
Params.X,Params.Y, Params.Width, Params.Height, Params.WndParent, 0, Params.WindowClass.hInstance, Params.Param);
end;

procedure ThandleLabel1.CreateWnd;
var
Params: TCreateParams;
begin
CreateParams(Params);
CreateWindowHandle(Params);
if FHandle = 0 then showmessage('aaa');
end;

function ThandleLabel1.GetHandle: HWnd;
begin
if FHandle = 0 then
begin
if Parent <> nil then Parent.HandleNeeded;
CreateHandle;
end ;
Result := FHandle;
end;

procedure ThandleLabel1.TWMMOUSEMove(var msg: TWMMOUSEMove);
begin
self.CreateWnd ;
end;
为什么handle值总为零

把CreateWindow API创建的window 作为 Label的Owner处理

靠，没那么复杂吧？你是要在其中加入一些自定义消息的处理吗？
如下是框架代码，试试看，是不是和你想要的：）
代码在win2k+delphi6上通过。
---------------------------------------------
unit ghhLabel;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls;

type
TghhLabel = class(TLabel)
private
{ Private declarations }
FHandle: HWnd; //<<< 句柄
protected
{ Protected declarations }
function GetHandle: HWnd;
WndProc(var Message: TMessage);override
public
{ Public declarations }
property Handle: HWnd read GetHandle;
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
published
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TghhLabel]);
end;

constructor TghhLabel.Create(AOwner: TComponent);

begin
inherited Create(AOwner);
FHandle := AllocateHWnd(WndProc);//<<<建立句柄
end;

procedure TghhLabel.WndProc(var Message: TMessage);
begin
with Message do
case Msg of
//处理你的自定义消息
end;
inherited WndProc(Message);
end;


function TghhLabel.GetHandle: HWnd;
begin
Result := FHandle;
end;

destructor TghhLabel.Destroy;
begin
DeallocateHWnd(FHandle);//<<< 释放句柄
inherited Destroy;
end;

end.

原来有这个函数呀 还得我白研究了原子函数
银子给你了 gonghh

多人接受答案了。

这还要搞半天？
AllocateHWnd不还是用API CreateWindowEx创建了一个Window吗？
FAINT！

function AllocateHWnd(Method: TWndMethod): HWND;
var
TempClass: TWndClass;
ClassRegistered: Boolean;
begin
UtilWindowClass.hInstance := HInstance;
{$IFDEF PIC}
UtilWindowClass.lpfnWndProc := @DefWindowProc;
{$ENDIF}
ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName,
TempClass);
if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
begin
if ClassRegistered then
Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
Windows.RegisterClass(UtilWindowClass);
end;
Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName,
'', WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
if Assigned(Method) then
SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));
end;

来晚了