-
Всем привет! Пытаюсь создать окно, но почему то не выходит. Может кто-нибудь подскажет? constructor TWindow64.Create(AParent: THandle; ABitmap: TBitmap64; R: TRegion);
var
ClassRegistered: Boolean;
lpWndClassEx: tagWndClassEx;
FWndClassEx: TWndClassEx;
Style: cardinal;
Wnd: HWND;
begin
inherited Create;
FWndClassEx.cbSize := SizeOf(FWndClassEx);
FWndClassEx.style := WS_OVERLAPPED;
FWndClassEx.lpfnWndProc := @ClientWndProc;
FWndClassEx.cbClsExtra := 0;
FWndClassEx.cbWndExtra := 0;
FWndClassEx.hInstance := HInstance;
FWndClassEx.hIcon := 0;
FWndClassEx.hCursor := 0;
FWndClassEx.hbrBackground := 0;
FWndClassEx.lpszMenuName := nil;
FWndClassEx.lpszClassName := LPCWSTR('DmkClass');
FWndClassEx.hIconSm := 0;
if RegisterClassEx(FWndClassEx) = 0 then
begin
InfoMessage(0, 'TWindow64: Класс не зарегестрирован.');
end
else
begin
ClassRegistered := GetClassInfoEx(HInstance, FWndClassEx.lpszClassName, lpWndClassEx);
Style := WS_DISABLED;
Wnd := Windows.CreateWindowEx(0, LPCWSTR(FWndClassEx.lpszClassName), LPCWSTR('DmkClass'), Style, 0, 0, 0, 0, HWND_MESSAGE, 0, HInstance, nil);
end;
if (FHandle = 0) then
begin
InfoMessage(0, 'TWindow64: Окно не создано. Ошибка: ' + IntToStr(GetLastError));
end
end;
-
смотри реализацию AllocateHWnd()
-
GetLastError наше все
-
>Rouse_ © (22.03.17 10:27) [1] Так оттуда и скопировал.
>Игорь Шевченко © (22.03.17 10:42) [2] GetLastError говорит 06h – IVALIDE_HANDLE.
Только вот какой непонятно. Может HInstance?
-
Стренно, это вообще совет MS сделать пустое окно с выборкой только сообщений. Самое интересное, что в таком виде никакое окно не создается ;(
-
dmk © (22.03.17 13:22) [3]
Ты создаешь Wnd, а проверяешь FHandle. Странный какой-то код.
-
>Странный какой-то код. Да это отладочный. Там точка останова на CreateWindowEx стоит. FHandle пока не нужен.
-
Вот так окно создается, но FPrevWndProc := Pointer(GetWindowLongPtr(AParent, GWL_WNDPROC)); видимо неправильно. AV вылезает. Никто не знает откуда взять адрес предыдущей процедуры?
function TWindow64.WndProc(Wnd: HWND; Msg: integer; WParam: WParam; LParam: LParam): LResult; stdcall; var Input: TMessage; m: TWMMouse;
begin case Msg of WM_MOUSEMOVE: begin m := TWMMouse(Input); MForm.Caption := IntToStr(m.XPos) + '.' + IntToStr(m.YPos); Result := S_OK; end; end;
Result := CallWindowProc(FPrevWndProc, Wnd, Msg, WParam, LParam); end;
constructor TWindow64.Create(AParent: THandle; ABitmap: TBitmap64; R: TRegion); begin inherited Create;
//Функция класа FCallWndProc := WndProc; //FPrevWndProc := @FCallWndProc; FPrevWndProc := Pointer(GetWindowLongPtr(AParent, GWL_WNDPROC));
//Заполняем класс FWndClassEx.cbSize := SizeOf(FWndClassEx); FWndClassEx.style := 0; FWndClassEx.lpfnWndProc := @FCallWndProc; FWndClassEx.cbClsExtra := 0; FWndClassEx.cbWndExtra := 0; FWndClassEx.hInstance := HInstance; FWndClassEx.hIcon := 0; FWndClassEx.hCursor := 0; FWndClassEx.hbrBackground := 0; FWndClassEx.lpszMenuName := nil; FWndClassEx.lpszClassName := 'TWindow64'; FWndClassEx.hIconSm := 0;
//Регистрируем класс if RegisterClassEx(FWndClassEx) = 0 then begin InfoMessage(0, 'TWindow64: Класс не зарегестрирован.'); end else begin FClassRegistered := GetClassInfoEx(HInstance, FWndClassEx.lpszClassName, FTagWndClassEx);
//Стиль окна FStyleEx := 0; FStyle := WS_DISABLED;
//Создаем окно FHandle := Windows.CreateWindowEx(0, LPCWSTR(FWndClassEx.lpszClassName), 'TWindow64', FStyle, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, HWND_MESSAGE, 0, HInstance, nil); end;
if (FHandle = 0) then begin InfoMessage(0, 'TWindow64: Окно не создано. Ошибка: ' + IntToStr(GetLastError)); end else begin FParent := AParent; FBitmap := ABitmap; FRegion := R; FTransparent := false; FBackColor := crWhite; FFontColor := crWhite; FFrameColor := crBlack; FAlpha := $FF; FOpacity := $FF; SetFont(DefaultFont, DefaultFontParams);
if FRegion.Empty then begin FRegion.X := 0; FRegion.Y := 0; FRegion.W := 100; FRegion.H := 100; end; end; end;
-
Процедуры вызова объявлены так:
FCallWndProc: TCallWndProc; FPrevWndProc: TFarProc;
type TCallWndProc = function(Wnd: HWND; Msg: integer; WParam: WParam; LParam: LParam): LResult of object; stdcall;
-
> Никто не знает откуда взять адрес предыдущей процедуры?
FPrevWndProc := Pointer(GetWindowLongPtr(AParent, GWL_WNDPROC));
все правильно. Только зачем ты пытаешься вызвать процедуру чужого оконного класса ? Это в общем случае запрещено.
-
> Никто не знает откуда взять адрес предыдущей "оконной" процедуры?а какого окна? -> AParent: THandle ? -> а это кто/что, у тебя ж окна нет (не было) ? ... а если нового, то вот : FWndClassEx.lpfnWndProc := @FCallWndProc; только тут ошибочка, нужно так: FWndClassEx.lpfnWndProc := Pointer(FCallWndProc); но и тут ошибочка, так как type TCallWndProc = function(Wnd: HWND; Msg: integer; WParam: WParam; LParam: LParam): LResult of object; stdcall; of object; а это значит, что вызывающий эту функцию код должен допередать туда первым(нулевым) скрытым параметром ещё и адрес объекта. и как такое сделать - уже озвучено, или заюзай глобальною/классовою переменную. Для одного окошка прокатит.
-
>Игорь Шевченко © (22.03.17 21:19) [9] Игорь, просто я не знаю механизм работы данной процедуры. Что за OldProc? Как ее получить? В MSDN это не объясняется. В примерах везде ее получают разными способами, но ничего не работает.
-
>только тут ошибочка, нужно так: >FWndClassEx.lpfnWndProc := Pointer(FCallWndProc); Так не принимает, а с @ принимает и сразу после создания окна влетает в оконную функцию.
-
>а если нового, то вот : >FWndClassEx.lpfnWndProc := @FCallWndProc;
Да, нового. Пришлось делать создание окна, пусть и пустого.
Все там нормально передается. Соглашение принимается. Окно создается. Если DefWindowProc использовать то MSG всегда нулю равен. Если CallWindowProc, то AV выскакивает.
-
> а с @ принимаетбыл не прав, спутал с @@ (прямым углом) > влетает в оконную функцию.= > http://pda.delphimaster.net/?id=1490126076&n=5 dmk © (22.03.17 02:13) [3] > Проходит один цикл и виснет. > Если не делать частью класса - все в порядке, но переменные класса не видны. > Можно сделать вызов, если ClientWindowProc часть класса?
Там несколько вариантов ответов предложено тчк
-
dmk © (22.03.17 21:38) [11]
Я до сих пор не понимаю, чего ты хочешь сделать. Отправлять произвольному классу Delphi оконные сообщения ? А зачем ? Произвольные классы Delphi для этого не предназначены. Оконные сообщения приходят окнам и обрабатываются оконными процедурами оконных классов, что не обрабатывается в процедурах, обрабатывается в процедуре по умолчанию (DefWindowProc)
-
-
Игорь Шевченко © (22.03.17 22:45) [16] Да это просто графические объекты со своими свойствами. Типа TButton или CheckBox, только без VCL-нагромождений и наследований. У меня свой ZBuffer и DBuffer. В нем все рисуется. Windows не дает досутп к видеопамяти, поэтому рисую в памяти, как в старые досовские времена. Алгоритмы свои. Объекты свои. От винды нужен только ввод-вывод: мышь, дисплей, хдд и т.п. Поэтому делаю абстракцию от WinApi и VCL. Минимальная привязка. Только к процессору. Библиотека типа директ икс или GDI+, только без железа. Мне скорости и так пока хватает. Вы же помните DOS Игорь? Вот. Я просто устал с окнами бороться и написал свое ;)
-
Вот мне нужны например скроллы свои. Написать их несложно, а сообщения от мыши где? Только в оконном классе. Вот и бъюсь с этим.
-
>NoUser
Спасибо! Все работает. И даже 3 окна. Только сообщения от мыши поступают исключительно в видимое окно. Поэтому буду искать другие варианты.
program TestCreateWindowEx;
{$APPTYPE CONSOLE}
{$R *.res}
uses System.SysUtils, Windows, Messages;
type TWindow64 = class protected FHandle: HWND; FParent: HWND; FWndClassEx: TWndClassEx; FTagWndClassEx: tagWndClassEx; FClassRegistered: Boolean; FStyle: dword; FStyleEx: dword; FClassName: string; private FOldWndProc: IntPtr; FOldUserData: IntPtr; procedure InitClientWndProc(AHandle: HWND); function ClientWindowProc(Wnd: HWND; Msg: integer; WParam: WParam; LParam: LParam): LResult; stdcall; class function WndProc(Wnd: HWND; Msg: integer; WParam: WParam; LParam: LParam): LResult; static; stdcall; public constructor Create(AParent: THandle); destructor Destroy; override; property Handle: HWND read FHandle; end;
var GNumClasses: integer = 0;
procedure TWindow64.InitClientWndProc(AHandle: HWND); begin FOldWndProc := SetWindowLongPtr(AHandle, GWL_WNDPROC, IntPtr(@WndProc)); FOldUserData := SetWindowLongPtr(AHandle, GWL_USERDATA, IntPtr(Self)); end;
class function TWindow64.WndProc(Wnd: HWND; Msg: integer; WParam: WParam; LParam: LParam): LResult; var P: Pointer; CN: array[0..255] of Char;
begin P := Pointer(GetWindowLongPtr(Wnd, GWL_USERDATA)); if (P <> nil) then begin Result := TWindow64(P).ClientWindowProc(Wnd, Msg ,WParam, LParam); end else begin GetClassName(Wnd, CN, SizeOf(CN));
case Msg of WM_MOUSEMOVE: SetWindowText(Wnd, CN + ': WM_MOUSEMOVE'); WM_LBUTTONDOWN: SetWindowText(Wnd, CN + ': WM_LBUTTONDOWN'); WM_RBUTTONDOWN: SetWindowText(Wnd, CN + ': WM_RBUTTONDOWN'); WM_LBUTTONUP: SetWindowText(Wnd, CN + ': WM_LBUTTONUP'); WM_RBUTTONUP: SetWindowText(Wnd, CN + ': WM_RBUTTONUP'); WM_CLOSE: PostMessage(Wnd, WM_QUIT, 0, 0); end;
//Writeln(IntToStr(Msg)); Result := DefWindowProc(Wnd, Msg ,wParam, lParam); end; end;
function TWindow64.ClientWindowProc(Wnd: HWND; Msg: integer; WParam: WParam; LParam: LParam): LResult; begin SetWindowLongPtr(Wnd, GWL_USERDATA, IntPtr(FOldUserData));
Result := CallWindowProc(Pointer(FOldWndProc), Wnd, Msg, wParam, lParam);
if IntPtr(@WndProc) <> GetWindowLongPtr(Wnd, GWL_WNDPROC) then FOldWndProc := SetWindowLongPtr(Wnd, GWL_WNDPROC, IntPtr(@WndProc));
FOldUserData := SetWindowLongPtr(Wnd, GWL_USERDATA, IntPtr(Self)); end;
//................................................................................ ......................................
constructor TWindow64.Create(AParent: THandle); var N: integer;
begin inherited Create;
N := GNumClasses; Inc(GNumClasses);
//Заполняем класс FWndClassEx.cbSize := SizeOf(FWndClassEx); FWndClassEx.style := WS_EX_CONTROLPARENT; FWndClassEx.lpfnWndProc := @WndProc; FWndClassEx.cbClsExtra := 0; FWndClassEx.cbWndExtra := 0; FWndClassEx.hInstance := HInstance; FWndClassEx.hIcon := 0; FWndClassEx.hCursor := 0; FWndClassEx.hbrBackground := GetStockObject(DKGRAY_BRUSH); FWndClassEx.lpszMenuName := nil; FWndClassEx.lpszClassName := PChar('TWindow64(' + IntToStr(N) + ')'); FWndClassEx.hIconSm := 0;
//Регистрируем класс if RegisterClassEx(FWndClassEx) = 0 then begin MessageBox(0, PChar('TWindow64: Класс не зарегестрирован. Ошибка: ' + IntToStr(GetLastError)), 'Ошибка', 0); end else begin FClassRegistered := GetClassInfoEx(HInstance, FWndClassEx.lpszClassName, FTagWndClassEx);
//Стиль окна FStyleEx := WS_EX_COMPOSITED; FStyle := WS_TILEDWINDOW;
SetLastError(0);
//Создаем окно FHandle := Windows.CreateWindowEx(FStyleEx, FWndClassEx.lpszClassName, FWndClassEx.lpszClassName, FStyle, 0, 0, 800, 600, 0, //HWND_MESSAGE 0, HInstance, nil);
end;
if (FHandle = 0) then begin MessageBox(0, PChar('TWindow64: Окно не создано. Ошибка: ' + IntToStr(GetLastError)), 'Ошибка', 0); Exit; end;
FParent := AParent; end;
//................................................................................ ......................................
destructor TWindow64.Destroy; begin inherited Destroy; end;
//................................................................................ ......................................
var MW1, MW2, MW3: TWindow64; Msg: tagMsg;
begin try { TODO -oUser -cConsole Main : Insert code here }
MW1 := TWindow64.Create(0); MW2 := TWindow64.Create(0); MW3 := TWindow64.Create(0);
SetWindowText(MW1.Handle, 'Заголовок 1'); SetWindowText(MW2.Handle, 'Заголовок 2'); SetWindowText(MW3.Handle, 'Заголовок 3'); Windows.SetWindowPos(MW1.Handle, 0, 100, 100, 800, 600, SWP_SHOWWINDOW); Windows.SetWindowPos(MW2.Handle, 0, 300, 300, 800, 600, SWP_SHOWWINDOW); Windows.SetWindowPos(MW3.Handle, 0, 500, 500, 800, 600, SWP_SHOWWINDOW);
Msg.Message := 0;
while (Msg.Message <> WM_QUIT) do begin PeekMessage(Msg, MW1.Handle, 0, 0, PM_REMOVE); if (Msg.Message <> WM_QUIT) then begin TranslateMessage(Msg); DispatchMessage(Msg); end;
PeekMessage(Msg, MW2.Handle, 0, 0, PM_REMOVE); if (Msg.Message <> WM_QUIT) then begin TranslateMessage(Msg); DispatchMessage(Msg); end;
PeekMessage(Msg, MW3.Handle, 0, 0, PM_REMOVE); if (Msg.Message <> WM_QUIT) then begin TranslateMessage(Msg); DispatchMessage(Msg); end; end;//while
MW1.Destroy; MW2.Destroy; MW3.Destroy;
except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end.
-
dmk © (23.03.17 00:14) [17]
Существует масса игровых фреймворков, где контролы создаются и рисуются также, как ты написал. Возможно, некоторые из них с исходным кодом. Всегда проще использовать чужой опыт.
-
Так я и пришел на сайт за опытом ;) На международных вообще какой то дегресс.
-
> Спасибо! Все работает. И даже 3 окна. У тебя ж окно своё, родное, можно без OldProc и UserData: {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils, Generics.collections, Classes, Windows, Messages;
type TWindow64 = class protected FHandle: HWND; FParent: HWND; FStyle: dword; FStyleEx: dword; class var FWndClassEx: TWndClassEx; class var FClassRegistered: Boolean; private procedure Process(Msg: NativeInt; WParam: WParam; LParam: LParam); class function WndProc(Wnd:HWND; Msg:NativeInt; WParam:WParam; LParam:LParam): LResult; static; stdcall; public class var Wnds: TList<TWindow64>; property Handle: HWND read FHandle; constructor Create(aParent:HWND); destructor Destroy; override; class destructor Dtor; end;
class function TWindow64.WndProc(Wnd: HWND; Msg: NativeInt; WParam: WParam; LParam: LParam): LResult; var Obj:TWindow64; begin Writeln(Format('Wnd:%x Msg:%u lw:%u lp:%u', [wnd, msg, wParam, lParam])); //for debug
if (Wnds<>nil) then for Obj in Wnds do if (Obj.FHandle = Wnd) then case Msg of WM_MOUSEFIRST..WM_MOUSELAST: Obj.Process(Msg, WParam, LParam); WM_CLOSE: begin Obj.Free; if (Wnds = nil) then PostQuitMessage(0); end; end;
Result := DefWindowProc(Wnd, Msg ,wParam, lParam); end;
constructor TWindow64.Create(aParent:HWND); begin inherited Create;
if not FClassRegistered then begin //Заполняем класс FWndClassEx.cbSize := SizeOf(FWndClassEx); FWndClassEx.style := WS_EX_CONTROLPARENT; FWndClassEx.lpfnWndProc := @WndProc; FWndClassEx.cbClsExtra := 0; FWndClassEx.cbWndExtra := 0; FWndClassEx.hInstance := HInstance; FWndClassEx.hIcon := 0; FWndClassEx.hCursor := 0; FWndClassEx.hbrBackground := GetStockObject(DKGRAY_BRUSH); FWndClassEx.lpszMenuName := nil; FWndClassEx.lpszClassName := PChar('TWindow64'); FWndClassEx.hIconSm := 0; //Регистрируем класс if (RegisterClassEx(FWndClassEx) <> 0) then FClassRegistered := True else raise Exception.Create(Format('TWindow64: Класс не зарегестрирован. Ошибка: %d',[GetLastError()])); end; //Стиль окна FStyleEx := WS_EX_COMPOSITED; FStyle := WS_TILEDWINDOW; //Создаем окно FHandle := Windows.CreateWindowEx(FStyleEx, FWndClassEx.lpszClassName,FWndClassEx.lpszClassName, FStyle, 0, 0, 800, 600, 0, 0, HInstance, nil);
if (FHandle <> 0) then begin FParent := AParent; if (Wnds = nil) then Wnds := TList<TWindow64>.Create; Wnds.Add(Self); end else raise Exception.Create(Format('TWindow64: Окно не создано. Ошибка: %d', [GetLastError()])); end;
destructor TWindow64.Destroy; begin if ( Wnds <> nil ) then begin Wnds.Remove(Self); if ( Wnds.Count = 0 ) then FreeAndNil(Wnds); end;
inherited Destroy; end;
class destructor TWindow64.Dtor; begin if ( FClassRegistered ) then FClassRegistered := not UnregisterClass(FWndClassEx.lpszClassName, FWndClassEx.hInstance); end;
procedure TWindow64.Process(Msg: NativeInt; WParam: WParam; LParam: LParam); begin // to do ... end;
//-------------------------------------------------------------------------------------------------- var Msg: tagMsg; Obj:TWindow64; i:Integer; begin try for i:= 1 to 3 do TWindow64.Create(0);
if (Obj.Wnds<>nil) then begin for Obj in Obj.Wnds do with Obj do begin SetWindowText(Handle, Format('Заголовок %d',[i+1])); SetWindowPos(Handle, 0, i*100+100, i*100+100, 800, 600, SWP_SHOWWINDOW); Inc(i); end;
while GetMessage(Msg, 0, 0, 0) do if (Msg.message <> WM_QUIT) then DispatchMessage(Msg) // => TWindow64.WndProc else Break; end;
except on E: Exception do begin Writeln(E.ClassName, ': ', E.Message); Readln; end; end; end. P.S. http://www.firststeps.ru/mfc/winapi/r.php?51 , 52, 53, 54.. https://msdn.microsoft.com/ru-ru/library/dd460756.aspx( http://andybor.blogspot.com/2008/06/gui.html)
-
NoUser © (23.03.17 21:30) [22]
Огромное Спасибо! На самом деле придется ретрансляцию сообщений делать через AllocWnd. По другому не получится. WM_MOUSEMOVE в невидимое окно не поступает. Печалька.
|