Оригинал Поиск Дополнительно Вход
ДомойОсновная Компоненты FreePascal Начинающим KOL Игры Corba Media Журнал WinAPI Сети Прочее Базы .Net
Конференция "WinAPI" » CreateWindowEx
[1 - 20 из 24]<< < 1 2 > >>
  
  • dmk © (22.03.17 06:37) [0]
    Всем привет!

    Пытаюсь создать окно, но почему то не выходит. Может кто-нибудь подскажет?
    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;

  • Rouse_ © (22.03.17 10:27) [1]
    смотри реализацию AllocateHWnd()
  • Игорь Шевченко © (22.03.17 10:42) [2]
    GetLastError наше все
  • dmk © (22.03.17 13:22) [3]
    >Rouse_ ©   (22.03.17 10:27) [1]
    Так оттуда и скопировал.

    >Игорь Шевченко ©   (22.03.17 10:42) [2]
    GetLastError говорит 06h – IVALIDE_HANDLE.

    Только вот какой непонятно. Может HInstance?
  • dmk © (22.03.17 13:23) [4]
    Стренно, это вообще совет MS сделать пустое окно с выборкой только сообщений.
    Самое интересное, что в таком виде никакое окно не создается ;(
  • Игорь Шевченко © (22.03.17 19:31) [5]
    dmk ©   (22.03.17 13:22) [3]

    Ты создаешь Wnd, а проверяешь FHandle.
    Странный какой-то код.
  • dmk © (22.03.17 19:49) [6]
    >Странный какой-то код.
    Да это отладочный. Там точка останова на CreateWindowEx стоит. FHandle пока не нужен.
  • dmk © (22.03.17 19:58) [7]
    Вот так окно создается, но 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;
  • dmk © (22.03.17 20:00) [8]
    Процедуры вызова объявлены так:

    FCallWndProc: TCallWndProc;
    FPrevWndProc: TFarProc;

    type TCallWndProc = function(Wnd: HWND; Msg: integer; WParam: WParam; LParam: LParam): LResult of object; stdcall;
  • Игорь Шевченко © (22.03.17 21:19) [9]

    > Никто не знает откуда взять адрес предыдущей процедуры?


    FPrevWndProc := Pointer(GetWindowLongPtr(AParent, GWL_WNDPROC));

    все правильно. Только зачем ты пытаешься вызвать процедуру чужого оконного класса ? Это в общем случае запрещено.
  • NoUser © (22.03.17 21:34) [10]
    > Никто не знает откуда взять адрес предыдущей "оконной" процедуры?

    а какого окна?  -> 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;

    а это значит, что вызывающий эту функцию код должен допередать туда первым(нулевым) скрытым параметром ещё и адрес объекта.

    и как такое сделать - уже озвучено, или заюзай глобальною/классовою переменную. Для одного окошка прокатит.
  • dmk © (22.03.17 21:38) [11]
    >Игорь Шевченко ©   (22.03.17 21:19) [9]
    Игорь, просто я не знаю механизм работы данной процедуры.
    Что за OldProc? Как ее получить? В MSDN это не объясняется.
    В примерах везде ее получают разными способами, но ничего не работает.
  • dmk © (22.03.17 21:45) [12]
    >только тут ошибочка, нужно так:
    >FWndClassEx.lpfnWndProc := Pointer(FCallWndProc);
    Так не принимает, а с @ принимает и сразу после создания окна влетает в оконную функцию.
  • dmk © (22.03.17 21:55) [13]
    >а если нового, то вот :
    >FWndClassEx.lpfnWndProc := @FCallWndProc;

    Да, нового. Пришлось делать создание окна, пусть и пустого.

    Все там нормально передается. Соглашение принимается. Окно создается.
    Если DefWindowProc использовать то MSG всегда нулю равен.
    Если CallWindowProc, то AV выскакивает.
  • NoUser © (22.03.17 22:06) [14]
    >  а с @ принимает
    был не прав, спутал с @@ (прямым углом)

    > влетает в оконную функцию.
    =
    > http://pda.delphimaster.net/?id=1490126076&n=5 dmk ©   (22.03.17 02:13) [3]

    > Проходит один цикл и виснет.
    > Если не делать частью класса - все в порядке, но переменные  класса не видны.
    > Можно сделать вызов, если ClientWindowProc часть класса?


    Там несколько вариантов ответов предложено тчк
  • Игорь Шевченко © (22.03.17 22:22) [15]
    dmk ©   (22.03.17 21:38) [11]

    Я до сих пор не понимаю, чего ты хочешь сделать. Отправлять произвольному классу Delphi оконные сообщения ? А зачем ?
    Произвольные классы Delphi для этого не предназначены. Оконные сообщения приходят окнам и обрабатываются оконными процедурами оконных классов, что не обрабатывается в процедурах, обрабатывается в процедуре по умолчанию (DefWindowProc)
  • Игорь Шевченко © (22.03.17 22:45) [16]
    dmk ©   (22.03.17 21:38) [11]

    Если ты хочешь сделать аналог того, как форма посылает сообщения наследникам TGraphicControl, у которых нет окон, то у любого наследника TObject есть метод Dispatch.

    http://docwiki.embarcadero.com/Libraries/Seattle/en/System.TObject.Dispatch
  • dmk © (23.03.17 00:14) [17]
    Игорь Шевченко ©   (22.03.17 22:45) [16]
    Да это просто графические объекты со своими свойствами. Типа TButton или CheckBox, только без VCL-нагромождений и наследований. У меня свой ZBuffer и DBuffer. В нем все рисуется. Windows не дает досутп к видеопамяти, поэтому рисую в памяти, как в старые досовские времена. Алгоритмы свои. Объекты свои. От винды нужен только ввод-вывод: мышь, дисплей, хдд и т.п. Поэтому делаю абстракцию от WinApi и VCL. Минимальная привязка. Только к процессору. Библиотека типа директ икс или GDI+, только без железа.
    Мне скорости и так пока хватает. Вы же помните DOS Игорь? Вот. Я просто устал с окнами бороться и написал свое ;)
  • dmk © (23.03.17 00:16) [18]
    Вот мне нужны например скроллы свои. Написать их несложно, а сообщения от мыши где? Только в оконном классе. Вот и бъюсь с этим.
  • dmk © (23.03.17 02:41) [19]
    >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.
[1 - 20 из 24]<< < 1 2 > >>
 
Конференция "WinAPI" » CreateWindowEx
ДомойОсновная Компоненты FreePascal Начинающим KOL Игры Corba Media Журнал WinAPI Сети Прочее Базы .Net
Есть новые Нет новых   [118429   +13][b:0][p:0.002]