Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Создание окна [Win95/98]

Страницы: < 1 2
rel_ © (2003-10-21 08:45:00)

Мастера, необходимо сгенерить дочернее окно на контроле.

В общем виде делаю так: в конструкторе получаю Parent и затем вызываю след. методы:

type
TWndProc = function(wnd:HWND; Msg : Integer; Wparam:Wparam; Lparam:Lparam):Lresult of object; stdcall;
...

FWndProc : TWndProc;
...

function TGame.InitClass : boolean;
begin

wndClass.style:=cs_hredraw or cs_vredraw;
wndClass.lpfnWndProc:=@FWndProc;
wndClass.cbClsExtra:=0;
wndClass.cbWndExtra:=0;
wndClass.hInstance:=HInstance;
wndClass.hIcon:=LoadIcon(0,idi_application);
wndClass.hCursor:=LoadCursor(0,idc_arrow);
wndClass.hbrBackground:=COLOR_BTNFACE+1;
wndClass.lpszMenuName:=nil;
wndClass.lpszClassName:="TGame";

Result:=Boolean(RegisterClass(wndClass)<>0);
end;

function TAnyClass.MakeWindow(): HWND;
begin
result :=
CreateWindow("TAnyClass","",
WS_VISIBLE or WS_CHILD or WS_CLIPSIBLINGS,
10, 10, 200, 200,
FParent.Handle, 0, HInstance, nil );
end;

Так вот MakeWindow() возвращает "0" - соответственно, ничего не создаётся. Подскажите, что делаю не так (в примере не приведены процедуры сбора сообщении, отображения окна и т.д.).

rel_ (2003-10-21 12:01:00) [21]

to Digitman © Конечно знаю, что есть готовый класс TWinControl - в итоге, если не получится навоять руками, то унаследую именно от него.

Но есть задумка : создать класс, создающий дочернее окно на заданной Parent??? Причём весь механизм создания окна должен быть скрыт внутри класса. (сделать хочу руками : на API)

Может кто отсоветует что-нибудь???

Digitman (2003-10-21 11:57:00) [22]

> Неужели не корректно

некорректно.

непонятно вообще, зачем ты это делаешь непосредственно на WinAPI

на то есть готовый класс TWinControl, св-во ParentWindow которого позволяет легко и просто создать дочерний контрол-наследник данного VCL-класса на указанном родительском non-VCL-окне (либо св-во Parent, если род.окно создано VCL-контролом)

rel_ (2003-10-21 11:37:00) [23]

to Игорь Шевченко © если не трудно, проясни пожалуйста.
Instance я вообще использую вслепую не зная его предназначения.

>>Оконная процедура в твоем случае не может быть методом объекта

Почему??? Неужели не корректно такое объявление

TWndProc = function(wnd:HWND; Msg : Integer; Wpar:Wparam; Lpar:Lparam):Lresult of object; stdcall;
...
FWndProc : TWndProc
...
FWndProc := WndProc;
...

и потом использовнаие адреса FWndProc при описании класса окна???

А как же мне тогда быть, если я хочу создать класс, создающий дочернее окно на заданной Parent???
Причём весь механизм создания окна должен быть скрыт внутри класса.

Если не трудно, просвети меня.

Игорь Шевченко (2003-10-21 11:16:00) [24]

Оконная процедура в твоем случае не может быть методом объекта

RTFM MakeobjectInstance, твоя ошибка в этом

Digitman (2003-10-21 11:11:00) [25]

вот сей момент прелюбопытен :

constructor TGame.Create(AParent : TWinControl);
var Msg : TMsg;
begin
...
while (GetMessage(Msg, 0, 0, 0)) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;...
end;

и когда ж ты ожидаешь завершение работы конструирующего метода, если в нем крутится по сути бесконечный цикл ?
при каких условиях ты ожидаешь здесь получить WM_QUIT , дабы прервать этот цикл ?

rel_ (2003-10-21 11:02:00) [26]

unit GameUn;

interface
uses Windows,Messages,ShellAPI, Controls, Types, SysUtils, Dialogs;

type
TWndProc = function(wnd:HWND; Msg : Integer; Wpar:Wparam; Lpar:Lparam):Lresult of object; stdcall;

TGame = class
private
FParent : TWinControl;
FHandle : HWND;
wndClass : TWndClass;
FWndProc : TWndProc;

procedure Paint(wnd:HWND; Msg : Integer; Wpar:Wparam; Lpar:Lparam);

function InitClass : boolean;
function WndProc(wnd:HWND; Msg : Integer; Wpar:Wparam; Lpar:Lparam):Lresult; stdcall;
function MakeWindow(): HWND;

public
constructor Create(AParent : TWinControl);
end;

implementation

