{ Example of program using the GAP library.
  This example show different line styles (Pen)
  different brushed (to fill rectangle or more complicated regions)
  different fonts
  and some information about the system, as the screen size and resolution
  and some information about the device context used in WM_PAINT.
  --------------------------------------------}
program tEx020;

// To tell FreePascal that the application is a Graphical User Interface
// i.e. is running in windows, not in text mode.
{$APPTYPE GUI}

Uses
  Windows
 ,wGlobals2
 ,wApplication0
 ,wWindow0
 ,wErrors0
 ,wDebug0;

type
  PMyWindow = ^TMyWindow;
  TMyWindow = object(TWindow0)
  //""""""""""""""""""""""""""

  nPaintChoice : int32;
  // to choose what should be painted during the WM_PAINT.

  constructor Init(strWinTitlePrm:ShortString);

  procedure MenuCreate; virtual;
  // Add a menu to the window

  procedure Paint_1(hDCPaint:HDC);
  // shows some line styles

  procedure Paint_2(hDCPaint:HDC);
  // shows some brushes styles

  procedure Paint_3(hDCPaint:HDC);
  // shwos some font styles

  procedure Paint_4(hDCPaint:HDC);
  // shwos some information on the system

   procedure Paint_5(hDCPaint:HDC);
   // shows some Device context information

  procedure WMPaint; virtual;
  // the system want the program to repaint the client area.

  function WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  // Handles the menu messages

  function WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  end; // TMyWindow = object(TWindow)

// var nNotUsed : integer; // only to avoid an error message while compliling in DevPascal 1.9

constructor TMyWindow.Init(strWinTitlePrm:ShortString);
//=====================================================
begin
inherited Init(strWinTitlePrm);

nPaintChoice:=501;
end;  // TMyWindow.Init

procedure TMyWindow.MenuCreate;
//=============================
var
  hSubMenu    : HMENU;
begin
hMenuWin := CreateMenu;

hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING,100,'&Open debug window');
AppendMenu(hSubmenu,MF_SEPARATOR,0,Nil);
AppendMenu(hSubMenu,MF_String, 200, 'E&xit');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&File');

hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING, 501, '&1 Show different line styles');
AppendMenu(hSubmenu,MF_STRING, 502, '&2 Show different brush styles');
AppendMenu(hSubmenu,MF_STRING, 503, '&3 Show different font styles');
AppendMenu(hSubmenu,MF_STRING, 504, '&4 Show Info on the system');
AppendMenu(hSubmenu,MF_STRING, 505, '&5 Show Info on Device Context');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&Info choice');

hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING, 401, 'Info &1...');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&Help');
end;  // TMyWindow.MenuCreate

procedure TMyWindow.Paint_1(hDCPaint:HDC);
//========================================
// shows some line styles
const
  SEVEN       = 7;
  EIGHTEEN    = 18;
var
  hPenWinL, // A pen to choose the drawing color, size of the line and style.
  hPenOldL  // to remeber the old pen used by window.
           : HPEN;
  anPenStyle : array[1..SEVEN] of integer;
  astrPenStyle : array[1..SEVEN] of string[50];
  nn         : integer;
  strS       : string[80]; // to write info about the lines

  acolLine  : array[1..EIGHTEEN] of word32; // to show some line colors

begin
// memorises in a table different line styles, to draw each of them
anPenStyle[1]:=PS_SOLID;
anPenStyle[2]:=PS_DASH;
anPenStyle[3]:=PS_DOT;
anPenStyle[4]:=PS_DASHDOT;
anPenStyle[5]:=PS_DASHDOTDOT;
anPenStyle[6]:=PS_NULL;
anPenStyle[7]:=PS_INSIDEFRAME;

// to see the name of the pen style
astrPenStyle[1]:='PS_SOLID';
astrPenStyle[2]:='PS_DASH';
astrPenStyle[3]:='PS_DOT';
astrPenStyle[4]:='PS_DASHDOT';
astrPenStyle[5]:='PS_DASHDOTDOT';
astrPenStyle[6]:='PS_NULL';
astrPenStyle[7]:='PS_INSIDEFRAME';

