WINAPI functions are working but their output remains invisible
lazarus / 67-Windows

----------------------------------------------------------------------
Pieter · 2022-07-15 15:30

I brought a classical Pascal program (no objects) to Lazarus 2.2.2,
running on an Intel i5 laptop under Windows 11 Pro. It gets its user
input and output by means of a window created by the WINAPI function
CreateWindow and related WINAPI functions. In this way, the program
can migrate to another OS by replacing these input and output
functions. In Lazarus, this seems to work properly, if you trace the
program, however, no output is visible. Below, I inserted a small
program that illustrates the problem. The console output shows the
effect of the SendMessage command but the intended window is
completely absent. What did I miss?

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
SimpleTest3;{$mode objfpc}{$H+} uses  Classes, Windows, Messages,
SysUtils ;const  MyClassName = 'JustAnotherWindow'; 
DefFntSize=12;type  Tsem =(dflt,dbg,key_prw);var{test specif. vars} i:
integer;  mb_Ok: LongWord;  ic: integer;  hWindow: HWnd;  TheFont1:
HFont;  TheColor: DWORD; function WindowProc(Window: HWnd; AMessage,
WParam,                    LParam: Longint): Longint; stdcall;
export;  var     dc : hdc;     ps : Tpaintstruct;     r : rect;   
 bres, speckey:boolean;     si:integer;     as2:ansistring;     sem:
