Hi,
Das ist jetzt meine Ober-Frage zu dem Thema. Ich stell hier in letzter Zeit ungefähr 10
nonVCL Fragen am Tag. Jetzt komm ich ma konkret zum Punkt weil ich langsam die Schn.... voll hab.
Also wie ihr vielleicht schon mitbekommen hab versuche ich sowas wie ne kleine eigene
VCL zu bauen.
Dazu hab ich eine Basis-Klasse TNVCLControl. Es geht jetzt hauptsächlich um die Form (TNVCLForm).
Delphi-Quellcode:
// Die vorläufige TNVCLForm
TNVCLForm = class(TNVCLControl)
private
wc: TWndClassEx;
FList: TControlList;
FCanClose: Boolean;
FCaption: String;
FOnCreate: TCreateEvent;
FOnDestroy: TNotifyEvent;
FOnClose: TNotifyEvent;
FOnCloseQuery: TCloseQueryEvent;
FTButtons: TTitleButtons;
FSizeable: Boolean;
FIcon: HICON;
procedure SetCaption(const Value: String);
procedure SetTButtons(const Value: TTitleButtons);
procedure SetSizeable(const Value: Boolean);
procedure SetIcon(const Value: HICON);
protected
procedure WndProc(var Message: TMessage);
public
constructor Create(AParent: TNVCLControl); override;
procedure Close;
property Caption: String read FCaption write SetCaption;
property TitleButtons: TTitleButtons read FTButtons write SetTButtons;
property Sizeable: Boolean read FSizeable write SetSizeable;
property Icon: HICON read FIcon write SetIcon;
property Controls: TControlList read FList;
destructor Destroy; override;
property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;
property OnClose: TNotifyEvent read FOnClose write FOnClose;
property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
property OnCreate: TCreateEvent read FOnCreate write FOnCreate;
end;
Was jetzt wichtig ist, ist der constructor und der/die/das WndProc:
Delphi-Quellcode:
constructor TNVCLForm.Create(AParent: TNVCLControl);
var _Create: TMethod;
l: Integer;
resStr: String;
a: WNDCLASS;
begin
inherited Create(AParent);
FList := TControlList.Create;
// Standard Werte setzen
FLeft := 50;
FTop := 50;
FHeight := 540;
FWidth := 780;
FSizeable := true;
FTButtons := [tbClose, tbMinimize, tbMaximize];
// OnCreate zuweise
SetLength(resStr,High(Byte));
l := LoadString(hInstance,0,@resStr[1],High(Byte));
SetLength(resStr,l);
LoadString(hInstance,0,@resStr[1],l+1);
_Create.Code := MethodAddress(resStr);
_Create.Data := Self;
FOnCreate := TCreateEvent(_Create);
// Neue Fensterklasse registrieren
with wc do
begin
cbSize := SizeOf(TWndClassEx);
lpfnWndProc := @WndProcDispatch;
hInstance := SysInit.hInstance;
hbrBackground := GetSysColorBrush(COLOR_BTNFACE);
lpszClassName := Pchar('Form' + IntToStr(frmCount));
hIcon := LoadIcon(0,IDI_APPLICATION);
cbWndExtra := 4;
hIconSm := hIcon;
end;
inc(frmCount);
RegisterClassEx(wc);
// Fenster erstellen
FHandle := CreateWindowEx(0,wc.lpszClassName,wc.lpszClassName,
{WS_VISIBLE or }WS_CAPTION or WS_SYSMENU or WS_SIZEBOX or WS_MAXIMIZEBOX or WS_MINIMIZEBOX,
FLeft,FTop,FWidth,FHeight,HWND_DESKTOP,FID,hInstance,nil);
SetWindowLong(FHandle,GWL_USERDATA,Integer(Self)); // Self an das Fenster hängen
SendMessage(FHandle,WM_CREATE,0,0); // nachträglich aufs OnCreate reagieren weil ich das eigentliche durch den Dispatcher nicht mitbekomme.
ShowWindow(FHandle,SW_SHOW); // Erst jetzt das Fenster zeigen.
end;
Dann kommen wir jetzt zu dem WndProc gedöns.
Delphi-Quellcode:
function WndProcDispatch(wnd: HWND; Msg: UINT; lp: LPARAM; wp: WPARAM): LResult; stdcall;
var Self: TNVCLForm;
m: TMessage;
begin
Integer(Self) := GetWindowLong(wnd,GWL_USERDATA); // Self bekommen
if Self <> nil then
begin
m.Msg := Msg;
m.WParam := wp;
m.LParam := lp;
m.Result := 0;
Self.WndProc(m); // WndProc des aufrufenden Fensters starten
if m.Result = -1 then // <---- 1)
Result := DefWindowProc(wnd,Msg,lp,wp)
else
Result := m.Result;
end
else
Result := DefWindowProc(wnd,Msg,lp,wp);
end;
Delphi-Quellcode:
procedure TNVCLForm.WndProc(var Message: TMessage);
var x: Pointer;
ps: TPaintStruct;
i: Integer;
begin
Message.Result := 0;
case Message.Msg of
WM_LBUTTONUP: begin
if Assigned(FOnClick) then
FOnClick(Self);
SetFocus(0);
end;
WM_COMMAND: begin
if hiWord(Message.WParam) = BN_CLICKED then // <--- 2)
begin
x := FList.Find(Message.WParamLo);
if Assigned(TNVCLControl(x)) then
begin
if Assigned(TNVCLControl(x).OnClick) then
TNVCLControl(x).OnClick(TNVCLControl(x));
end;
end;
end;
WM_CREATE: begin
if Assigned(FOnCreate) then
FOnCreate(Self);
end;
WM_CLOSE: begin
FCanClose := true;
if Assigned(FOnCloseQuery) then
FOnCloseQuery(Self,FCanClose);
if FCanClose then
begin
if Assigned(FOnClose) then
FOnClose(Self);
Message.Result := -1; // <--- 1)
end
else
Message.Result := Integer(FCanClose)
end;
WM_PAINT : begin
BeginPaint(FHandle,ps);
for i := 0 to FList.Count - 1 do
TNVCLControl(FList[i]).DoPaint;
EndPaint(FHandle,ps);
Message.Result := -1; // <--- 1)
end;
WM_DESTROY: begin
if Assigned(FOnDestroy) then
FOnDestroy(Self);
for i := FList.Count - 1 downto 0 do
TNVCLControl(FList[i]).Free;
PostQuitMessage(0);
end;
else Message.Result := DefWindowProc(FHandle, Message.Msg, Message.WParam, Message.LParam);
end;
end;
so ich habe Stellen mit 1) und 2) im Code markiert die ich erklären will.
1) Wenn ich im WndProc der Klasse DefWindowProc aufrufe (außer beim dem else
) dann stürzt das Programm mit einem Runtime-Error ab. Keine Ahnung wieso. Deswegen setze ich Result nur auf -1 und rufe dann im Dispatcher wieder DefWindowProc auf.
2) Seltsamerweise bekomme ich wenn ich auf nen Button klicke die WM_COMMAND Message aber mit total falschen Parametern, sodass letztendlich doch nichts passiert. Das verstehe ich nicht.
Man muss dazu sagen das ich zuvor ein WndProc benutzt habe das ich mithilfe von Luckies (?) MakeProcInstance(m: TMethod) in einen normalen Funktionszeiger umgewandelt habe und der Fensterklasse übergeben habe. Jetzt habe ich auf diesen Dispatcher umgestellt weils meiner Meinung einfach eleganter ist. Früher lief aber alles ohne Probleme. Jetzt funktioniert zumindest die WM_COMMAND Message nicht mehr.
Das letzte Problem was ich aber auch schon früher hatte, ist das ich keine zwei Forms erstellen kann. Die zweite Form wird einfach nicht erstellt. CreateWindowEx liefert als
Handle eine 0. Ich dachte zuerst es läge an dem WndProc und auch deshalb hab ich auf den Dispatcher umgestellt aber es läuft so oder so nicht
Wenn im Verlaufe dieses Threads Antworten auf alle diese Probleme gefunden werden könnten wäre ich euch ewig dankbar
Gruß
Neutral General