function TFont.GetHandle: HFont;
var
  LogFont: TLogFont;
begin
  with FResource^ do
  begin
    if Handle = 0 then
    begin
      FontManager.Lock;
      with LogFont do
      try
        if Handle = 0 then
        begin
          lfHeight := Font.Height;
          lfWidth := 0; { have font mapper choose }
          lfEscapement := 0; { only straight fonts }
          lfOrientation := 0; { no rotation }
          if fsBold in Font.Style then
            lfWeight := FW_BOLD
          else
            lfWeight := FW_NORMAL;
          lfItalic := Byte(fsItalic in Font.Style);
          lfUnderline := Byte(fsUnderline in Font.Style);
          lfStrikeOut := Byte(fsStrikeOut in Font.Style);
          lfCharSet := Byte(Font.Charset);
          if AnsiCompareText(Font.Name, 'Default') = 0 then  // do not localize
            StrPCopy(lfFaceName, DefFontData.Name)
          else
            StrPCopy(lfFaceName, Font.Name);
          lfQuality := DEFAULT_QUALITY;
          { Everything else as default }
          lfOutPrecision := OUT_DEFAULT_PRECIS;
          lfClipPrecision := CLIP_DEFAULT_PRECIS;
          case Pitch of
            fpVariable: lfPitchAndFamily := VARIABLE_PITCH;
            fpFixed: lfPitchAndFamily := FIXED_PITCH;
          else
            lfPitchAndFamily := DEFAULT_PITCH;
          end;
          Handle := CreateFontIndirect(LogFont);
        end;
      finally
        FontManager.Unlock;
      end;
    end;
    Result := Handle;
  end;
end;

procedure TWinControl.CMFontChanged(var Message: TMessage);
begin
  inherited;
  if HandleAllocated then Perform(WM_SETFONT, FFont.Handle, 0);
  NotifyControls(CM_PARENTFONTCHANGED);
end;

program PaintStatic;

uses
  Windows, Messages;

{$R *.RES}

var
wClass: TWndClass;
hMainForm, hExitBut, hDrawBut, hPaintBut, hOwnerDrawS,
hLabel1, hLabel2, hIcon1, Font1, Font2, Font3, Font4, Font5,
hChangeBut, OldObj, Bitmap1, Bitmap2, hMakeBmpBut: HWND;
mainMsg: TMSG;
Brush1, Brush2: hBrush;
Pen1, Pen2: hPen;
{for Fonts Brushes and Pens, I do not use an h 
like hPen1, since I know all fonts, pens and brushes 
are Handles}
FontLog1: TLogFont;
TempDC: HDC;
FormRect: TRect;
Size1: TSize;

procedure ShutDown;
begin
DeleteObject(Font1);
DeleteObject(Font2);
DeleteObject(Font3);
DeleteObject(Font4);
DeleteObject(Brush1);
DeleteObject(Brush2);
DeleteObject(Pen1);
DeleteObject(Pen2);
DeleteObject(Bitmap1);
DeleteObject(Bitmap2);

PostQuitMessage(0);
end;

procedure MakeBmp;
var
BmpDC: HDC;
Rect1: TRect;
New: Boolean;
FPoints: array[0..7] of TPoint;
begin
New := False;
TempDC := GetDC(hMainForm);
BmpDC := CreateCompatibleDC(TempDC);
if Bitmap2 = 0 then
  begin
  Bitmap2 := CreateCompatibleBitmap(TempDC,160,120);
  {Bitmap2 := CreateBitmap(120,80,1,24,nil);}
  New := True;
  end;
SelectObject(BmpDC,Bitmap2);
if New then
  begin
  SetRect(Rect1,0,0,160,120);
  FillRect(BmpDC,Rect1,GetStockObject(WHITE_BRUSH));
  SelectObject(BmpDC,Brush2);
  Ellipse(BmpDC,2,2,156,116);
  SelectObject(BmpDC,Brush1);
  Rectangle(BmpDC,16,34,132,76);
  SelectObject(BmpDC,Font3);
  SetTextColor(BmpDC,$000000FF);
  SetBkColor(BmpDC,$0000FF00);
  TextOut(BmpDC,30,40,'Bitmap2',7);
  FPoints[0].x := 2;
  FPoints[0].y := 8;
    FPoints[1].x := 14;
    FPoints[1].y := 2;
  FPoints[2].x := 14;
  FPoints[2].y := 6;
    FPoints[3].x := 20;
    FPoints[3].y := 6;
  FPoints[4].x := 20;
  FPoints[4].y := 10;
    FPoints[5].x := 14;
    FPoints[5].y := 10;
  FPoints[6].x := 14;
  FPoints[6].y := 14;
    FPoints[7].x := 2;
    FPoints[7].y := 8;
  MoveToEx(BmpDC, 2, 8, nil);
    BeginPath(BmpDC);
    PolylineTo(BmpDC,FPoints,8);
    {LineTo(BmpDC, 12, 12);}
    EndPath(BmpDC);
  StrokeAndFillPath(BmpDC);
  BitBlt(TempDC, 256, 148, 160, 120, BmpDC, 0, 0, SRCCOPY);
  SetWindowText(hMakeBmpBut,'UpsideDown');
  End else
  StretchBlt(TempDC, 256, 148, 160, 120, BmpDC, 0, 120, 160, -120, SRCCOPY);
