Einzelnen Beitrag anzeigen

Bjoerk

Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
 
Delphi 10.4 Sydney
 
#14

AW: Polygon schraffieren (ohne Canvas.Polygon)

  Alt 22. Dez 2013, 22: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;
  Mit Zitat antworten Zitat