// loop to draw each style of line
for nn:=1 to SEVEN do begin
   // Info about the line style used.
   strS:='Line style = ' + astrPenStyle[nn] + '   width = 1 and 4';

   TextOut(hDcPaint, 10, 50*nn-40, @strS[1], length(strS));

   // creation of a Pen, to change its color, width, etc.
   hPenWinL:=CreatePen(anPenStyle[nn], 1, RGB(0,0,0)); // 1=line width

   // Use this pen in the device context and
   // remember the handle on the old pen.
   hPenOldL:=SelectObject(hDCPaint, hPenWinL);
   MoveToEx(hDCPaint,  40,  50*nn -15, NIL);
   LineTo  (hDCPaint, 400,  50*nn -15);

   // must give back the old pen, before destroying the used pen.
   SelectObject(hDCPaint, hPenOldL);

   // Detroy the pen, to free resources.
   // If you forget to do this, Windows resources will go down,
   // and after a while, the complete system will crash.
   DeleteObject(hPenWinL);

   // to change an attribut of the pen. --> Quit complicate !!!

   // creation of a Pen, to change its color, width, etc.
   // Same style as before, but thiker line width
   hPenWinL:=CreatePen(anPenStyle[nn], 4, RGB(0,0,0)); // 4=line width

   // Use this pen in the device context and
   // remember the handle on the old pen.
   hPenOldL:=SelectObject(hDCPaint, hPenWinL);
   MoveToEx(hDCPaint,  40,  50*nn-5, NIL);
   LineTo  (hDCPaint, 300,  50*nn-5);

   // must give back the old pen, before destroying the used pen.
   SelectObject(hDCPaint, hPenOldL);

   // Detroy the pen, to free resources.
   // If you forget to do this, Windows resources will go down,
   // and after a while, the complete system will crash.
   DeleteObject(hPenWinL);
   end; // for

// show some line colors
acolLine[ 1]:=RGB(  0,  0,  0);
acolLine[ 2]:=RGB(255,  0,  0);
acolLine[ 3]:=RGB(  0,255,  0);
acolLine[ 4]:=RGB(  0,  0,255);
acolLine[ 5]:=RGB(128,  0,  0);
acolLine[ 6]:=RGB(  0,128,  0);
acolLine[ 7]:=RGB(  0,  0,128);
acolLine[ 8]:=RGB(255,255,  0);
acolLine[ 9]:=RGB(  0,255,255);
acolLine[10]:=RGB(255,  0,255);
acolLine[11]:=RGB(128,128,  0);
acolLine[12]:=RGB(  0,128,128);
acolLine[13]:=RGB(128,  0,128);
acolLine[14]:=RGB(255,255,255);
acolLine[15]:=RGB(192,192,192);
acolLine[16]:=RGB(128,128,128);
acolLine[17]:=RGB( 64, 64, 64);
acolLine[18]:=RGB(  0,  0,  0);

for nn:=1 to EIGHTEEN do begin
   // creation of a Pen, to change its color
   hPenWinL:=CreatePen(PS_SOLID, 4, acolLine[nn]); // 4=line width

   // Use this pen in the device context and
   // remember the handle on the old pen.
   hPenOldL:=SelectObject(hDCPaint, hPenWinL);
   MoveToEx(hDCPaint, 420+10*nn,  10, NIL);
   LineTo  (hDCPaint, 420+10*nn, 400);

   // must give back the old pen, before destroying the used pen.
   SelectObject(hDCPaint, hPenOldL);

   // Detroy the pen, to free resources.
   // If you forget to do this, Windows resources will go down,
   // and after a while, the complete system will crash.
   DeleteObject(hPenWinL);
   end; // for

end;  // TMyWindow.Paint_1

procedure TMyWindow.Paint_2(hDCPaint:HDC);
//========================================
// shows some brush styles
const
  CTE_NBBRUSH       = 7;
var
  hBr,
  hBrOld      : HBRUSH; // which brush style to use
  rRec        : RECT;   // which rectangle to fill
  arBrushStyle : array[1..CTE_NBBRUSH] of LOGBRUSH;
  astrBrushStyle : array[1..CTE_NBBRUSH] of string[50];
  nn          : integer;
  strS        : string[80]; // to write info about the lines
  hBMapOld,
  hBMap       : HBITMAP; // to define a new Hatch
  hDCMem      : HDC; // to draw the new pattern in a memory device context

begin
for nn:=1 to CTE_NBBRUSH do arBrushStyle[nn].lbColor:=RGB(0,0,0);

astrBrushStyle[ 1]:='BS_SOLID, Hatch doesn''t matter';
arBrushStyle[ 1].lbStyle:=BS_SOLID; // this is the most curren
arBrushStyle[ 1].lbHatch:=HS_VERTICAL; // not used, since BS_SOLID

