Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Дочернее окно на WinApi, Проблема при создании 
:(
    Опции темы
Mavlyudov
Дата 11.5.2019, 16:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 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.


PM MAIL   Вверх
RAIN666
Дата 8.6.2019, 11:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 14
Регистрация: 15.2.2019

Репутация: нет
Всего: нет



Для child-окон не нужно создавать отдельный класс окна. Достаточно указать handle окна-родителя. В нем будет создан ваш child.
Код

unit Unit_MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages;

function init1:boolean;

const
  myclass1 = 'MyProgs';
  mytitle1 = 'Name';

var
  wc : TWndClassEx;
  form1 : HWND;


implementation

function WindowProc1(wnd:HWND; Msg : uint; Wpar:Wparam; Lpar:LPARAM):Lresult; stdcall;
Begin
  Result := 0;
  case msg of

    WM_CREATE:
    begin
      MessageBox(wnd, PChar('hello, world'), PChar(':)'),MB_ICONINFORMATION);
    end;

    WM_DESTROY:
    Begin
      PostQuitMessage(0);
      Result := 0;
      exit;
    End;

    WM_QUERYENDSESSION:
    result := integer(true);
    WM_ENDSESSION:
    if wpar=integer(true) then
      SendMessage(wnd,WM_DESTROY,0,0);

  else Result := DefWindowProc(wnd,msg,wpar,lpar);
  end;
End;


function CreateForm1(IsVisible : boolean) : boolean;
const
  MyStyle = (WS_BORDER or WS_CAPTION or WS_SIZEBOX or WS_SYSMENU or
             WS_MAXIMIZEBOX or WS_MINIMIZEBOX);
var
  xPos,yPos,nWidth,nHeight : Integer;
begin
  wc.cbSize:=sizeof(twndclassex);
  wc.style:= CS_HREDRAW or CS_VREDRAW or CS_DBLCLKS;
  wc.lpfnWndProc:=@WindowProc1;
  wc.cbClsExtra:=0;
  wc.cbWndExtra:=0;
  wc.hInstance:=HInstance;
  wc.hIcon:=LoadIcon(0,idi_application);

  wc.hCursor:=LoadCursor(0,idc_arrow);
  wc.hbrBackground:=COLOR_BTNFACE+1;
  wc.lpszMenuName := nil;
  wc.lpszClassName:= myclass1;
  if RegisterClassEx(wc) = 0 then
  begin
    result := false;
    exit;
  end;

  xPos:=100;
  yPos:=150;
  nWidth:=400;
  nHeight:=250;

  if isVisible then
  form1 := CreateWindowEx(0,myclass1,mytitle1,mystyle or ws_visible,
                          xPos,yPos,nWidth,nHeight,0,0,Hinstance,nil) else
  form1 := CreateWindowEx(0,myclass1,mytitle1,mystyle,
                          xPos,yPos,nWidth,nHeight,0,0,Hinstance,nil);
  result := form1 <> 0;
end;

function init1 : boolean;
begin
  result := CreateForm1(true);
  if not result then
  exit;
end;

end.

а кнопки создавайте в обработчике WM_CREATE

Это сообщение отредактировал(а) RAIN666 - 8.6.2019, 12:03
PM MAIL   Вверх
Google
  Дата 26.6.2019, 18:55 (ссылка)  





  Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »


 




[ Время генерации скрипта: 0.1132 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.