DeleteDC(BmpDC);
ReleaseDC(hMainForm,TempDC);
end;

function MessageProc(hWnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
  var
  DC, BmpDC: HDC;
  PaintS: TPaintStruct;
  Rect1: TRect;
  DrawItem: PDrawItemStruct;
begin
case Msg of
WM_ERASEBKGND:
  begin
  Result := DefWindowProc(hWnd,Msg,wParam,lParam);
  {if you are not compleatly filling the background then
  call DefWindowProc( ) first or it will overdraw anything
  you draw}
  SelectObject(wParam,Brush2);
  GetClientRect(hWnd, Rect1);
  Rect1.Bottom := 36;
  FillRect(wParam,Rect1,Brush2);
  Exit;
  {be sure to Exit so DefWindowProc( ) woun't be called at the end}
  end;
WM_PAINT: begin
          DC := BeginPaint(hWnd, PaintS);
          {use WM_PAINT to draw on your Form, the BeginPaint tells
          you the WM_PAINT hDC to use to paint on}
          SelectObject(DC,Brush1);
          SelectObject(DC,Pen1);
          GetWindowRect(hLabel1, Rect1);
          {if we get the window Rect}
          ScreenToClient(hMainForm,Rect1.TopLeft);
          ScreenToClient(hMainForm,Rect1.BottomRight);

          {the PaintS record has a rcPaint Rect, which has the Area that will be painted
           anything outside this Rect will NOT show, even if it is in thses Paint commands}
          if PaintS.rcPaint.Top < Rect1.Bottom then
            begin
            {you can test the rcPaint to see if you need to paint, this is 
             suppose to increase the efficientcy of painting, but with modern 
             video display it may not make much difference}
            Ellipse(DC,Rect1.Left-((Size1.cy) div 2),Rect1.Top,Rect1.Left+((Size1.cy+2) div 2),
              Rect1.Bottom{Size1.cy+Rect1.Top});
            Ellipse(DC,Rect1.Left+Size1.cx+(Size1.cx div 10)-((Size1.cy+4) div 2),Rect1.Top,
              Rect1.Left+Size1.cx+(Size1.cx div 10)+((Size1.cy) div 2),Rect1.Bottom{Size1.cy+6});
            {these 2 Ellipse draw hLable1 ends based on the Font3 size}
            end;
          
          DrawIcon(DC,2,40,LoadImage(hInstance, 'MainIcon', IMAGE_ICON, 0, 0, LR_DEFAULTSIZE));
          {DrawIcon(DC,2,40,LoadIcon(hInstance, 'MainIcon'));}
          {LoadIcon( ) can also be used and is simpler, but has less options,
          you do NOT have to free or DeleteObject or DetroyIcon for Icons except
          if you use CreateIconIndirect( )}
          SelectObject(DC,Font2);
          SetBkColor(DC,GetSysColor(COLOR_BTNFACE));
          TextOut(DC,48,60,'Compare to text above',21);
          SelectObject(DC,Font4);
          TextOut(DC,248,56,'Font4  -20  Escapement',22);
          SelectObject(DC,Font5);
          TextOut(DC,248,114,'Font5  20  Escapement',21);
          BmpDC := CreateCompatibleDC(DC);
          SelectObject(BmpDC,Bitmap1);
          BitBlt(DC, 56, 158, 64, 80, BmpDC, 0, 0, SRCCOPY);
          DeleteDC(BmpDC);
          EndPaint(hWnd,PaintS);
          end;
WM_DRAWITEM: begin
             DrawItem := Pointer(LParam);
             if DrawItem.hwndItem = hOwnerDrawS then
               begin
               SelectObject(DrawItem.hDC,Brush2);
               SelectObject(DrawItem.hDC,Font2);
               FillRect(DrawItem.hDC,DrawItem.rcItem, GetStockObject(BLACK_BRUSH));
               RoundRect(DrawItem.hDC,DrawItem.rcItem.Left+3,DrawItem.rcItem.Top+3,
                 DrawItem.rcItem.Right-3,DrawItem.rcItem.Bottom-3,10,10);
               SetBkMode(DrawItem.hDC,TRANSPARENT);
               DrawText(DrawItem.hDC,'Owner Draw',-1,DrawItem.rcItem,
                 DT_CENTER or DT_VCENTER or DT_SINGLELINE);
               Result := 1;
               Exit;
               end;
             end;
WM_COMMAND: if lParam = abs(hExitBut) then PostMessage(hMainForm,WM_CLOSE,0,0)
            else if lParam = abs(hMakeBmpBut) then MakeBmp;
WM_DESTROY: ShutDown;
WM_CTLCOLORSTATIC: if (LParam = abs(hLabel1)) then
{WM_CTLCOLORSTATIC is the pre Static Paint message to get
colors to paint the Label}
                     begin
                     SetTextColor(wParam,$0000FFFF);
                     SetBkColor(wParam,$00FF0000);
                     {SetBkColor is only for the text drawing}
                     Result := Brush1;
                     {Result is the Brush Handle used to paint any
                     background not covered by text}
                     Exit;
                     {IMPORTENT
                       You MUST Exit so the DefWindowProc is NOT called
                       try it without Exit and the Static will NOT change colors}
                     end;
end;
Result := DefWindowProc(hWnd,Msg,wParam,lParam);
end;

begin  // main program begin
{since Brushes, Pens and Fonts are Window's System Objects
I usually create them first. You must Delete these Objects
before your Program ends, see ShutDown procedure above}
Brush1 := CreateSolidBrush($00FF0000);
Pen1 := CreatePen(PS_SOLID, 1, $00FF0000);
Brush2 := CreateHatchBrush(HS_DIAGCROSS, $00FF00FF);
Bitmap1 := LoadImage(hInstance,'C:\Stuff\small.bmp', IMAGE_BITMAP,0,0, LR_LOADFROMFILE);
Bitmap2 := 0;


// // // // Font Creation // // //
Font1 := CreateFont(-12,0,0,0,FW_NORMAL,0,0,0,ANSI_CHARSET,OUT_DEFAULT_PRECIS,
   CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,VARIABLE_PITCH or FF_SWISS,'MS Sans Serif');

   with FontLog1 do
  begin
  lfHeight := -14;
  lfWidth := 0;
  lfItalic := 0;
  lfWeight := FW_BOLD;
  lfCharSet := ANSI_CHARSET;
  lfOutPrecision := OUT_TT_PRECIS;
  lfClipPrecision := CLIP_DEFAULT_PRECIS;
  lfQuality := ANTIALIASED_QUALITY;
  lfPitchAndFamily := VARIABLE_PITCH or FF_ROMAN;
  lfFaceName := 'Times New Roman';
  end;
Font2 := CreateFontIndirect(FontLog1);

with FontLog1 do
  begin
  lfHeight := -20;
  lfPitchAndFamily := VARIABLE_PITCH or FF_SWISS;
  lfItalic := 1;
  lfFaceName := 'v8j9k2a5';
  {there will be no Font named v8j9k2a5, this is to show you what happens
  if the font you name is NOT on the computer, you can never tell if a Font
  will be on a computer, even the "Standard" windows fonts like
  'MS Sans Serif' or 'Arial' may have been deleted, so if a control's
  size or function depends on the font, you may want to make provisions for that,
  see hLabel1 below and the WM_PAINT in the MessageProc }
  end;
Font3 := CreateFontIndirect(FontLog1);

with FontLog1 do
  begin
  lfHeight := -14;
  lfItalic := 0;
  lfEscapement := 3400;
  lfOrientation := 3400;
  lfWeight := FW_NORMAL;
  lfPitchAndFamily := VARIABLE_PITCH or FF_SWISS;
  lfFaceName := 'Arial';
  end;
Font4 := CreateFontIndirect(FontLog1);

with FontLog1 do
  begin
  lfEscapement := 200;
  lfOrientation := 200;
  end;
Font5 := CreateFontIndirect(FontLog1);

wClass.hInstance := hInstance;
with wClass do
  begin
    hIcon :=         LoadIcon(hInstance,'MAINICON');
    lpfnWndProc :=   @MessageProc;
    hbrBackground := COLOR_BTNFACE+1;
{GetStockObject is good to get system Brushs, Pens, and fonts
you do NOT need to call DeleteObject for Stock Objects}
    lpszClassName := 'Form Class';
{you may use any class name, but you may want to make it descriptive
if you register more than one class}
    hCursor :=       LoadCursor(0,IDC_ARROW);
  end;

RegisterClass(wClass);

hMainForm := CreateWindow(
    wClass.lpszClassName,	// pointer to registered class name
    ' Static Control and Paint test',	// pointer to window name (title bar Caption here)
    WS_OVERLAPPEDWINDOW,	// window style
{WS_OVERLAPPEDWINDOW is the default standard main window with a
Title bar and system menu and sizing border}
    (GetSystemMetrics(SM_CXSCREEN) div 2)-276,	// horizontal position of window
    (GetSystemMetrics(SM_CYSCREEN) div 2)-222,	// vertical position of window
    500,	// window width
    350,	// window height
    0,	// handle to parent or owner window
{this is the MAIN window, so it will be the parent}
    0,	// handle to menu or child-window identifier
    hInstance,	// handle to application instance
    nil 	// pointer to window-creation data
   );

TempDC := GetDC(hMainForm);
OldObj := SelectObject(TempDC,Font3);
{for a Device Context
(HDC, see Win32 API help for "Device Contexts", like a Canvas in Delphi)
you need to SelectObjects (fonts, pens, brushes) to use in Drawing on that DC}
GetTextExtentPoint32(TempDC, 'DC Paint and Static Control Demo', 32, Size1);
{GetTextExtentPoint32 gets the size of text for that DC
Size1 is used to get the correct size for Label1, even though this is NOT the
hLabel1 DC, the Text size should be the same for the same font and text Font3}
SelectObject(TempDC,OldObj);
{Restore the default font to your form's HDC, this is
not necessary if you don't use that HDC again, the Font stays
selected even if you release the DC}

ReleaseDC(hMainForm,TempDC);
{to call GetDC and then ReleaseDC may seem unnessary,
why not just call GetDC once when the app starts and then
ReleaseDC once when the app closes (like Delphi VCL),
these GetDC are quick functions and releasing it cuts down
on window's system resources use}

GetClientRect(hMainForm, FormRect);

hLabel1 := CreateWindow('Static', 'DC Paint and Static Control Demo',
         WS_VISIBLE or WS_CHILD or SS_CENTER,
         (FormRect.Right div 2)-((Size1.cx+(Size1.cx div 10)) div 2), 5,
         Size1.cx+(Size1.cx div 10),Size1.cy+1,hMainForm,0,hInstance,nil);
{hLabel1 is assigned a Font name that will not be found, Font3, so I calculate the Label1 
size based on the Size1 from GetTextExtentPoint32() so it will be the correct size for any font 
used, change the font name or font size in Font3 := CreateFontIndirect(FontLog1); 
and see how it changes Label1}
SendMessage(hLabel1,WM_SETFONT,Font3,0);

hIcon1 := CreateWindow('Static', 'MAINICON',
    WS_VISIBLE or WS_CHILD or SS_ICON,
    2,2,1,1,hMainForm,0,hInstance,nil);

hLabel2 := CreateWindow('Static', 'Compare to text below',
         WS_VISIBLE or WS_CHILD or SS_LEFT,48,40,290,16,hMainForm,0,hInstance,nil);
SendMessage(hLabel2,WM_SETFONT,Font2,0);

hOwnerDrawS := CreateWindow('Static', '',
         WS_VISIBLE or WS_CHILD or SS_OWNERDRAW,8,90,100,30,hMainForm,0,hInstance,nil);

hExitBut := CreateWindow('Button','Exit',
    WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT or BS_TOP or WS_GROUP,
    380,280,64,28,hMainForm,0,hInstance,nil);
SendMessage(hExitBut, WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);

hMakeBmpBut := CreateWindow('Button','Make Bmp',
    WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_Center or BS_TEXT,
    20,228,90,24,hMainForm,0,hInstance,nil);
SendMessage(hMakeBmpBut,WM_SETFONT,Font2,0);

hPaintBut := CreateWindow('Button','Paint It',
    WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_LEFT or BS_TEXT,
    20,258,80,21,hMainForm,0,hInstance,nil);
SendMessage(hPaintBut,WM_SETFONT,Font2,0);

hDrawBut := CreateWindow('Button','Draw It',
    WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_RIGHT or BS_TEXT,
    20,286,70,21,hMainForm,0,hInstance,nil);
SendMessage(hDrawBut,WM_SETFONT,Font1,0);

ShowWindow(hMainForm, SW_SHOWNORMAL);
{the WS_VISIBLE style was NOT set in the Main window creation}

UpdateWindow(hMainForm);
{the update line above is not needed here because the message loop
has not started yet, but I have added it to show that you need to 
update to get changes to be visible after the message loop starts}

while GetMessage(mainMsg,0,0,0) do
  begin
  {GetMessage will return True until it gets a WM_OUIT message}

    TranslateMessage(mainMsg);  // Translate any WM_KEYDOWN keyboard Msg to a WM_CHAR message
    DispatchMessage(mainMsg);   // Send Msg to the WndMessageProc
  end;
end.