astrBrushStyle[ 2]:='BS_HATCHED, HS_BDIAGONAL';
arBrushStyle[ 2].lbStyle:=BS_HATCHED; // this is the second most current
arBrushStyle[ 2].lbHatch:=HS_BDIAGONAL;
astrBrushStyle[ 3]:='BS_HATCHED, HS_CROSS';
arBrushStyle[ 3].lbStyle:=BS_HATCHED; // this is the second most current
arBrushStyle[ 3].lbHatch:=HS_CROSS;
astrBrushStyle[ 4]:='BS_HATCHED, HS_DIAGCROSS';
arBrushStyle[ 4].lbStyle:=BS_HATCHED; // this is the second most current
arBrushStyle[ 4].lbHatch:=HS_DIAGCROSS;
astrBrushStyle[ 5]:='BS_HATCHED, HS_FDIAGONAL';
arBrushStyle[ 5].lbStyle:=BS_HATCHED; // this is the second most current
arBrushStyle[ 5].lbHatch:=HS_FDIAGONAL;
astrBrushStyle[ 6]:='BS_HATCHED, HS_HORIZONTAL';
arBrushStyle[ 6].lbStyle:=BS_HATCHED; // this is the second most current
arBrushStyle[ 6].lbHatch:=HS_HORIZONTAL;
astrBrushStyle[ 7]:='BS_HATCHED, HS_VERTICAL';
arBrushStyle[ 7].lbStyle:=BS_HATCHED; // this is the second most current
arBrushStyle[ 7].lbHatch:=HS_VERTICAL;

// to set the backgrund color of a BS_HATCHED style,
// you can use :
// SetBkColor(hDCPaint, RGB(Red,Green,Blue));

// to control if the background must be repainted or not,
// you can use :
// SetBkMode(hDCPaint, OPAQUE);  or  SetBkMode(hDCPaint, TRANSPARENT);

// arBrushStyle[ 1].lbStyle:=BS_HOLLOW; // = BS_NULL -> does not paint anything
// arBrushStyle[ 1].lbHatch:=BS_PATTERN  // Pattern brush defined by a memory bitmap

// If you want a special pattern, you can define it yourself
// arBrushStyle[ 8].lbHatch:= handle to a packed DIB pattern
// arBrushStyle[ 8].lbColor:=DIB_RGB_COLORS; // must be set (most common) or
// arBrushStyle[ 8].lbColor:=DIB_PAL_COLORS; // must be set (older way, not shown here)
// arBrushStyle[ 8].lbStyle:=BS_DIBPATTERN;
// An easier way to create a custom bitmap, is shown at the end of
// this procedure.

for nn:=1 to CTE_NBBRUSH do begin
   // creation of a brush, to change its style
   hBr:=CreateBrushIndirect(arBrushStyle[nn]);

   // If you only wanted a filled brush with a selected color,
   // you could use :
   // hBr:=CreateSolidBrush(RGB(Red,Green,Blue));

   // Use this brush in the device context and
   // remember the handle on the old brush
   hBrOld:=SelectObject(hDCPaint, hBr);

   // defines the region to fill
   rRec.Left   := 10;
   rRec.Top    := 50 * nn -40;
   rRec.Right  :=400;
   rRec.Bottom := 50 * nn;
   FillRect(hDCPaint, rRec, hBr);

   strS:=astrBrushStyle[nn];

   TextOut(hDcPaint, 415, rRec.Top+5, @strS[1], length(strS));

   // must give back the old brush, before destroying the used brush
   SelectObject(hDCPaint, hBrOld);

   // Detroy the brush, to free resources.
   // If you forget to do this, Windows resources will go down,
   // and after a while, the complete system will crash.
   DeleteObject(hBr);
   end;

// An easier way (I think) to create a custom bitmap is the following.
// '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
// create first a bitmap, compatible with the used device context
// of a given size. It will be created in memory.
hBMap:=CreateCompatibleBitmap(hDCPaint, 8,8); // 8,8 = width, height

// you must create a memory device context, do draw in the bitmap
hDCMem:=CreateCompatibleDC(hDCPaint);

// to draw on the bit map, select it in the memory device context.
// remember the original bitmap used.
hBMapOld:=SelectObject(hDCMem, hBMap);

