1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:

procedure TForm1.Button1Click(Sender: TObject);
// http://www.swissdelphicenter.ch/de/showcode.php?id=2332 (Benjamin van Eck)
const NewPenStyle: array[1..4] of DWORD = (10, 3, 1, 3);
var logBrush: TLogBrush;
begin
  logBrush.lbStyle := BS_SOLID;
  logBrush.lbColor := Canvas.Pen.Color;
  Image1.Canvas.Pen.Handle := ExtCreatePen(PS_GEOMETRIC or PS_USERSTYLE,
                              Image1.Canvas.Pen.Width, logBrush,
                              Length(NewPenStyle), @NewPenStyle);
  with Image1.Canvas do
    begin
      MoveTo(10,10);
      LineTo(200,10);
      LineTo(10,200);
    end;
end;

const
  SquarePenStyle = PS_GEOMETRIC or PS_ENDCAP_SQUARE or PS_JOIN_BEVEL;

procedure SetPen(Canvas: TCanvas; Color: TColor;
  Width: Integer; Style: TPenStyle);
var
  LogBrush: TLogBrush;
begin
  ZeroMemory(@LogBrush, SizeOf(LogBrush));
  LogBrush.lbColor := ColorToRGB(Color);
  LogBrush.lbHatch := 0;
  Canvas.Pen.Handle := ExtCreatePen(SquarePenStyle or Ord(Style), Width,
    LogBrush, 0, nil);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  SetPen(Image1.Canvas, clBlack, 5, psDashDotDot);
  Image1.Canvas.MoveTo(10, 10);
  Image1.Canvas.LineTo(200, 200);
end;