Forum > Windows

Problem with creating an API GUI Windows program with message loop

(1/3) > >>

Conrad:
Hi all,
I'm new member of this forum. Previously I used TMT Pascal but now I decided to try Lazarus environment.
As I usually wrote my Windows GUI programs using "clean" WINAPI functions and message loop, I would like to know if it is possible in Lazarus, too.
I have written the following code:

program Window1; uses Windows, Strings, Messages;
  var   Msg : TMsg;
         Wnd : HWnd;
           wc : TWndClass;

function WinProc(Window: HWND; Mess: UInt; WParam: WParam; LParam: LParam ): UInt; stdcall;
begin
  Result := 0;
  case Mess of
  WM_CLOSE: Result :=WinProc(Window, Mess, WParam, LParam);
  WM_DESTROY: PostQuitMessage(0);
  else
    Result:=WinProc(Window, Mess, WParam, LParam);
  end;
end;

begin 
  FillChar( wc, SizeOf( wc ), 0 );
  with wc do
  begin
    style:=CS_HREDRAW + CS_VREDRAW;
    lpfnWndProc:=@WinProc;
    cbClsExtra:=0;
    cbWndExtra:=0;
    hInstance:=System.hInstance;
    hCursor:=LoadCursor( THandle( NIL ), IDC_ARROW );
    hbrBackGround := COLOR_WINDOW + 1;
    lpszMenuName:=nil;
    lpszClassName:='First GUI App';
  end;
  if RegisterClass( wc ) = 0 then Exit;

  Wnd:=CreateWindow( wc.lpszClassName, 'ListView', WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 500, 400, 0, 0, HInstance, nil );
   repeat
    while GetMessage( Msg, 0, 0, 0 ) do
      begin
        TranslateMessage( Msg );
        DispatchMessage( Msg );
      end;
  until Msg.Message = WM_QUIT;
end.


For the line:  lpfnWndProc:=@WinProc;, the compiler reports the following error:
 
window1.lpr(29,18) Error: Incompatible types: got "<address of function(QWord,LongWord,Int64,Int64):DWord;StdCall>" expected "<procedure variable type of function(QWord,LongWord,Int64,Int64):Int64;StdCall>"


Can anybody help me with this problem?

Thanks in advance

Conrad

Leledumbo:
Window procedure return value is HRESULT, not UINT. and:

--- Quote ---WParam: WParam; LParam: LParam
--- End quote ---
does it still work? it's supposed to be an error due to duplicated identifier.

Conrad:
Unfortunately, problem still exists.
I forgot to mention that above code works fine under TMT (Framework) Pascal.

Conrad

felipemdc:

--- Quote from: Conrad on September 04, 2011, 05:19:47 pm ---function WinProc(Window: HWND; Mess: UInt; WParam: WParam; LParam: LParam ): UInt; stdcall;
...
window1.lpr(29,18) Error: Incompatible types: got "<address of function(QWord,LongWord,Int64,Int64):DWord;StdCall>" expected "<procedure variable type of function(QWord,LongWord,Int64,Int64):Int64;StdCall>"

--- End quote ---

The error is cristal clear in the compiler message ... the result should be pointer sized and you are passing 4 bytes. Try:

function WinProc(Window: HWND; Mess: UInt; WParam: WParam; LParam: LParam ): PtrUInt; stdcall;

Leledumbo:
Sorry, it should be LRESULT instead of HRESULT. Here's my old pure Windows API code that compiles and works:

--- Code: Text  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---program WinTemplate; {$apptype gui} uses  Windows; var  hMain: HWnd;  ms: MSG;  active: Boolean;  Width, Height: Word;   procedure Error(s: String);  begin    MessageBox(hMain, @s[1], nil, MB_OK);    Halt(1);  end;   procedure Fail(s: String);  begin    MessageBox(hMain, @s[1], 'Failure', MB_OK);  end;   function WinProc(h: HWnd; ms: DWORD; wp: WPARAM; lp: LPARAM): LRESULT;  stdcall; export;  begin    case ms of      WM_CREATE: active := True;      WM_DESTROY: active := False;    end;    WinProc := DefWindowProc(h, ms, wp, lp);  end;   procedure WinReg;  var    wc: WNDCLASS;  begin    with wc do begin      Style := cs_hRedraw or cs_vRedraw;      lpfnWndProc := WndProc(@WinProc);      cbClsExtra := 0;      cbWndExtra := 0;      hInstance := System.MainInstance;      hIcon := LoadIcon(hInstance, idi_Application);      hCursor := LoadCursor(0, idc_Arrow);      hbrBackground := COLOR_BTNSHADOW;      lpszMenuName := nil;      lpszClassName := 'Main';    end;    if RegisterClass(wc) = 0 then      Error('Window Registration Failed!');  end;   procedure WinCreate;  begin    hMain := CreateWindowEx(WS_EX_APPWINDOW, 'Main', 'WinApp', WS_OVERLAPPEDWINDOW,      (1024 - Width) div 2, (768 - Height) div      2, Width, Height, 0, 0, System.MainInstance, nil);    if hMain = 0 then      Error('Window Creation Failed!');    ShowWindow(hMain, SW_SHOW);    UpdateWindow(hMain);  end;   procedure WinDestroy;  begin    DestroyWindow(hMain);  end; begin  WinReg;  Width := 640;  Height := 480;  WinCreate;  repeat    if PeekMessage(@ms, 0, 0, 0, 0) then begin      GetMessage(@ms, 0, 0, 0);      TranslateMessage(ms);      DispatchMessage(ms);    end;  until not active;  WinDestroy;end. 

Navigation

[0] Message Index

[#] Next page