// fill the bitmap with a selected color
rRec.Left   := 0;
rRec.Top    := 0;
rRec.Right  := 8;
rRec.Bottom := 8;
FillRect(hDCMem, rRec, GetStockObject(WHITE_BRUSH));

// draw in the new bit map
MoveToEx(hDCMem, 2, 2, NIL);
LineTo(hDCMem, 6, 2);
LineTo(hDCMem, 6, 6);
LineTo(hDCMem, 2, 6);
LineTo(hDCMem, 2, 2);

// create a pattern brush from this bitmap
hBr:=CreatePatternBrush(hBMap);

// You must delete the memory device when not used any more.
// But before, select the original bitmap associated with it at creation.
SelectObject(hDCMem, hBMapOld);
DeleteDC(hDCMem);

// Select the new brush
hBrOld:=SelectObject(hDCPaint, hBr);

// fill a rectangle with this new pattern
rRec.Left   := 10;
rRec.Top    := 50 * CTE_NBBRUSH +10;
rRec.Right  :=400;
rRec.Bottom := 50 * CTE_NBBRUSH + 50;
FillRect(hDCPaint, rRec, hBr);

strS:='User defined bitmap Hatch';
TextOut(hDcPaint, 415, rRec.Top+5, @strS[1], length(strS));

// must give back the old brush, before destroying the used brush
SelectObject(hDCPaint, hBrOld);

// Detroy the brush and bitmap, to free resources.
// If you forget to do this, Windows resources will go down,
// and after a while, the complete system will crash.
DeleteObject(hBr);
DeleteObject(hBMap);
end;  // TMyWindow.Paint_2

procedure TMyWindow.Paint_3(hDCPaint:HDC);
//========================================
// shows some character fonts.
var
  strS        : string[80];
  nn          : integer;
  rLogFont    : TLogFont;
  hFontNew1,  // four style of font, for normal, bold and italic.
  hFontNew2,
  hFontNew3,
  hFontNew4,
  hFontOld    : HFONT;
  astrFont    : array[1..4] of string[30];

begin
// fonts to be used :
astrFont[1]:='Arial';
astrFont[2]:='Times New Roman';
astrFont[3]:='Courier New';
astrFont[4]:='Comic Sans MS';  // if you have it.

for nn:=1 to 4 do begin
   // define a new font.
   strS:=astrFont[nn]+#0;
   with rLogFont do  begin
      lfHeight         := 0;                // Default logical height of font
      lfWidth          := 0;                // Default logical average character width
      lfEscapement     := 0;                // angle of escapement
      lfOrientation    := 0;                // base-line orientation angle
      lfWeight         := FW_NORMAL;        // font weight = 400
      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
      lfFaceName       :=PCHAR(@strS[1]);         // pointer to typeface name string
      end; // with

   // creates the new Font.
   // CreateFont(...) could also be used.
   hFontNew1 := CreateFontIndirect(@rLogFont);

   rLogFont.lfItalic:=1; // to have italic text
   hFontNew2 := CreateFontIndirect(@rLogFont);

   // Italic and bold
   rLogFont.lfWeight:=700; // bold, could go up to 1000 for very bold
   hFontNew3 := CreateFontIndirect(@rLogFont);

   rLogFont.lfItalic:=0; // not italic
   rLogFont.lfWeight:=900; // very bold
   hFontNew4 := CreateFontIndirect(@rLogFont);

   // If you want to draw text in the selected font.
   hFontOld:=SelectObject(hDcPaint, hFontNew1);
   strS:=astrFont[nn] + ', normal font';
   TextOut(hDcPaint, 10, 90*nn -70, @strS[1], length(strS));

   // with another style
   SelectObject(hDcPaint, hFontNew2);
   strS:=astrFont[nn] + ', italic font';
   TextOut(hDcPaint, 10, 90*nn -50, @strS[1], length(strS));

   // with another style
   SelectObject(hDcPaint, hFontNew3);
   strS:=astrFont[nn] + ', italic bold font';
   TextOut(hDcPaint, 10, 90*nn -30, @strS[1], length(strS));

   // with another style
   SelectObject(hDcPaint, hFontNew4);
   strS:=astrFont[nn] + ', very bold font';
   TextOut(hDcPaint, 10, 90*nn -10, @strS[1], length(strS));

   // As always, you must select the original font, the delete
   // the created "objects" to free resources.
   SelectObject(hDcPaint, hFontOld);
   DeleteObject(hFontNew4);
   DeleteObject(hFontNew3);
   DeleteObject(hFontNew2);
   DeleteObject(hFontNew1);
   end; // for nn:=1 to 4 do begin

