Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
Delphi 10.4 Sydney
|
AW: Polygon schraffieren (ohne Canvas.Polygon)
22. Dez 2013, 23:49
Genauso so sieht's aus, Ihr habt vollkommen recht.
Beispiel:
Delphi-Quellcode:
procedure HatchSolidDash(Canvas: TCanvas; const Polygon: array of TPoint;
HatchColor: TColor; Frequency: integer);
var
I, J: integer;
ClipRgn: HRGN;
CanvasWidth, CanvasHeight: integer;
begin
ClipRgn := CreatePolygonRgn(Polygon[0], Length(Polygon), WINDING);
try
SelectClipRgn(Canvas.Handle, ClipRgn);
CanvasWidth := Canvas.ClipRect.Right - Canvas.ClipRect.Left;
CanvasHeight := Canvas.ClipRect.Bottom - Canvas.ClipRect.Top;
Canvas.Pen.Color := HatchColor;
Canvas.Pen.Width := 1;
I := 0;
J := 0;
while (I < CanvasHeight) or (I < CanvasWidth) do
begin
Canvas.MoveTo(0, I * Frequency);
Canvas.LineTo(I * Frequency, 0);
Inc(I, Frequency);
Inc(J);
if Odd(J) then
Canvas.Pen.Style := psSolid
else
Canvas.Pen.Style := psDash;
end;
finally
DeleteObject(ClipRgn);
SelectClipRgn(Canvas.Handle, 0);
end;
end;
procedure TForm2.Button4Click(Sender: TObject);
var
Points: array of TPoint;
begin
SetLength(Points, 12);
Points[0] := Point(100, 150);
Points[1] := Point(200, 150);
Points[2] := Point(250, 200);
Points[3] := Point(200, 350);
Points[4] := Point(100, 350);
Points[5] := Point(50, 400);
Points[6] := Point(400, 150);
Points[7] := Point(500, 50);
Points[8] := Point(55, 100);
Points[9] := Point(500, 250);
Points[10] := Point(400, 350);
Points[11] := Point(350, 400);
HatchSolidDash(Canvas, Points, clRed, 3);
Canvas.Pen.Width := 1;
Canvas.Brush.Style := bsClear;
Canvas.Pen.Style := psSolid;
Canvas.Pen.Color := clBlack;
Canvas.Polygon(Points);
end;
|
|
Zitat
|