How to draw dotted or dashed lines using a pen with a width greater than 1 #143
I once got around this silly limitation by writing a wrapper procedure that would figure out where each dot or dash belonged, and draw many tiny line segments using a solid pen. One of the parameters to the procedure was a string indicating the pattern, which looked like morse code (any arrangement of dots and dashes is allowed).
However, the procedure is ugly. It will handle polylines, and if a polyline vertex falls right in the middle of a dash, then the dash will bend around the corner correctly.
The LineTo method of TCanvas cannot reliably render dashed lines more than one pixel wide. This procedure provides a workaround.
{Copyright (c) 1996 G. Williams} procedure PlotDashedLine(const Canvas: TCanvas; const Vertices: array of TPoint; const Pattern: String; const DashLength: Integer); var PenDown: Boolean; Index: Integer; procedure PlotTo(const Position: TPoint); begin with Canvas, Position do if (PenDown) then LineTo(X, Y) else MoveTo(X, Y); end; function Advance(const Distance: Integer): Boolean; var DistanceRemaining: Single; DistanceToNextVertex: Single; begin Result := false; DistanceRemaining := Distance; DistanceToNextVertex := PointDist(Canvas.PenPos, Vertices[Index]); while (DistanceRemaining > DistanceToNextVertex) do begin DistanceRemaining := DistanceRemaining - DistanceToNextVertex; PlotTo(Vertices[Index]); Inc(Index); if (Index > High(Vertices)) then Exit; DistanceToNextVertex := PointDist(Canvas.PenPos, Vertices[Index]); end; with Canvas.PenPos do if (FltEqual(DistanceToNextVertex, 0)) then PlotTo(Vertices[Index]) else PlotTo( Point( Round( X + DistanceRemaining / DistanceToNextVertex * (Vertices[Index].X - X) ), Round( Y + DistanceRemaining / DistanceToNextVertex * (Vertices[Index].Y - Y) ) ) ); Result := true; end; var PatternIndex: Integer; OldPenStyle: TPenStyle; begin OldPenStyle := Canvas.Pen.Style; Canvas.Pen.Style := psSolid; Canvas.MoveTo(Vertices[0].X, Vertices[0].Y); PatternIndex := 1; Index := 1; while (true) do begin PenDown := true; case Pattern[PatternIndex] of '.': if not(Advance(0)) then Break; '-': if not(Advance(DashLength)) then Break; else ShowError(''); end; PenDown := false; if not(Advance(DashLength)) then Break; Inc(PatternIndex); if (PatternIndex > Length(Pattern)) then PatternIndex := 1; end; Canvas.Pen.Style := OldPenStyle; end;
Original resource: | The Delphi Pool |
---|---|
Author: | Gary Williams |
Added: | 2009/11/06 |
Last updated: | 2009/11/06 |