end;  // TMyWindow.Paint_3

procedure TMyWindow.Paint_4(hDCPaint:HDC);
//========================================
// shows some system information
type
  TSysMetrics = record
     wInd    : word;
     strS1   : string[20];
     strS2   : string[40];
     end;
const
  NUMLINES = 33;
  arSysMetrics : array[1..NUMLINES] of TSysMetrics =
((wInd:SM_CXSCREEN;      strS1:'SM_CXSCREEN';      strS2:'Screen width in pixels'),
 (wInd:SM_CYSCREEN;      strS1:'SM_CYSCREEN';      strS2:'Screen height in pixels'),
 (wInd:SM_CXVSCROLL;     strS1:'SM_CXVSCROLL';     strS2:'Vertical scroll arrow width'),
 (wInd:SM_CYHSCROLL;     strS1:'SM_CYHSCROLL';     strS2:'Horizontal scroll arrow height'),
 (wInd:SM_CYCAPTION;     strS1:'SM_CYCAPTION';     strS2:'Caption bar height'),
 (wInd:SM_CXBORDER;      strS1:'SM_CXBORDER';      strS2:'Border width'),
 (wInd:SM_CYBORDER;      strS1:'SM_CYBORDER';      strS2:'Border height'),
 (wInd:SM_CXDLGFRAME;    strS1:'SM_CXDLGFRAME';    strS2:'Dialog window frame width'),
 (wInd:SM_CYDLGFRAME;    strS1:'SM_CYDLGFRAME';    strS2:'Dialog window frame height'),
 (wInd:SM_CYVTHUMB;      strS1:'SM_CYVTHUMB';      strS2:'Vertical scroll thumb height'),
 (wInd:SM_CXHTHUMB;      strS1:'SM_CXHTHUMB';      strS2:'Horizontal scroll thumb width'),
 (wInd:SM_CXICON;        strS1:'SM_CXICON';        strS2:'Icon width'),
 (wInd:SM_CYICON;        strS1:'SM_CYICON';        strS2:'Icon height'),
 (wInd:SM_CXCURSOR;      strS1:'SM_CXCURSOR';      strS2:'Cursor width'),
 (wInd:SM_CYCURSOR;      strS1:'SM_CYCURSOR';      strS2:'Cursor height'),
 (wInd:SM_CYMENU;        strS1:'SM_CYMENU';        strS2:'Menu bar height'),
 (wInd:SM_CXFULLSCREEN;  strS1:'SM_CXFULLSCREEN';  strS2:'Full screen client window width'),
 (wInd:SM_CYFULLSCREEN;  strS1:'SM_CYFULLSCREEN';  strS2:'Full screen client window height'),
 (wInd:SM_CYKANJIWINDOW; strS1:'SM_CYKANJIWINDOW'; strS2:'Kanji window height'),
 (wInd:SM_MOUSEPRESENT;  strS1:'SM_MOUSEPRESENT';  strS2:'Mouse present flag'),
 (wInd:SM_CYVSCROLL;     strS1:'SM_CYVSCROLL';     strS2:'Vertical scroll arrow height'),
 (wInd:SM_CXHSCROLL;     strS1:'SM_CXHSCROLL';     strS2:'Horizontal scroll arrow width'),
 (wInd:SM_DEBUG;         strS1:'SM_DEBUG';         strS2:'Debug version flag'),
 (wInd:SM_SWAPBUTTON;    strS1:'SM_SWAPBUTTON';    strS2:'Mouse buttons swapped flag'),
 (wInd:SM_CXMIN;         strS1:'SM_CXMIN';         strS2:'Minimum window width'),
 (wInd:SM_CYMIN;         strS1:'SM_CYMIN';         strS2:'Minimum window height'),
 (wInd:SM_CXSIZE;        strS1:'SM_CXSIZE';        strS2:'Minimize/Maximize icon width'),
 (wInd:SM_CYSIZE;        strS1:'SM_CYSIZE';        strS2:'Minimize/Maximize icon height'),
 (wInd:SM_CXFRAME;       strS1:'SM_CXFRAME';       strS2:'Window frame width'),
 (wInd:SM_CYFRAME;       strS1:'SM_CYFRAME';       strS2:'Window frame height'),
 (wInd:SM_CXMINTRACK;    strS1:'SM_CXMINTRACK';    strS2:'Minimum tracking width of window'),
 (wInd:SM_CYMINTRACK;    strS1:'SM_CYMINTRACK';    strS2:'Maximum tracking width of window'),
 (wInd:SM_CMETRICS;      strS1:'SM_CMETRICS';      strS2:'Number of system metrics'));

