Форум: "WinAPI";
Текущий архив: 2002.05.13;
Скачать: [xml.tar.bz2];

Вниз

Создание окна   Найти похожие ветки 

← →
Cobalt   (2002-03-07 17:20) [0]

Регистрирую класс - всё ок(ф-ия <>0, GetLastError = 0). Создаю окно этого класса - возвращает 0, окно не показывает, к оконной ф-ии обращается (3 раза) и говорит, что параметр неправильный;
Создаю окно другого класса (напр. Combobox) - всё ок(показывает его)

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure Execut;forward;
procedure TForm1.Button1Click(Sender: TObject);
begin
Execut;
end;

type
TList = array[1..99] of String[17];

const
ListCount:Word = 0;

var
UserMenu: hMenu;
MenuName:String[17];
Window: hWnd;

function WindowProc(Wnd: hWnd; iMessage, wParam:Word; lParam: LongInt): LongInt; export;
var
DC: hDC;
PaintStruct: TPaintStruct;
begin
case iMessage of
WM_Paint: begin
DC:=BeginPaint(Wnd, PaintStruct);
TextOut(DC, 0, 0, @MenuName[1], Length(MenuName));
EndPaint(Wnd, PaintStruct);
end;
WM_Destroy: PostQuitMessage(0);
else
WindowProc:=DefWindowProc(Wnd, iMessage, wParam, lParam);
end;
end;


procedure Execut;
var
WndClas: TWndClass;
s:string;
p:pointer;
clAtom:integer absolute p;
m:MSG;
begin
//Регистрируем класс
WndClas.Style := 0;
WndClas.lpfnWndProc:= @WindowProc;
WndClas.cbClsExtra := 0;
WndClas.cbWndExtra := 0;
WndClas.hInstance := MainInstance;
WndClas.hIcon := 0;
WndClas.hCursor := LoadCursor(0, IDC_Arrow);
WndClas.hbrBackground := GetStockObject(White_Brush);
WndClas.lpszMenuName := "Menu";
WndClas.lpszClassName := "GenWindow";
//clAtom = 50079
clAtom:=Windows.RegisterClass(WndClas);
s:="Error №"+InttoHex(GetLastError,6)+":"+SysErrorMessage(GetLastError);
if clAtom=0
then MessageBox(0,PChar(s),"Can""t Register Class",0);
//"Combobox"
Window := CreateWindow("GenWindow","MyInstance",
WS_POPUP or WS_CAPTION or WS_CLIPSIBLINGS or WS_SYSMENU
or WS_MINIMIZEBOX,
GetSystemMetrics(SM_CXSCREEN) div 2,
GetSystemMetrics(SM_CYSCREEN) div 2,
0, 0, 0, 0, HInstance, nil);
//h:=CreateWindow(PChar(clAtom),"MyInstance",WS_CAPTION,0,0,100,100,0,0,MainInstance,nil);
if Window=0
then MessageBox(0,PChar(SysErrorMessage(GetLastError)),"Can""t create window",0);
UpDateWindow(Window);
UserMenu:=CreatePopUpMenu;
InsertMenu(GetMenu(Window), 106, MF_ByCommand or MF_PopUp, UserMenu, "User Define Menu");
ShowWindow(Window,Sw_ShowNormal);
while GetMessage(M, 0, 0, 0) do
begin
TranslateMessage(m);
DispatchMessage(m);
end;
end;

end.

---

← →
Cobalt   (2002-03-07 18:53) [1]

Собственно, вопрос:
если класс регистрируется, то почему не создаётся окно?

---

← →
Raptor   (2002-03-07 20:57) [2]

Здесь есть несколько ошибок, но что бы не перечислять их все лучше приведу правильный и рабочий код, а ты сам уже исправишь у себя.
************************** CUT HERE ****************************

program SimpleWindow;

uses
windows, messages;
var
wc : TWndClassEx;
Wnd : HWND;
Msg : TMsg;