Tsem;begin  WindowProc := 0; ic:=succ(ic); sem:=dbg;  case AMessage
of    wm_paint:      begin         InvalidateRgn(Window,0,false);    
   dc:=BeginPaint(Window,ps);         case sem of         dflt:;     
  dbg:           begin             GetClientRect(Window,@r);         
  DrawText(dc,'Hello world by Free Pascal',-1,@r,           
 DT_SINGLELINE or DT_CENTER or DT_VCENTER);             writeln('Best
wishes from FP')          end {dbg};         key_prw:;         end
{case sem};         EndPaint(Window,ps);          Exit;      end;   
wm_Destroy:      begin        PostQuitMessage(0);         Exit;     
end;  end {case};  WindowProc := DefWindowProc(Window, AMessage,
WParam, LParam);end; { Register the Window Class }function
WinRegister: Boolean;var  WindowClass: WndClass;begin 
WindowClass.Style := cs_hRedraw or cs_vRedraw; 
WindowClass.lpfnWndProc := WndProc(@WindowProc); 
WindowClass.cbClsExtra := 0;  WindowClass.cbWndExtra := 0; 
WindowClass.hInstance := system.MainInstance;  WindowClass.hIcon :=
LoadIcon(0, idi_Application);  WindowClass.hCursor := LoadCursor(0,
idc_Arrow);  WindowClass.hbrBackground :=
GetStockObject(WHITE_BRUSH);  WindowClass.lpszMenuName := pchar(''); 
WindowClass.lpszClassName := MyClassName;   {Result} WinRegister :=
RegisterClass(WindowClass) <> 0;end; procedure FontSize(var
TLF:TLOGFONT;Height:integer; bold:boolean);begin  with TLF do  begin 
 lfHeight         := Height;                // Default logical height
of font    lfWidth          := 0;                // Default logical
average character width    lfEscapement     := 0;                //
angle of escapement    lfOrientation    := 0;                // base-
line orientation angle    if bold then lfWeight:=800 else lfWeight:=
FW_NORMAL;        // font weight    lfItalic         := 0;           
   // italic attribute flag    lfUnderline      := 0;              
 // underline attribute flag    lfStrikeOut      := 0;              
 // strikeout attribute flag    lfCharSet        := DEFAULT_CHARSET;
 // character set identifier    lfOutPrecision   :=
OUT_DEFAULT_PRECIS;  // output precision    lfClipPrecision  :=
CLIP_DEFAULT_PRECIS; // clipping precision    lfQuality        :=
DEFAULT_QUALITY;     // output quality    lfPitchAndFamily :=
DEFAULT_PITCH;    // pitch and family    Strcopy(lfFaceName,'Courier
New');    // pointer to typeface name string  end;  {==}end
{FontSize}; function WinCreate: HWnd;var  hWaux: HWnd;
TheLogFont:TLogFont; begin  hWaux := CreateWindow(                   
   MyClassName, {Defined in WinRegister}                       
'aWindow', {Name of window}                       
ws_OverlappedWindow,  {Style}                        cw_UseDefault,
{X}                        cw_UseDefault, {Y}                       
cw_UseDefault, {width}                        cw_UseDefault,
{heighth}                        0, {Parent}                        0,
{Menu}                        system.MainInstance, {hInstance}       
               nil); {lpVOID}   if hWaux <> 0 then  begin   
{Selectfont;} FontSize(TheLogFont,DefFntSize,false);     TheColor :=
GetSysColor(COLOR_WINDOWTEXT);     TheFont1  :=
CreateFontIndirect(TheLogFont);   
 SendMessage(hWaux,WM_SETFONT,TheFont1,1);     ShowWindow(hWaux,
CmdShow);     UpdateWindow(hWaux);   end;   {Result} WinCreate :=
hWaux;end; Procedure DestroyWindow;var cont: boolean;begin 
DeleteObject(TheFont1);  sendmessage(hWindow,wm_Destroy,0,0);end
{destroywindow}; begin  mb_Ok := 0; if Winregister then   
 hWindow:=WinCreate;  sendmessage(hWindow,wm_paint,0,0); 
DestroyWindow;end.

----------------------------------------------------------------------
dseligo · 2022-07-15 15:56

Quote from: Pieter on July 15, 2022, 05:30:06 pmI brought a classical
Pascal program (no objects) to Lazarus 2.2.2, running on an Intel i5
laptop under Windows 11 Pro. It gets its user input and output by
means of a window created by the WINAPI function CreateWindow and
related WINAPI functions. In this way, the program can migrate to
another OS by replacing these input and output functions.
I can't help you with your code, but if you want to migrate your
program to another OS, why don't you just use Lazarus' forms? Then you
don't have to change anything in your code. You just compile it in
another OS, or you can also crosscompile to another OS.

----------------------------------------------------------------------
440bx · 2022-07-15 16:18

Quote from: Pieter on July 15, 2022, 05:30:06 pmBelow, I inserted a
small program that illustrates the problem. The console output shows
the effect of the SendMessage command but the intended window is
completely absent. What did I miss?
There are a number of deficiencies in the program you posted.  For
instance, calling InvalidateRgn when processing a WM_PAINT is not a
good idea because that will generate another WM_PAINT.  Using
WM_SETFONT to the window procedure you showed isn't going to cause the
window to use that font.  The WM_PAINT handler isn't selecting that
font in the WM_PAINT and the message loop ignores the WM_SETFONT.

Those are just some of the deficiencies I see just having a quick look
at that code. 

I recommend you look at the code found in the following examples, they
are pure Windows API
https://forum.lazarus.freepascal.org/index.php/topic,52984.0.html

That will be a good place for you to start.

HTH.

----------------------------------------------------------------------
Thaddy · 2022-07-15 16:44

Note that this very old code should work in D7 (although I had some
issue that I needed to address: too many incorrect @). But I agree
about where to put the invalidatergn code. NOT in wm_paint - but it is
also harmless-.
But then again, when the code is processing a message.... This is
sequential and invalidateXXX just sets a flag and does not force a
repaint, it schedules a repaint..

----------------------------------------------------------------------
BobDog · 2022-07-15 19:56

Quote from: Pieter on July 15, 2022, 05:30:06 pmI brought a classical
Pascal program (no objects) to Lazarus 2.2.2, running on an Intel i5
laptop under Windows 11 Pro. It gets its user input and output by
means of a window created by the WINAPI function CreateWindow and
related WINAPI functions. In this way, the program can migrate to
another OS by replacing these input and output functions. In Lazarus,
this seems to work properly, if you trace the program, however, no
output is visible. Below, I inserted a small program that illustrates
the problem. The console output shows the effect of the SendMessage
command but the intended window is completely absent. What did I miss?

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
SimpleTest3;{$mode objfpc}{$H+} uses  Classes, Windows, Messages,
SysUtils ;const  MyClassName = 'JustAnotherWindow'; 
DefFntSize=12;type  Tsem =(dflt,dbg,key_prw);var{test specif. vars} i:
integer;  mb_Ok: LongWord;  ic: integer;  hWindow: HWnd;  TheFont1:
HFont;  TheColor: DWORD; function WindowProc(Window: HWnd; AMessage,
WParam,                    LParam: Longint): Longint; stdcall;
export;  var     dc : hdc;     ps : Tpaintstruct;     r : rect;   
 bres, speckey:boolean;     si:integer;     as2:ansistring;     sem:
Tsem;begin  WindowProc := 0; ic:=succ(ic); sem:=dbg;  case AMessage
of    wm_paint:      begin         InvalidateRgn(Window,0,false);    
   dc:=BeginPaint(Window,ps);         case sem of         dflt:;     
  dbg:           begin             GetClientRect(Window,@r);         
  DrawText(dc,'Hello world by Free Pascal',-1,@r,           
 DT_SINGLELINE or DT_CENTER or DT_VCENTER);             writeln('Best
wishes from FP')          end {dbg};         key_prw:;         end
{case sem};         EndPaint(Window,ps);          Exit;      end;   
wm_Destroy:      begin        PostQuitMessage(0);         Exit;     
end;  end {case};  WindowProc := DefWindowProc(Window, AMessage,
WParam, LParam);end; { Register the Window Class }function
WinRegister: Boolean;var  WindowClass: WndClass;begin 
WindowClass.Style := cs_hRedraw or cs_vRedraw; 
WindowClass.lpfnWndProc := WndProc(@WindowProc); 
WindowClass.cbClsExtra := 0;  WindowClass.cbWndExtra := 0; 
WindowClass.hInstance := system.MainInstance;  WindowClass.hIcon :=
LoadIcon(0, idi_Application);  WindowClass.hCursor := LoadCursor(0,
idc_Arrow);  WindowClass.hbrBackground :=
GetStockObject(WHITE_BRUSH);  WindowClass.lpszMenuName := pchar(''); 
WindowClass.lpszClassName := MyClassName;   {Result} WinRegister :=
RegisterClass(WindowClass) <> 0;end; procedure FontSize(var
TLF:TLOGFONT;Height:integer; bold:boolean);begin  with TLF do  begin 
 lfHeight         := Height;                // Default logical height
of font    lfWidth          := 0;                // Default logical
average character width    lfEscapement     := 0;                //
angle of escapement    lfOrientation    := 0;                // base-
line orientation angle    if bold then lfWeight:=800 else lfWeight:=
FW_NORMAL;        // font weight    lfItalic         := 0;           
   // italic attribute flag    lfUnderline      := 0;              
 // underline attribute flag    lfStrikeOut      := 0;              
 // strikeout attribute flag    lfCharSet        := DEFAULT_CHARSET;
 // character set identifier    lfOutPrecision   :=
OUT_DEFAULT_PRECIS;  // output precision    lfClipPrecision  :=
CLIP_DEFAULT_PRECIS; // clipping precision    lfQuality        :=
DEFAULT_QUALITY;     // output quality    lfPitchAndFamily :=
DEFAULT_PITCH;    // pitch and family    Strcopy(lfFaceName,'Courier
New');    // pointer to typeface name string  end;  {==}end
{FontSize}; function WinCreate: HWnd;var  hWaux: HWnd;
TheLogFont:TLogFont; begin  hWaux := CreateWindow(                   
   MyClassName, {Defined in WinRegister}                       
'aWindow', {Name of window}                       
ws_OverlappedWindow,  {Style}                        cw_UseDefault,
{X}                        cw_UseDefault, {Y}                       
cw_UseDefault, {width}                        cw_UseDefault,
{heighth}                        0, {Parent}                        0,
{Menu}                        system.MainInstance, {hInstance}       
               nil); {lpVOID}   if hWaux <> 0 then  begin   
{Selectfont;} FontSize(TheLogFont,DefFntSize,false);     TheColor :=
GetSysColor(COLOR_WINDOWTEXT);     TheFont1  :=
CreateFontIndirect(TheLogFont);   
 SendMessage(hWaux,WM_SETFONT,TheFont1,1);     ShowWindow(hWaux,
CmdShow);     UpdateWindow(hWaux);   end;   {Result} WinCreate :=
hWaux;end; Procedure DestroyWindow;var cont: boolean;begin 
DeleteObject(TheFont1);  sendmessage(hWindow,wm_Destroy,0,0);end
{destroywindow}; begin  mb_Ok := 0; if Winregister then   
 hWindow:=WinCreate;  sendmessage(hWindow,wm_paint,0,0); 
DestroyWindow;end. You need a while loop (line 133 ish)
Repeat your code:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
SimpleTest3;{$mode objfpc}{$H+} uses  Classes, Windows, Messages,
SysUtils ;const  MyClassName = 'JustAnotherWindow'; 
DefFntSize=12;type  Tsem =(dflt,dbg,key_prw);var{test specif. vars} i:
integer;  mb_Ok: LongWord;  ic: integer;  hWindow: HWnd;  TheFont1:
HFont;  TheColor: DWORD; function WindowProc(Window: HWnd; AMessage,
WParam,                    LParam: Longint): Longint; stdcall;
export;  var     dc : hdc;     ps : Tpaintstruct;     r : rect;   
 bres, speckey:boolean;     si:integer;     as2:ansistring;     sem:
Tsem;begin  WindowProc := 0; ic:=succ(ic); sem:=dbg;  case AMessage
of    wm_paint:      begin         InvalidateRgn(Window,0,false);    
   dc:=BeginPaint(Window,ps);         case sem of         dflt:;     
  dbg:           begin             GetClientRect(Window,@r);         
  DrawText(dc,'Hello world by Free Pascal',-1,@r,           
 DT_SINGLELINE or DT_CENTER or DT_VCENTER);             writeln('Best
wishes from FP')          end {dbg};         key_prw:;         end
{case sem};         EndPaint(Window,ps);          Exit;      end;   
wm_Destroy:      begin        PostQuitMessage(0);         Exit;     
end;  end {case};  WindowProc := DefWindowProc(Window, AMessage,
WParam, LParam);end; { Register the Window Class }function
WinRegister: Boolean;var  WindowClass: WndClass;begin 
WindowClass.Style := cs_hRedraw or cs_vRedraw; 
WindowClass.lpfnWndProc := WndProc(@WindowProc); 
WindowClass.cbClsExtra := 0;  WindowClass.cbWndExtra := 0; 
WindowClass.hInstance := system.MainInstance;  WindowClass.hIcon :=
LoadIcon(0, idi_Application);  WindowClass.hCursor := LoadCursor(0,
idc_Arrow);  WindowClass.hbrBackground :=
GetStockObject(WHITE_BRUSH);  WindowClass.lpszMenuName := pchar(''); 
WindowClass.lpszClassName := pchar(MyClassName);   {Result}
WinRegister := RegisterClass(WindowClass) <> 0;end; procedure
FontSize(var TLF:TLOGFONT;Height:integer; bold:boolean);begin  with
TLF do  begin    lfHeight         := Height;                // Default
logical height of font    lfWidth          := 0;                //
Default logical average character width    lfEscapement     := 0;    
          // angle of escapement    lfOrientation    := 0;           
   // base-line orientation angle    if bold then lfWeight:=800 else
lfWeight:= FW_NORMAL;        // font weight    lfItalic         := 0;
              // italic attribute flag    lfUnderline      := 0;     
         // underline attribute flag    lfStrikeOut      := 0;       
       // strikeout attribute flag    lfCharSet        :=
DEFAULT_CHARSET;  // character set identifier    lfOutPrecision   :=
OUT_DEFAULT_PRECIS;  // output precision    lfClipPrecision  :=
CLIP_DEFAULT_PRECIS; // clipping precision    lfQuality        :=
DEFAULT_QUALITY;     // output quality    lfPitchAndFamily :=
DEFAULT_PITCH;    // pitch and family    Strcopy(lfFaceName,'Courier
New');    // pointer to typeface name string  end;  {==}end
{FontSize}; function WinCreate: HWnd;var  hWaux: HWnd;
TheLogFont:TLogFont; emsg:msg;begin  hWaux := CreateWindow(          
            MyClassName, {Defined in WinRegister}                    
  'aWindow', {Name of window}                       
ws_OverlappedWindow,  {Style}                        cw_UseDefault,
{X}                        cw_UseDefault, {Y}                       
cw_UseDefault, {width}                        cw_UseDefault,
{heighth}                        0, {Parent}                        0,
{Menu}                        system.MainInstance, {hInstance}       
               nil); {lpVOID}   if hWaux <> 0 then  begin   
{Selectfont;} FontSize(TheLogFont,DefFntSize,false);     TheColor :=
GetSysColor(COLOR_WINDOWTEXT);     TheFont1  :=
CreateFontIndirect(TheLogFont);   
 SendMessage(hWaux,WM_SETFONT,TheFont1,1);     ShowWindow(hWaux,
CmdShow);     UpdateWindow(hWaux);   end;     {Result} WinCreate :=
hWaux;While (GetMessage(@eMsg, 0, 0, 0) <> FALSE) dobegin   
TranslateMessage(@eMsg);   
DispatchMessage(@eMsg);end;  end; Procedure DestroyWindow;var cont:
boolean;begin  DeleteObject(TheFont1); 
sendmessage(hWindow,wm_Destroy,0,0);end {destroywindow}; begin  mb_Ok
:= 0; if Winregister then     hWindow:=WinCreate; 
sendmessage(hWindow,wm_paint,0,0);  DestroyWindow;end.

----------------------------------------------------------------------
Pieter · 2022-07-18 07:54

Thanks! This is all very useful information to go forward.

----------------------------------------------------------------------
Pieter · 2022-07-25 10:05

Quote from: dseligo on July 15, 2022, 05:56:30 pmQuote from: Pieter on
July 15, 2022, 05:30:06 pmI brought a classical Pascal program (no
objects) to Lazarus 2.2.2, running on an Intel i5 laptop under Windows
11 Pro. It gets its user input and output by means of a window created
by the WINAPI function CreateWindow and related WINAPI functions. In
this way, the program can migrate to another OS by replacing these
input and output functions.
I can't help you with your code, but if you want to migrate your
program to another OS, why don't you just use Lazarus' forms? Then you
don't have to change anything in your code. You just compile it in
another OS, or you can also crosscompile to another OS.

Continuing your proposal, I made the following code, i.e. a classical
console program including a form that should serve for the input and
output.

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
FrmInCnsl; {$mode objfpc}{$H+} uses  {$IFDEF UNIX}  cthreads, 
{$ENDIF}  Classes, Interfaces, // this includes the LCL widgetset 
Forms, Windows, MyUnit1  { you can add units after this }; // {$R
*.res}  not necessary?var  cont: boolean;begin 
Application.Initialize;  writeln('Start'); 
Application.CreateForm(TForm1, Form1);  writeln('Form Created'); 
Form1.Show;  Form1.Canvas.TextOut(1,1,'My Text');  readln;end {main
program}.  {*** unit ***}  unit MyUnit1; {$mode
ObjFPC}{$H+} interface uses  Classes, SysUtils, Forms, Controls,
Graphics, Dialogs; type   { TForm1 }   TForm1 = class(TForm)   
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift:
TShiftState);  private   public   end; var  Form1:
TForm1; implementation {$R *.lfm} { TForm1 } procedure
TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState 
);begin  writeln('key:', Key:2);end; end.    