var
  rTextMetric : TEXTMETRIC; // 20 fields are defined here
  nn         : integer;
  strS       : string[80]; // to write info about the lines

begin // TMyWindow.Paint_4
// Get information about character fonts and sizes.
GetTextMetrics(hDCPaint, rTextMetric);

// rTextMetric.tmHeight = total height of characters = height of the line
// rTextMetric.tmAveCharWidth
// rTextMetric.tmMaxCharWidth

// loop over informations about the system.
for nn:=1 to NUMLINES do begin
   // Info about the line style used.
   strS:= arSysMetrics[nn].strS1;
   TextOut( hDcPaint, 10, rTextMetric.tmHeight*(nn-1)+10,
            @strS[1], length(strS));

   strS:= arSysMetrics[nn].strS2;
   TextOut( hDcPaint, rTextMetric.tmAveCharWidth*28,
                      rTextMetric.tmHeight*(nn-1)+10,
            @strS[1], length(strS));

   strS:= IntToStr(GetSystemMetrics(arSysMetrics[nn].wInd), 5);
   if (strS[1] = ' ') then strS[1]:='_';
   if (strS[2] = ' ') then strS[2]:='_';
   if (strS[3] = ' ') then strS[3]:='_';
   if (strS[4] = ' ') then strS[4]:='_';
   TextOut( hDcPaint, rTextMetric.tmAveCharWidth*60,
                      rTextMetric.tmHeight*(nn-1)+10,
            @strS[1], length(strS));
   end; // for nn:=1 to NUMLINES do begin

// Three info about char sizes

nn:=1;
strS:='Char height =' + IntToStr(rTextMetric.tmHeight, 3);
TextOut( hDcPaint, rTextMetric.tmAveCharWidth*70,
                   rTextMetric.tmHeight*(nn-1)+10,
            @strS[1], length(strS));
inc(nn);
strS:='Char medium width =' + IntToStr(rTextMetric.tmAveCharWidth, 3);
TextOut( hDcPaint, rTextMetric.tmAveCharWidth*70,
                   rTextMetric.tmHeight*(nn-1)+10,
            @strS[1], length(strS));
inc(nn);
strS:='Char average width =' + IntToStr(rTextMetric.tmMaxCharWidth, 3);
TextOut( hDcPaint, rTextMetric.tmAveCharWidth*70,
                   rTextMetric.tmHeight*(nn-1)+10,
            @strS[1], length(strS));

end;  // TMyWindow.Paint_4

procedure TMyWindow.Paint_5(hDCPaint:HDC);
//========================================
// shows some Device context information
type
  TDeviceCaps = record
     wInd    : word;
     strS1   : string[20];
     strS2   : string[80];
     end;
const
  NUMLINES = 37;
  arDeviceCaps : array[1..NUMLINES] of TDeviceCaps =