function WindowProc(wnd : HWND; Msg : Integer; WParam : WParam; LParam : Longint): Longint; stdcall;
Begin
Result := 0;
case msg of
wm_destroy:Begin
postquitmessage(0);
End;
else Result := DefWindowProc(wnd, msg, wparam, lparam);
end;//Case MSG
End;

begin
wc.cbSize:=sizeof(wc);
wc.style:=cs_hredraw or cs_vredraw;
wc.lpfnWndProc:=@WindowProc;
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:="SimpleWindowDemo";

RegisterClassEx(wc);
CreateWindowEx(0, "SimpleWindowDemo", "Simple Window Demo", ws_overlapped or ws_sysmenu,0, 0, 300, 300, 0, 0,Hinstance, nil);
ShowWindow(Wnd, CmdShow);

While GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.

************************** CUT HERE ****************************

---

← →
Cobalt   (2002-03-08 11:23) [3]

Извиняюсь перед всеми,
Проблема: класс не регистрируется
Регистрацию класса взял у Raptor © (07.03.02 20:57)

Кстати о Raptor © (07.03.02 20:57 : Wnd:=CreateWindowEx(0, "SimpleWindowDemo", "Simple Window Demo", ws_overlapped or ws_sysmenu,0, 0, 300, 300, 0, 0,Hinstance, nil);

Т.о. Из обработчика формы (Button1Click) класс не регистрируется
А просто так - регистрируется...
????!!

---

← →
Cobalt   (2002-03-08 12:30) [4]

Вынес процедуру, создающую окно, в отдельный модуль.
Вызываю её (процедуру) в Button1Click - окно создаётся.

Вставляю в текст обработчика переменные и код процедуры - выдаёт ошибку !!!!!???

---

← →
Evgeny   (2002-03-09 07:42) [5]

1. Сделай переменные глобальными
WndClas: TWndClass;
m : MSG;
2. Этот вопрос подымается с периодичностью, по меньшей мере, раз в месяц. Так что по поиску можно найти не один пример.

---

← →
Cobalt   (2002-03-12 09:18) [6]

> Evgeny © (09.03.02 07:42)
> 2. Этот вопрос подымается с периодичностью, по меньшей мере,
> раз в месяц. Так что по поиску можно найти не один пример.

В поиске нашёл только в форуме "Сети"...

> 1. Сделай переменные глобальными
> WndClas: TWndClass;
> m : MSG;

В том-то и заключается проблема: когда WndClas - глобальная переменная (объявлена в модуле) - всё ОК.
А если как локальная переменная процедуры, то не пашет, грит, ошибка.

Попробуйте сбилдить такую вот прогу (на форме одна кнопка, обработчик, функция для класса окна, закоментированная глобальная переменная) И понажимать эту кнопку несколько раз

function WindowProc(wnd : HWND; Msg : Integer; WParam : WParam; LParam : Longint):Longint; stdcall;
Begin
Result := 0;
case msg of
wm_destroy:Begin
PostQuitMessage(0);
End;
else Result := DefWindowProc(wnd, msg, wparam, lparam);
end//Case MSG
End;

//var wc : TWndClassEx;
procedure TForm1.Button1Click(Sender: TObject);
var
wc : TWndClassEx;
clAtom:integer;
s:string;
begin
//m:=my.Create(false);
wc.cbSize:=sizeof(wc);
wc.style:=cs_hredraw or cs_vredraw;
wc.lpfnWndProc:=@Unit1.WindowProc;
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:="MyClass_____";

clAtom:=Windows.RegisterClassEx(wc);
if (clAtom=0)and(GetLastError<>0)
then begin
s:="Error №"+InttoHex(GetLastError,6)+":"+SysErrorMessage(GetLastError);
MessageBox(0,PChar(s),"Can""t Register Class",0);
end;
ShowMessage(String(wc.lpszClassName));
end;

---

Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2002.05.13;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.004 c