Новичок
Профиль
Группа: Участник
Сообщений: 1
Регистрация: 11.5.2019
Репутация: нет
Всего: нет
|
Здравствуйте! Пытаюсь создать дочернее окно средствами WinApi. Нашел пример (см. ниже), в нем основное окно создается средствами Delphi, а дочернее - функцией CreateMDIWindow. Я создал основное (родительское) окно в отдельной функции function WinCreate: HWnd; через CreateWindow. При создании дочернего окна в функции CreateMDIWindow на место параметра hWndParent ставлю WinCreate. Сделал отдельную кнопку для созидании дочернего окна. Но почему-то при нажатии на кнопку создается еще один экземпляр основного окна. В чем может быть проблема? Пример | Код |
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
CreateChild1: TMenuItem;
procedure CreateChild1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ Register the MDI Child Window Class }
function RegisterClass: Boolean;
var
WindowClass: TWndClass;
begin
{setup our new window class}
WindowClass.Style := CS_HREDRAW or CS_VREDRAW; {set the class styles}
WindowClass.lpfnWndProc := @DefMDIChildProc; {point to the default MDI child window procedure}
WindowClass.cbClsExtra := 0; {no extra class memory}
WindowClass.cbWndExtra := 0; {no extra window memory}
WindowClass.hInstance := hInstance; {the application instance}
WindowClass.hIcon := LoadIcon(0, IDI_WINLOGO); {load a predefined logo}
WindowClass.hCursor := LoadCursor(0, IDC_APPSTARTING); {load a predefined cursor}
WindowClass.hbrBackground := COLOR_WINDOW; {use a predefined color}
WindowClass.lpszMenuName := nil; {no menu}
WindowClass.lpszClassName := 'TestClass'; {the registered class name}
{now that we have our class set up, register it with the system}
Result := Windows.RegisterClass(WindowClass) <> 0;
end;
procedure TForm1.CreateChild1Click(Sender: TObject);
var
hWindow: HWND;
begin
{register our new class first}
if not RegisterClass then
begin
ShowMessage('RegisterClass failed');
Exit;
end;
{now, create a window based on our new class}
hWindow := CreateMDIWindow('TestClass', {the registered class name}
'API Window', {the title bar text}
WS_VISIBLE OR {the MDI child window is visible,}
WS_CAPTION OR {has a caption bar,}
WS_SYSMENU OR {a system menu,}
WS_MINIMIZEBOX OR {and minimize and}
WS_MAXIMIZEBOX, {maximize boxes}
CW_USEDEFAULT, {default horizontal position}
CW_USEDEFAULT, {default vertical position}
CW_USEDEFAULT, {default width}
CW_USEDEFAULT, {default height}
Form1.ClientHandle, {handle of the MDI client window}
hInstance, {the application instance}
0 {no additional information}
);
{if our window was created successfully, show it}
if hWindow <> 0 then
begin
ShowWindow(hWindow, SW_SHOWNORMAL);
UpdateWindow(hWindow);
end
else
begin
ShowMessage('CreateWindow failed');
Exit;
end;
end;
end.
|
Мой код | Код |
program WINHELLO3;
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
const
AppName = 'WinHello';
id_BUTTON=222;
var
hWindow0,hinst1: HWnd;
function WinCreate: HWnd;forward;
procedure CreateChildWindow;forward;
function WindowProc(Window: HWnd; AMessage: UINT; WParam : WPARAM;
LParam: LPARAM): LRESULT; stdcall; export;
var
dc : hdc;
ps : paintstruct;
r : Trect;
begin
WindowProc := 0;
case AMessage of
WM_COMMAND:
BEGIN
if(wparam=ID_BUTTON) then
begin
// MessageBox(0, 'Кнопка', 'Test', MB_OK);
CreateChildWindow;
end;
END;
wm_paint:
begin
dc:=BeginPaint(Window,ps);
GetClientRect(Window,r);
DrawText(dc,'Hello world',-1,r,
DT_SINGLELINE or DT_CENTER or DT_VCENTER);
EndPaint(Window,ps);
Exit;
end;
wm_Destroy:
begin
PostQuitMessage(0);
Exit;
end;
end;
WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
end;
function WinRegister: Boolean;
var
WindowClass: TWndClass;
begin
WindowClass.Style := cs_hRedraw or cs_vRedraw;
WindowClass.lpfnWndProc := @WindowProc;
WindowClass.cbClsExtra := 0;
WindowClass.cbWndExtra := 0;
WindowClass.hInstance := hInstance;//system.MainInstance;
WindowClass.hIcon := LoadIcon(0, idi_Application);
WindowClass.hCursor := LoadCursor(0, idc_Arrow); {load a predefined cursor}
WindowClass.hbrBackground := COLOR_WINDOW; {use a predefined color}
WindowClass.lpszMenuName := nil; {no menu}
WindowClass.lpszClassName := AppName;
Result := Windows.RegisterClass(WindowClass) <> 0;
end;
{ Create the Window Class }
function WinCreate: HWnd;
var
hWindow: HWnd;
begin
//Класс регистрируется в основной программе до вызова WinCreate
//Если тут раскомментировать, а в основной программе убрать,
//то второе окно не создается.
{
if not WinRegister then
begin
ShowMessage('Register Main Class failed');
Exit;
end;
}
hWindow := CreateWindow
(AppName,
'Hello world program',
ws_OverlappedWindow,
cw_UseDefault,
cw_UseDefault,
cw_UseDefault,
cw_UseDefault,
0,
0,
system.MainInstance,
nil);
if hWindow <> 0 then begin
ShowWindow(hWindow, CmdShow);
ShowWindow(hWindow, SW_SHOW);
UpdateWindow(hWindow);
end;
Result := hWindow;
end;
function RegisterChild: Boolean;
var
WindowClass: TWndClass;
begin
{setup our new window class}
WindowClass.Style := CS_HREDRAW or CS_VREDRAW; {set the class styles}
WindowClass.lpfnWndProc := @DefMDIChildProc; {point to the default MDI child window procedure}
WindowClass.cbClsExtra := 0; {no extra class memory}
WindowClass.cbWndExtra := 0; {no extra window memory}
WindowClass.hInstance := hInstance; {the application instance}
WindowClass.hIcon := LoadIcon(0, IDI_WINLOGO); {load a predefined logo}
WindowClass.hCursor := LoadCursor(0, IDC_APPSTARTING); {load a predefined cursor}
WindowClass.hbrBackground := COLOR_WINDOW; {use a predefined color}
WindowClass.lpszMenuName := nil; {no menu}
WindowClass.lpszClassName := 'TestClass'; {the registered class name}
{now that we have our class set up, register it with the system}
Result := Windows.RegisterClass(WindowClass) <> 0;
end;
procedure CreateChildWindow;
var
hWindow: HWND;
begin
{register our new class first}
if not RegisterChild then
begin
ShowMessage('Register child Class failed');
Exit;
end;
{now, create a window based on our new class}
hWindow := CreateMDIWindow('TestClass', {the registered class name}
'API Window', {the title bar text}
WS_VISIBLE OR {the MDI child window is visible,}
WS_CAPTION OR {has a caption bar,}
WS_SYSMENU OR {a system menu,}
WS_MINIMIZEBOX OR {and minimize and}
WS_MAXIMIZEBOX, {maximize boxes}
0,//CW_USEDEFAULT, {default horizontal position}
0,//CW_USEDEFAULT, {default vertical position}
200,//CW_USEDEFAULT, {default width}
200,//CW_USEDEFAULT, {default height}
WinCreate, {handle of the MDI client window}
hInstance, {the application instance}
0 {no additional information}
);
{if our window was created successfully, show it}
if hWindow <> 0 then
begin
ShowWindow(hWindow, SW_SHOWNORMAL);
UpdateWindow(hWindow);
end
else
begin
ShowMessage('Create child Window failed');
Exit;
end;
end;
var
AMessage: Msg;
hWindow,button1,hinst,hfont: HWnd;
begin
if not WinRegister then begin
MessageBox(0, 'Register Main failed', nil, mb_Ok);
Exit;
end;
hWindow := WinCreate;
hInst1 := GetModuleHandle(nil);
if longint(hWindow) = 0 then begin
MessageBox(0, 'WinCreate failed', nil, mb_Ok);
Exit;
end;
Button1 := CreateWindow(
'Button',
'Кнопка',
WS_CHILD or BS_TEXT or WS_VISIBLE,
0, 0, 70, 40, hWindow, id_button, hInst, nil);
SendMessage(Button1,WM_SETFONT,hFont,0);
while GetMessage(AMessage, 0, 0, 0) do begin
TranslateMessage(AMessage);
DispatchMessage(AMessage);
end;
Halt(AMessage.wParam);
end.
|
|
Дочернее окно на WinApi, Проблема при создании 
Загрузка ...
