Problem with creating an API GUI Windows program with message loop

[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:

WParam: WParam; LParam: LParam

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]

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>"

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  [Select][+][-]

1. program WinTemplate;
2.  
3. {$apptype gui}
4.  
5. uses
6.   Windows;
7.  
8. var
9.   hMain: HWnd;
10.   ms: MSG;
11.   active: Boolean;
12.   Width, Height: Word;
13.  
14.   procedure Error(s: String);
15.   begin
16.     MessageBox(hMain, @s[1], nil, MB_OK);
17.     Halt(1);
18.   end;
19.  
20.   procedure Fail(s: String);
21.   begin
22.     MessageBox(hMain, @s[1], 'Failure', MB_OK);
23.   end;
24.  
25.   function WinProc(h: HWnd; ms: DWORD; wp: WPARAM; lp: LPARAM): LRESULT;
26.   stdcall; export;
27.   begin
28.     case ms of
29.       WM_CREATE: active := True;
30.       WM_DESTROY: active := False;
31.     end;
32.     WinProc := DefWindowProc(h, ms, wp, lp);
33.   end;
34.  
35.   procedure WinReg;
36.   var
37.     wc: WNDCLASS;
38.   begin
39.     with wc do begin
40.       Style := cs_hRedraw or cs_vRedraw;
41.       lpfnWndProc := WndProc(@WinProc);
42.       cbClsExtra := 0;
43.       cbWndExtra := 0;
44.       hInstance := System.MainInstance;
45.       hIcon := LoadIcon(hInstance, idi_Application);
46.       hCursor := LoadCursor(0, idc_Arrow);
47.       hbrBackground := COLOR_BTNSHADOW;
48.       lpszMenuName := nil;
49.       lpszClassName := 'Main';
50.     end;
51.     if RegisterClass(wc) = 0 then
52.       Error('Window Registration Failed!');
53.   end;
54.  
55.   procedure WinCreate;
56.   begin
57.     hMain := CreateWindowEx(WS_EX_APPWINDOW, 'Main', 'WinApp', WS_OVERLAPPEDWINDOW,
58.       (1024 - Width) div 2, (768 - Height) div
59.       2, Width, Height, 0, 0, System.MainInstance, nil);
60.     if hMain = 0 then
61.       Error('Window Creation Failed!');
62.     ShowWindow(hMain, SW_SHOW);
63.     UpdateWindow(hMain);
64.   end;
65.  
66.   procedure WinDestroy;
67.   begin
68.     DestroyWindow(hMain);
69.   end;
70.  
71. begin
72.   WinReg;
73.   Width := 640;
74.   Height := 480;
75.   WinCreate;
76.   repeat
77.     if PeekMessage(@ms, 0, 0, 0, 0) then begin
78.       GetMessage(@ms, 0, 0, 0);
79.       TranslateMessage(ms);
80.       DispatchMessage(ms);
81.     end;
82.   until not active;
83.   WinDestroy;
84. end.
85.  

[avra]

If you really have some reason to avoid Lazarus LCL for Windows GUI development, then you could take a look at KOL. It could save you a lot of time.

KOL - Key Objects Library is a set of objects to develop power (but small) 32 bit Windows GUI applications using Delphi but without VCL (or Free Pascal). It is distributed free of charge, with source code.

http://kolmck.net
http://kolmck.net/e_kolmck.htm

[Conrad]

Thanks for your all replies.

The following syntax: lpfnWndProc := WndProc(@WinProc) instead of previous "lpfnWndProc:=@WinProc" solved my problem.
It is a difference between TMT Pascal and Lazarus which I didn't know before (time to start reading manual 

Conrad

[marcov]

Thanks for your all replies.

The following syntax: lpfnWndProc := WndProc(@WinProc) instead of previous "lpfnWndProc:=@WinProc" solved my problem.

That is a hack. The return types don't match and you force it anyway.

It is a difference between TMT Pascal and Lazarus which I didn't know before (time to start reading manual 

Most probably it is a 32-bit vs 64-bit problem. Your TMT code wasn't entirely 64-bit clean, and my guess is that now you are using a 64-bit compiler

[Conrad]

You are absolutely right. I used 32-bit TMT pascal which is "a bit" obsolete nowadays.
In fact, I don't have much experience in 64-bit programming, but in future I would
like to convert one of my big TMT pascal projects (around 30.000 lines of code) to 64-bit platform.
That is why I'm interested in Lazarus.

Anyway, thanks for help.

Conrad

[marcov]

Study Leledumbo's 2nd post. The returnvalue should probably be LRESULT.

[Conrad]

One more question:

Now, I try to create simple dialog box with icon (both defined in external resource file and compiled with Microsoft rc.exe compiler).
Everything works fine under my old TMT Pascal but I can't get the dialog visible under Lazarus, however I can see the program running in memory.
Does Lazarus accept resource files compiled by Microsoft rc.exe compiler?

My code is below:

Code: [Select]


program Dlgbox;

{$apptype gui}

uses Windows, Messages;

{$R dlgbox.res}

var
   DialogProc : HWnd;
         Mess : TMsg;

const
  MAIN_DIALOG = 200;


function DialogPr( Dialog : HWnd; ms: DWORD; wp: Wparam; lp: Lparam ): LResult; stdcall; export;
begin
  Result:=0;
  case ms of
      WM_COMMAND : begin
                                   case LoWord( wp ) of
                                       IDOK : SendMessage( Dialog, WM_CLOSE, 0, 0 );
                                   end
                                end;
       WM_CLOSE : DestroyWindow( Dialog );
   WM_DESTROY : begin
                              PostQuitMessage( 0 );
                              Result:=0;
                           end;
    end
end;

begin
  DialogProc:=CreateDialog( hInstance, MakeIntResource( MAIN_DIALOG ), 0, @DialogPr );
  SendMessage( DialogProc, WM_SETICON, ICON_SMALL OR ICON_BIG, LoadIcon( hInstance, MAKEINTRESOURCE( 100 )) );
  ShowWindow( DialogProc, SW_RESTORE );
  repeat
    while GetMessage( @Mess, 0, 0, 0 ) do
      begin
        TranslateMessage( Mess );
        DispatchMessage( Mess );
      end;
  until Mess.Message = WM_QUIT;
end.   

==============

and resource file:


#include "afxres.h"

100 ICON "favourite.ico"

200 DIALOG MOVEABLE LOADONCALL DISCARDABLE 335, 123, 408, 102
STYLE DS_FIXEDSYS |DS_SETFONT |WS_POPUP |WS_VISIBLE |WS_SYSMENU |WS_THICKFRAME |WS_MAXIMIZEBOX |WS_MINIMIZEBOX |WS_CAPTION
CAPTION "My Dialog Box"
FONT 8, "Ms Shell Dlg"
LANGUAGE LANG_NEUTRAL, 0

BEGIN
  CONTROL "Close",IDOK,"BUTTON",BS_DEFPUSHBUTTON |BS_VCENTER |BS_CENTER |WS_CHILD |WS_TABSTOP |WS_VISIBLE ,175,70,73,23
END



Conrad

[felipemdc]

Does Lazarus accept resource files compiled by Microsoft rc.exe compiler?

No. Pass the rc file for Free Pascal and it will use windres to compile it:

{$R dlgbox.rc}