Модераторы: 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   Вверх
Google
  Дата 26.5.2019, 00:16 (ссылка)  





  Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "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.3555 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


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

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