constructor TGame.Create(AParent : TWinControl);
var Msg : TMsg;
begin
FParent := TWinControl(AParent);
FWndProc := WndProc;
if InitClass then begin
FHandle := MakeWindow();
ShowWindow(FHandle, SW_SHOW);
UpdateWindow(FHandle);

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

end;
end;

function TGame.WndProc(wnd:HWND; Msg : Integer; Wpar:Wparam; Lpar:Lparam):Lresult; stdcall;
begin
WndProc := 0;
case Msg of
WM_CREATE : ;
WM_ERASEBKGND : ;
WM_PAINT : Paint(wnd, Msg, wPar, lPar);
WM_DESTROY : PostQuitMessage(0);
end;

result := DefWindowProc(wnd, Msg, wPar, lPar);
end;

function TGame.InitClass : boolean;
begin
wndClass.style:=cs_hredraw or cs_vredraw;
wndClass.lpfnWndProc:=@FWndProc;
wndClass.cbClsExtra:=0;
wndClass.cbWndExtra:=0;
wndClass.hInstance:=GetModuleHandle (NIL);
wndClass.hIcon:=LoadIcon(0,idi_application);
wndClass.hCursor:=LoadCursor(0,idc_arrow);
wndClass.hbrBackground:=COLOR_BTNFACE+1;
wndClass.lpszMenuName:=nil;
wndClass.lpszClassName:="TGame";

Result:=Boolean(RegisterClass(wndClass)<>0);

//здеся вроде всё проходит
end;

function TGame.MakeWindow(): HWND;
begin
result :=

CreateWindow( "TGame", "",
WS_CHILD,
0, 0, 200, 200, FParent.Handle, 0, HInstance, nil);

//вот здесь я проверял, что вы писали
if result =0 then ShowMessage(SysErrorMessage(GetLastError)+" "+IntToStr(FParent.Handle));
end;

// отрисовка - можно вообще не смотреть - рисую rectangle ради проверки и всё.
procedure TGame.Paint(wnd:HWND; Msg : Integer; Wpar:Wparam; Lpar:Lparam);
var
_paint : PAINTSTRUCT;
_dc, _mdc : HDC;
_tmpBm, _saveBm : HBITMAP;
_tmpBrush, _saveBrush : HBRUSH;
_savePen : HPEN;

begin
_dc := BeginPaint(wnd,_paint);
_mdc := CreateCompatibleDC(_dc);
_tmpBm := CreateDiscardableBitmap(_dc, 200,200);
_tmpBrush := CreateSolidBrush(RGB(255,255,255));

_saveBm := SelectObject(_mdc, _tmpBm);
_saveBrush := SelectObject(_mdc, _tmpBrush);
_savePen := SelectObject(_mdc, CreatePen(PS_SOLID,1,RGB(0,0,0)));

//---

FillRect(_mdc, Rect(0,0,100,100),_tmpBrush);

BitBlt(_dc,0,0,200,200,_mdc,0,0,SRCCOPY);
//---

DeleteObject(SelectObject(_mdc, _saveBm));
DeleteObject(SelectObject(_mdc, _saveBrush));
DeleteObject(SelectObject(_mdc, _savePen));

DeleteDC(_mdc);
EndPaint(Wnd,_paint);
end;

end.

[lamer]Barmaglot (2003-10-21 10:53:00) [27]

Скидывай, покрайней мере можно попытаться посмотреть...

rel_ (2003-10-21 10:49:00) [28]

to Игорь Шевченко ©
нет, не равен (там 6 знаков аж).

Может я скину код - там всего 3 процедуры. Что-то я делаю коряво!!!???

Игорь Шевченко (2003-10-21 10:35:00) [29]

rel_ (21.10.03 10:33)

> Пишет : недопустимый дескриптор окна.

Проверь, чему равен FParent.Handle, сдается мне, что нулю...

rel_ (2003-10-21 10:33:00) [30]

to Guerrillero ©
Пишет : недопустимый дескриптор окна.

[lamer]Barmaglot (2003-10-21 10:14:00) [31]

1400L ERROR_INVALID_WINDOW_HANDLE

Исходя из этого ищи ошибку...

Guerrillero (2003-10-21 10:08:00) [32]

ShowMessage(SysErrorMessage(GetLastError));

rel_ (2003-10-21 10:04:00) [33]

to [lamer]Barmaglot © !!! спасибо за участие !!!

написал следующее:
if CreateWindow(...) =0
then ShowMessage(IntToStr(GetLastError()));

Вернул 1400

[lamer]Barmaglot (2003-10-21 09:26:00) [34]

Ну вопервых любимый вопрос Игоря Шевченко - что возвращает GetLastError?
Что за класс окна TAnyClass?

Страницы: < 1 2

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »