Problems with Windows.ExtCreatePen
lazarus / 34-Windows

----------------------------------------------------------------------
Michaela Joy · 2016-07-24 15:16

Hi,
I'm working on a Windows project where I will be using the GDI and not
Graphics.pp.

So I wrote a utility function to draw a line to a DC. The problem is,
Lazarus flags this as an error, when in fact the prototype for
ExtCreatePen is incorrect.

Here's my original code.

Code: [Select]procedure DoDrawLine(X0,Y0,X1,Y1: Integer;AColor:
Colorref;AStyle: Integer = PS_SOLID;AThickness: Integer = 1;AHatch:
Integer = 0);
var
  lb: TAGLOGBRUSH;
  hPen,oPen: Cardinal;
begin
lb.lbStyle := AStyle;
lb.lbColor := AColor;
lb.lbHatch := AHatch;
hPen := Windows.ExtCreatePen(PS_GEOMETRIC,AThickness,lb,0,Nil);
oPen := Windows.SelectObject(ADC,hPen);
Windows.MoveToEx(ADC,X0,Y0,Nil);
Windows.LineTo(ADC,X1,Y1);
Windows.DeleteObject(Windows.SelectObject(ADC,oPen));
end;

This code does not compile.

However: If I change the prototype for Windows.ExtCreatePen (I did it
in my own source.) It works fine.

Here's what I did.
Code: [Select]function MyExtCreatePen(PenStyle, Width: DWORD; const
Brush: PLogBrush; StyleCount: DWORD; Style: Pointer): HPEN; external
'gdi32' name 'ExtCreatePen';

procedure DoDrawLine(X0,Y0,X1,Y1: Integer;AColor: Colorref;AStyle:
Integer = PS_SOLID;AThickness: Integer = 1;AHatch: Integer = 0);
var
  lb: TAGLOGBRUSH;
  hPen,oPen: Cardinal;
begin
lb.lbStyle := AStyle;
lb.lbColor := AColor;
lb.lbHatch := AHatch;
hPen := MyExtCreatePen(PS_GEOMETRIC,AThickness,@lb,0,Nil);
oPen := Windows.SelectObject(ADC,hPen);
Windows.MoveToEx(ADC,X0,Y0,Nil);
Windows.LineTo(ADC,X1,Y1);
Windows.DeleteObject(Windows.SelectObject(ADC,oPen));
end;

The MSDN documentation calls for the third argument to be a const
Logbrush *.

Here's the link.
https://msdn.microsoft.com/en-
us/library/windows/desktop/dd162705(v=vs.85).aspx

From redef.inc

function ExtCreatePen(PenStyle, Width: DWORD; const Brush: TLogBrush;
StyleCount: DWORD; Style: Pointer): HPEN; external 'gdi32' name
'ExtCreatePen';

Is this a bug, or is there a way to cast the TLogBrush so that it will
work correctly with the original prototype?

TIA,

----------------------------------------------------------------------
marcov · 2016-07-24 19:37

The problem is that CONST in pascal is not the same as c?c++ and in
default modes might imply an extra pointer, making your declaration
effectively const **logbrush

(or PPLOGBRUSH without const).  Please tell more about the error, it
seems to me you miss a @ to take the address of the record   (@lb
instead of lb)

----------------------------------------------------------------------
molly · 2016-07-24 20:10

as far as i am able to tell it is simply a 'bug' in the declaration.

Also jwawingdi shows:
Code: [Select]  PLogBrush = ^TLogBrush;
  tagLOGBRUSH = record
    lbStyle: UINT;
    lbColor: COLORREF;
    lbHatch: ULONG_PTR; // Sundown: lbHatch could hold a HANDLE
  end;
  {$EXTERNALSYM tagLOGBRUSH}
  LOGBRUSH = tagLOGBRUSH;
  {$EXTERNALSYM LOGBRUSH}
  LPLOGBRUSH = ^LOGBRUSH;
  {$EXTERNALSYM LPLOGBRUSH}
  NPLOGBRUSH = ^LOGBRUSH;
  {$EXTERNALSYM NPLOGBRUSH}
  TLogBrush = LOGBRUSH;
Do note the declaration of TLogBrush -> LOGBRUSH -> tagLOGBRUSH =
record

And the function declaration:
Code: [Select]function ExtCreatePen(dwPenStyle, dwWidth: DWORD; const
lplb: LOGBRUSH; dwStyleCount: DWORD; lpStyle: DWORD): HPEN; stdcall;
Which tells that even jwa declaration itself expects a lp to a lb ->
const lplb: LOGBRUSH

----------------------------------------------------------------------
marcov · 2016-07-24 20:32

Quote from: molly on July 24, 2016, 10:10:45 pmas far as i am able to
tell it is simply a 'bug' in the declaration.

Do note the declaration of TLogBrush -> LOGBRUSH -> tagLOGBRUSH =
record

As it should be.

QuoteAnd the function declaration:
Code: [Select]function ExtCreatePen(dwPenStyle, dwWidth: DWORD; const
lplb: LOGBRUSH; dwStyleCount: DWORD; lpStyle: DWORD): HPEN; stdcall;

This is a pascalization of the MSDN declaration by consuming one *
using const. So this code is correct, though not the most straight
MSDN translation which would be:

Code: [Select]function ExtCreatePen(dwPenStyle, dwWidth: DWORD; lplb:
PLOGBRUSH; dwStyleCount: DWORD; lpStyle: DWORD): HPEN; stdcall;

I noticed the windows version also uses this format, probably out of
compatibility. Actually there are two, one where the last is a
pointer(?!?), and one where it is not

Code: [Select]func.inc:function ExtCreatePen(_para1:DWORD;
_para2:DWORD; var _para3:LOGBRUSH; _para4:DWORD; var
_para5:DWORD):HPEN; external 'gdi32' name 'ExtCreatePen';
redef.inc:function ExtCreatePen(PenStyle, Width: DWORD; const Brush:
TLogBrush; StyleCount: DWORD; Style: Pointer): HPEN; external 'gdi32'
name 'ExtCreatePen';

So probably this is overloading related, so we need a minimal complete
compilable example (including compiler mode and unit list) and the
error message.

----------------------------------------------------------------------
molly · 2016-07-24 20:41

Quote from: marcov on July 24, 2016, 10:32:33 pmSo probably this is
overloading related, so we need a minimal complete compilable example
(including compiler mode and unit list) and the error message.
Agreed, although i must admit i had to read up on the const modifier.
Confusing when things act differently when a function is declared with
stdcall modifier.

----------------------------------------------------------------------
Michaela Joy · 2016-07-25 14:05

Thanks to all who replied.

@marcov: I have tried just about every pointer variation I could think
of, but I couldn't get my project to compile with the original
prototype.

Funny thing is, the -exact- same code exists in in SynTextDrawer.pp
(line 985 or thereabouts). It looks the same as my code.
And SynEdit compiles fine. Which proves that the prototype -is-
correct.

Maybe it's caused by a compile option or flag?

When I get some time, I will create a simple project (Default app) and
place the code in it. If it does not compile, I will then zip it and
send it to you, if you like.

Oh, and my apologies. I should have posted this info originally.
QuoteLazarus 1.6 r51630

FPC 3.0.0 x86_64-win64-win32/win64

----------------------------------------------------------------------
engkin · 2016-07-25 14:25

Quote from: Michaela Joy on July 24, 2016, 05:16:50 pmHi,
I'm working on a Windows project where I will be using the GDI and not
Graphics.pp.

So I wrote a utility function to draw a line to a DC. The problem is,
Lazarus flags this as an error, when in fact the prototype for
ExtCreatePen is incorrect.

Here's my original code.

Code: [Select]procedure DoDrawLine(X0,Y0,X1,Y1: Integer;AColor:
Colorref;AStyle: Integer = PS_SOLID;AThickness: Integer = 1;AHatch:
Integer = 0);
var
  lb: TAGLOGBRUSH;
  hPen,oPen: Cardinal;
begin
lb.lbStyle := AStyle;
lb.lbColor := AColor;
lb.lbHatch := AHatch;
hPen := Windows.ExtCreatePen(PS_GEOMETRIC,AThickness,lb,0,Nil);
oPen := Windows.SelectObject(ADC,hPen);
Windows.MoveToEx(ADC,X0,Y0,Nil);
Windows.LineTo(ADC,X1,Y1);
Windows.DeleteObject(Windows.SelectObject(ADC,oPen));
end;

This code does not compile.

It compiles here. My test unit:
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 unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils,
FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls; type   {
TForm1 }   TForm1 = class(TForm)    Button1: TButton;    procedure
Button1Click(Sender: TObject);  private    { private declarations } 
public    { public declarations }  end; var  Form1:
TForm1; implementationuses  Windows; var  ADC:HDC;{$R *.lfm} { TForm1
} procedure DoDrawLine(X0,Y0,X1,Y1: Integer;AColor: Colorref;AStyle:
Integer = PS_SOLID;AThickness: Integer = 1;AHatch: Integer = 0);var 
lb: TAGLOGBRUSH;  hPen,oPen: Cardinal;beginlb.lbStyle :=
AStyle;lb.lbColor := AColor;lb.lbHatch := AHatch;hPen :=
Windows.ExtCreatePen(PS_GEOMETRIC,AThickness,lb,0,Nil);oPen := Windows
.SelectObject(ADC,hPen);Windows.MoveToEx(ADC,X0,Y0,Nil);Windows.LineTo
(ADC,X1,Y1);Windows.DeleteObject(Windows.SelectObject(ADC,oPen));end; 
procedure TForm1.Button1Click(Sender: TObject);begin  ADC :=
Canvas.Handle; 
DoDrawLine(0,0,ClientWidth,ClientHeight,$80804020);end; end.

----------------------------------------------------------------------
Michaela Joy · 2016-07-25 15:35

@engkim: Thank you! You led me to the solution.

This works
Code: [Select]unit Unit1;

{$mode objfpc}{$H+}

interface

uses
    [b] LCLType, Windows[/b], Classes, SysUtils, FileUtil, Forms,
Controls, Graphics, Dialogs;

type
  TForm1 = class(TForm)
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure DoDrawLine(ADC: HDC;X0,Y0,X1,Y1: Integer;AColor:
Colorref;AStyle: Integer = PS_SOLID;AThickness: Integer = 1;AHatch:
Integer = 0);
var
  lb: TLogBrush;
  hPen,oPen: Cardinal;
begin
lb.lbStyle := AStyle;
lb.lbColor := AColor;
lb.lbHatch := AHatch;
hPen := ExtCreatePen(PS_GEOMETRIC,AThickness,lb,0,Nil);
oPen := Windows.SelectObject(ADC,hPen);
Windows.MoveToEx(ADC,X0,Y0,Nil);
Windows.LineTo(ADC,X1,Y1);
Windows.DeleteObject(Windows.SelectObject(ADC,oPen));
end;


But this does not.
Code: [Select]unit Unit1;

{$mode objfpc}{$H+}

interface

uses
     [b]Windows, LCLType[/b], Classes, SysUtils, FileUtil, Forms,
Controls, Graphics, Dialogs;

type
  TForm1 = class(TForm)
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure DoDrawLine(ADC: HDC;X0,Y0,X1,Y1: Integer;AColor:
Colorref;AStyle: Integer = PS_SOLID;AThickness: Integer = 1;AHatch:
Integer = 0);
var
  lb: TLogBrush;
  hPen,oPen: Cardinal;
begin
lb.lbStyle := AStyle;
lb.lbColor := AColor;
lb.lbHatch := AHatch;
hPen := ExtCreatePen(PS_GEOMETRIC,AThickness,lb,0,Nil);
oPen := Windows.SelectObject(ADC,hPen);
Windows.MoveToEx(ADC,X0,Y0,Nil);
Windows.LineTo(ADC,X1,Y1);
Windows.DeleteObject(Windows.SelectObject(ADC,oPen));
end;

end.

The only thing changed was the order in which I declared LCLType and
Windows.

LCLType goes first.

Thanks again everybody for all your help.