Witam,
Ostatnio interesuje się WinAPI, tak jak w przypadku exe jakoś mi to wychodziło to w DLL nie potrafię utworzyć czystej formy. Znalazłem jakieś przykłady na grupach dyskusyjnych, ale CreateWindow nic nie robi. To kod (pisany na szybkiego dla testów):
library Test;
uses
Windows,
Messages;
const
DLLTestMsgStr: PChar = 'DLL Test Message';
MAIN_FORM_CLASS = 'TMainForm';
MAIN_FORM_WIDTH = 395;
MAIN_FORM_HEIGHT = 500;
ZERO = 0;
JEDEN = 1;
EMPTSTR='';
var
Msg: TMsg;
DLLTestMsg: UINT;
MainFormClass: TWndClass;
MainForm: HWND;
{$R *.res}
function DLLWindowProc(Hndl: HWnd; Msg: UINT; wParam: WPARAM;
lParam: LPARAM): LRESULT; {$ifdef Win32} stdcall {$else}
export {$endif};
begin
{ Look for and handle any custom messages posted or sent to the DLL
window }
if (Msg = DLLTestMsg) then
begin
MessageBeep($ffff);
Result := 0;
end
else
begin
{ Call the default window procedure for all non-custom
messages }
Result := DefWindowProc(Hndl, Msg, wParam, lParam);
end; { end if }
end;
function ClassRegistered: Boolean;
begin
Result := GetClassInfo(HInstance, MAIN_FORM_CLASS, MainFormClass);
end;
function RegisterDLLWindow: Boolean;
begin
if ClassRegistered then
begin
Result := True;
Exit;
end;
(* with MainFormClass do
begin
style := CS_NOCLOSE; { Class style }
lpfnWndProc := @DLLWindowProc; { Pointer to window
procedure }
cbClsExtra := 0; { Additional class
params }
cbWndExtra := 0; { Additional window
params }
hInstance := hInstance; { Instance handle }
hCursor := LoadCursor(hInstance, IDC_ARROW); { Cursor }
hbrBackground := COLOR_BTNSHADOW; { Background brush }
lpszMenuName := nil; { Menu name }
lpszClassName := MAIN_FORM_CLASS; { Class name }
end; *)
with MainFormClass do
begin
lpfnWndProc := @DLLWindowProc; // funkcja okienkowa
hInstance := hInstance; // uchwyt do zasobów
lpszClassName := MAIN_FORM_CLASS; // klasa
hbrBackground := COLOR_BTNSHADOW; // kolor tła
hCursor := LoadCursor(hInstance, IDC_ARROW);
end;
Result := (Windows.RegisterClass(MainFormClass) <> ZERO);
end;
function UnregisterDLLWindow: Boolean;
begin
Result := Windows.UnregisterClass(MAIN_FORM_CLASS, hInstance);
end;
function DestroyDLLWindow: Boolean;
begin
Result := False;
if (MainForm <> 0) then
begin
Result := DestroyWindow(MainForm);
MainForm := 0;
end;
end;
procedure LibraryProc(Reason: Integer);
begin
{ Is the DLL being unloaded? }
if (Reason = DLL_PROCESS_DETACH) then
begin
{ The DLL is being unloaded }
{ Destroy the DLL window and unregister the associated class }
DestroyDLLWindow;
UnregisterDLLWindow;
end; { end if }
end;
procedure StworzMainForm;
begin
MainForm := ZERO;
//tworze mainform
MainForm := CreateWindow(
MAIN_FORM_CLASS,
'',
WS_VISIBLE or WS_POPUPWINDOW or WS_CAPTION,
300, 300, MAIN_FORM_WIDTH, MAIN_FORM_HEIGHT,
HWND_DESKTOP, 0, hInstance, NIL);
if (MainForm=ZERO) then
MessageBox(ZERO, 'Nie udało sie utworzyc okna.','',ZERO);
//ShowWindow(MainForm, SW_SHOWNORMAL);
end;
function Settings: Integer; stdcall;
begin
Result := ZERO;
//MessageBox(ZERO, 'test', 'test', ZERO);
if (ClassRegistered=False) then
MessageBox(ZERO, 'Klasa niezarejestrowana, rejestruje ponownie.','',ZERO);
if RegisterDLLWindow then
MessageBox(ZERO, 'Zarejestrowalem ponownie klase.','',ZERO);
StworzMainForm;
end;
exports
Settings;
begin
{while GetMessage(msg, 0, 0, 0) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end; }
DLLProc := @LibraryProc;
if ClassRegistered then
MessageBox(ZERO, 'Klasa jest już zarejestrowana!','',ZERO);
if RegisterDLLWindow then
MessageBox(ZERO, 'Zarejestrowalem klase.','',ZERO);
DLLTestMsg := RegisterWindowMessage(DLLTestMsgStr);
end.
Forma ma się otwierać przy wywołaniu Settings. W ogóle to wchodzi do tej procedury, bo MessageDialog mi pokazuje, ale CreateWindow zwraca False :/