((wInd:DRIVERVERSION;    strS1:'DRIVERVERSION';    strS2:'The device driver version.'),
 (wInd:TECHNOLOGY;       strS1:'TECHNOLOGY';       strS2:'Device technology. It can be any one of the following values:'),
 (wInd:HORZSIZE;         strS1:'HORZSIZE        '; strS2:'Width, in millimeters, of the physical screen.'),
 (wInd:VERTSIZE        ; strS1:'VERTSIZE        '; strS2:'Height, in millimeters, of the physical screen.'),
 (wInd:HORZRES         ; strS1:'HORZRES         '; strS2:'Width, in pixels, of the screen.'),
 (wInd:VERTRES         ; strS1:'VERTRES         '; strS2:'Height, in raster lines, of the screen.'),
 (wInd:LOGPIXELSX      ; strS1:'LOGPIXELSX      '; strS2:'Number of pixels per logical inch along the screen width.'),
 (wInd:LOGPIXELSY      ; strS1:'LOGPIXELSY      '; strS2:'Number of pixels per logical inch along the screen height.'),
 (wInd:BITSPIXEL       ; strS1:'BITSPIXEL       '; strS2:'Number of adjacent color bits for each pixel.'),
 (wInd:PLANES          ; strS1:'PLANES          '; strS2:'Number of color planes.'),
 (wInd:NUMBRUSHES      ; strS1:'NUMBRUSHES      '; strS2:'Number of device-specific brushes.'),
 (wInd:NUMPENS         ; strS1:'NUMPENS         '; strS2:'Number of device-specific pens.'),
 (wInd:NUMFONTS        ; strS1:'NUMFONTS        '; strS2:'Number of device-specific fonts.'),
 (wInd:NUMCOLORS       ; strS1:'NUMCOLORS       '; strS2:'Number of entries in the device''s color table.'),
 (wInd:ASPECTX         ; strS1:'ASPECTX         '; strS2:'Relative width of a device pixel used for line drawing.'),
 (wInd:ASPECTY         ; strS1:'ASPECTY         '; strS2:'Relative height of a device pixel used for line drawing.'),
 (wInd:ASPECTXY        ; strS1:'ASPECTXY        '; strS2:'Diagonal width of the device pixel used for line drawing.'),
 (wInd:PDEVICESIZE     ; strS1:'PDEVICESIZE     '; strS2:'Reserved.'),
 (wInd:CLIPCAPS        ; strS1:'CLIPCAPS        '; strS2:'Flag that indicates the clipping capabilities of the device...'),
 (wInd:SIZEPALETTE     ; strS1:'SIZEPALETTE     '; strS2:'Number of entries in the system palette...'),
 (wInd:NUMRESERVED     ; strS1:'NUMRESERVED     '; strS2:'Number of reserved entries in the system palette...'),
 (wInd:COLORRES        ; strS1:'COLORRES        '; strS2:'Actual color resolution of the device, in bits per pixel...'),
 (wInd:PHYSICALWIDTH   ; strS1:'PHYSICALWIDTH   '; strS2:'For printing devices: the physical width, in device units.'),
 (wInd:PHYSICALHEIGHT  ; strS1:'PHYSICALHEIGHT  '; strS2:'For printing devices: the physical height, in device units.'),
 (wInd:PHYSICALOFFSETX ; strS1:'PHYSICALOFFSETX '; strS2:'For printing devices: the physical printable area horizontal margin.'),
 (wInd:PHYSICALOFFSETY ; strS1:'PHYSICALOFFSETY '; strS2:'For printing devices: the physical printable area vertical margin. '),
 (wInd:SCALINGFACTORX  ; strS1:'SCALINGFACTORX  '; strS2:'For printing devices: the scaling factor along the horizontal axis.'),
 (wInd:SCALINGFACTORY  ; strS1:'SCALINGFACTORY  '; strS2:'For printing devices: the scaling factor along the vertical axis.'),
 (wInd:VREFRESH        ; strS1:'VREFRESH        '; strS2:'Windows NT only: For display devices: the current vertical refresh rate...'),
 (wInd:DESKTOPHORZRES  ; strS1:'DESKTOPHORZRES  '; strS2:'Windows NT only: Width, in pixels, of the virtual desktop...'),
 (wInd:DESKTOPVERTRES  ; strS1:'DESKTOPVERTRES  '; strS2:'Windows NT only: Height, in pixels, of the virtual desktop...'),
 (wInd:BLTALIGNMENT    ; strS1:'BLTALIGNMENT    '; strS2:'Windows NT only: Preferred horizontal drawing alignment,...'),
 (wInd:RASTERCAPS      ; strS1:'RASTERCAPS      '; strS2:'Value that indicates the raster capabilities of the device,...'),
 (wInd:CURVECAPS       ; strS1:'CURVECAPS       '; strS2:'Value that indicates the curve capabilities of the device,...'),
 (wInd:LINECAPS        ; strS1:'LINECAPS        '; strS2:'Value that indicates the line capabilities of the device,... '),
 (wInd:POLYGONALCAPS   ; strS1:'POLYGONALCAPS   '; strS2:'Value that indicates the polygon capabilities of the device,...'),
 (wInd:TEXTCAPS        ; strS1:'TEXTCAPS        '; strS2:'Value that indicates the text capabilities of the device,...'));

var
  rTextMetric : TEXTMETRIC; // 20 fields are defined here
  nn         : integer;
  strS       : string[180]; // to write info about the lines

begin // TMyWindow.Paint_5
// Get information about character fonts and sizes.
GetTextMetrics(hDCPaint, rTextMetric);

// rTextMetric.tmHeight = total height of characters = height of the line
// rTextMetric.tmAveCharWidth
// rTextMetric.tmMaxCharWidth

// loop over informations about the system.
for nn:=1 to NUMLINES do begin
   // Info about the line style used.
   strS:= arDeviceCaps[nn].strS1;
   TextOut( hDcPaint, 10, rTextMetric.tmHeight*(nn-1)+10,
            @strS[1], length(strS));

   strS:= arDeviceCaps[nn].strS2;
   TextOut( hDcPaint, rTextMetric.tmAveCharWidth*30,
                      rTextMetric.tmHeight*(nn-1)+10,
            @strS[1], length(strS));

   strS:= IntToStr(GetDeviceCaps(hDcPaint, arDeviceCaps[nn].wInd), 5);
   if (strS[1] = ' ') then strS[1]:='_';
   if (strS[2] = ' ') then strS[2]:='_';
   if (strS[3] = ' ') then strS[3]:='_';
   if (strS[4] = ' ') then strS[4]:='_';
   TextOut( hDcPaint, rTextMetric.tmAveCharWidth*20,
                      rTextMetric.tmHeight*(nn-1)+10,
            @strS[1], length(strS));
   end; // for nn:=1 to NUMLINES do begin

end;  // TMyWindow.Paint_5

procedure TMyWindow.WMPaint;
//==========================
Var
  hDcPaint    : hdc;
  rPS         : paintstruct;
begin
// Get a device context.
// Here we have a facility, during the WMPaint, we must always
// begin with  "BeginPaint", which gives a Device Context to paint, and
// end with "EndPaint", to tell that the painting is done.
hDcPaint:=BeginPaint(hWin, @rPS);

case nPaintChoice of
   501 : Paint_1(hDCPaint);
   502 : Paint_2(hDCPaint);
   503 : Paint_3(hDCPaint);
   504 : Paint_4(hDCPaint);
   505 : Paint_5(hDCPaint);
   end;

EndPaint(hWin, rPS);
end;  // TMyWindow.WMPaint

function TMyWindow.WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT;
//=============================================================
// Handles the menu messages
Var
  wNrMenu     : word;
  rRec        : RECT;

begin
WMCommand:=0; // default return value

if (lPar <> 0) then begin
   // call the parent WMCommand method.
   WMCommand:=inherited WMCommand(wPar, lPar);
   exit;
   end;

// for the menus,  lPar = 0
//=========================
wNrMenu   := LoWord(wPar);
Case wNrMenu Of
   // these calls to DBW0 can be done from anywhere
   100 : DBW0(0, '');  // just open the debugging window

   200 : PostMessage( hWin,WM_Close,0,0);
   401 : MessageBox( hWin,
       'Juste select the test you want to see. It is only a demo on drawings possibilites.',
       'Demos of pens, brushes, fonts and system info',
                     MB_OK Or MB_IconInformation);
   501..510 : begin
      nPaintChoice:=int32(wNrMenu);
      GetClientRect(hWin, @rRec);
      InvalidateRect(hWin, rRec, TRUE);
      end;

   else WMCommand:=inherited WMCommand(wPar, lPar);
   end;  // Case NrMenu Of
end;  // TMyWindow.WMCommand

function TMyWindow.WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//=======================================================================================
// All window messages are send here.
Begin
WindowProc := 0; // Default return value when processing a message

Case wMsg Of
   WM_Paint   : WMPaint; // must redraw the client area part.
   WM_Command : WindowProc:=WMCommand(wPar, lPar);
   else begin // Case wMsg Of
      // Default processing of the messages.
      WindowProc:=inherited WindowProc(hWindow, wMsg, wPar, lPar);
      end; // Case wMsg Of
   End; // Case wMsg Of

End;  // TMyWindow.WindowProc

var
  oApp        : TApplication0;
  poMyMainWin : PMyWindow;

Begin // MAIN ******
// Name under which the main window is registered. Spaces are not allowed
oApp.Init('Example020');

// Change the color of the background of the main window.
// to have the desktop color
// oApp.WindowClass.hbrBackground :=COLOR_BACKGROUND+1;

// Creation of the main window
new(poMyMainWin, Init('Title of the Example020 (Ex020.pp) Window'));

// The App.WindowClass can be modified here, if wanted. (Not usual)
oApp.Run;
oApp.Done;  // The main window object is disposed here.
End.