As you can see, output is not a problem but how can I make the form
react to keystrokes? The form has the procedure FormKeyDown, which
should do this. My problem is how to tell this to the form in a
classical pascal program. So, a want a piece of code that transfers
control from a classical main program to the form, that then waits for
a keystroke. When the keystroke has happened, control should go back
to the place in the main program where the form was activated. Could
you show me the way?

----------------------------------------------------------------------
Thaddy · 2022-07-25 10:51

Under windows add {$apptype console} or even beter {$ifdef
mswindows}{$apptype console}{$endif} at the top of your program. That
gives you a visible console output and no error 105. Also add a readln
at the very last line of your project code.
That can also be ifdeffed, because on most other platforms this is not
necessary, at least in the IDE.

----------------------------------------------------------------------
Pieter · 2022-07-25 11:33

Quote from: Thaddy on July 25, 2022, 12:51:59 pmUnder windows add
{$apptype console} or even beter {$ifdef mswindows}{$apptype
console}{$endif} at the top of your program. That gives you a visible
console output and no error 105. Also add a readln at the very last
line of your project code.
That can also be ifdeffed, because on most other platforms this is not
necessary, at least in the IDE.
This is not the problem. I can already see the console, no need for
APPTYPE CONSOLE, and readln is already present at the last position. I
want to activate the form so that entered key  strokes are displayed
in the form

----------------------------------------------------------------------
Pieter · 2022-08-02 14:37

Quote from: 440bx on July 15, 2022, 06:18:23 pmQuote from: Pieter on
July 15, 2022, 05:30:06 pmBelow, I inserted a small program that
illustrates the problem. The console output shows the effect of the
SendMessage command but the intended window is completely absent. What
did I miss?
There are a number of deficiencies in the program you posted.  For
instance, calling InvalidateRgn when processing a WM_PAINT is not a
good idea because that will generate another WM_PAINT.  Using
WM_SETFONT to the window procedure you showed isn't going to cause the
window to use that font.  The WM_PAINT handler isn't selecting that
font in the WM_PAINT and the message loop ignores the WM_SETFONT.

Those are just some of the deficiencies I see just having a quick look
at that code. 

I recommend you look at the code found in the following examples, they
are pure Windows API
https://forum.lazarus.freepascal.org/index.php/topic,52984.0.html

That will be a good place for you to start.

HTH.

Thanks, based on your GetClientRectangle example in https://forum.laza
rus.freepascal.org/index.php/topic,52902.msg390865.html#msg390865, I
could get my code to work.