clipper2-sys 1.0.0

Polygon Clipping and Offsetting (Clipper2 wrapper)
Documentation
unit ClipMisc;

interface

uses
  SysUtils, Classes, Windows, Math, ShellAPI, Clipper.Core;

function ScaleAndOffset(const paths: TPathsD; scale: single; offset: Clipper.Core.TPointD): TPathsD;

function MakeRandomPath(maxWidth, maxHeight, count: Integer;
  margin: Integer = 0): TPath64; overload;

function MakeRandomPathD(maxWidth, maxHeight, count: Integer;
  margin: Integer = 10): TPathD;

function MakeNPointedStar(const rec: TRect64;
  points: integer = 5): TPath64; overload;

function PointInPath(const pt: TPointD; const path: TPathD): Boolean;

procedure DisplayAsSvg(const caption: string;
  fillRule: TFillRule; const subj, clip, sol: TPaths64;
  hideCaption: Boolean = false); overload;

procedure DisplayAsSvg(const caption: string;
  fillRule: TFillRule; const subj, clip, sol: TPathsD;
  hideCaption: Boolean = false); overload;

procedure DisplayAsSvg_Open(const caption: string;
  fillRule: TFillRule; isJoined: Boolean;
  const openSub, clip, sol: TPaths64; solIsOpen: Boolean;
  hideCaption: Boolean = false); overload;

procedure DisplayAsSvg_Open(const caption: string;
  fillRule: TFillRule; isJoined: Boolean;
  const openSub, clip, sol: TPathsD; solIsOpen: Boolean;
  hideCaption: Boolean = false); overload;

procedure DisplayAsSvg_MultiColor(const caption: string;
  fillRule: TFillRule; const subj, sol: TPathsD);

implementation

uses
  Clipper, Clipper.SVG;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

procedure DisplayAsSvg(const caption: string;
  fillRule: TFillRule; const subj, clip, sol: TPaths64;
  hideCaption: Boolean = false);
var
  filename: string;
  r: TRect64;
begin
  ForceDirectories('.\SVG');
  filename := format('.\SVG\%s.SVG',[caption]);
  with TSvgWriter.Create(fillRule) do
  try
    if Assigned(subj) then
      AddPaths(subj, false, $1000BBFF, $800099FF, 0.8);
    if Assigned(clip) then
      AddPaths(clip, false, $12F99F00, $80FF9900, 0.8);
    if Assigned(sol) then
      AddPaths(sol, false, $2000FF00, $FF006600, 0.8);
    r := GetBounds(sol);
    if not hideCaption then
      AddText(caption, r.Left + 20, r.Top + 20);
    SaveToFile(filename);
  finally
    free;
  end;
  ShellExecute(0, 'open', PChar(filename), nil, nil, SW_SHOW);
end;
//------------------------------------------------------------------------------

procedure DisplayAsSvg(const caption: string;
  fillRule: TFillRule; const subj, clip, sol: TPathsD;
  hideCaption: Boolean = false);
var
  filename: string;
  r: TRectD;
begin
  ForceDirectories('.\SVG');
  filename := format('.\SVG\%s.SVG',[caption]);
  with TSvgWriter.Create(fillRule) do
  try
    if Assigned(subj) then
      AddPaths(subj, false, $1000BBFF, $800099FF, 0.8);
    if Assigned(clip) then
      AddPaths(clip, false, $12F99F00, $80FF9900, 0.8);
    if Assigned(sol) then
      AddPaths(sol, false, $2000FF00, $FF006600, 0.8);
    r := GetBounds(sol);
    if not hideCaption then
      AddText(caption, Round(r.Left) + 20, Round(r.Top) + 20);
    SaveToFile(filename);
  finally
    free;
  end;
  ShellExecute(0, 'open', PChar(filename), nil, nil, SW_SHOW);
end;
//------------------------------------------------------------------------------

procedure DisplayAsSvg_Open(const caption: string;
  fillRule: TFillRule; isJoined: Boolean;
  const openSub, clip, sol: TPaths64; solIsOpen: Boolean;
  hideCaption: Boolean = false);
var
  filename: string;
  r: TRect64;
begin
  ForceDirectories('.\SVG');
  filename := format('.\SVG\%s.SVG',[caption]);
  with TSvgWriter.Create(fillRule) do
  try
    if Assigned(openSub) then
      AddPaths(openSub, not isJoined, $0, $800099FF, 0.8);
    if Assigned(clip) then
      AddPaths(clip, false, $12F99F00, $80FF9900, 0.8);
    if Assigned(sol) then
    begin
      if solIsOpen then
        AddPaths(sol, false, $0, $FF006600, 1.5) else
        AddPaths(sol, false, $2000FF00, $FF006600, 1.0);
    end;
    r := GetBounds(sol);
    if not hideCaption then
      AddText(caption, r.Left + 20, r.Top + 20);
    SaveToFile(filename);
  finally
    free;
  end;
  ShellExecute(0, 'open', PChar(filename), nil, nil, SW_SHOW);
end;
//------------------------------------------------------------------------------

procedure DisplayAsSvg_Open(const caption: string;
  fillRule: TFillRule; isJoined: Boolean;
  const openSub, clip, sol: TPathsD; solIsOpen: Boolean;
  hideCaption: Boolean);
var
  filename: string;
  r: TRectD;
begin
  ForceDirectories('.\SVG');
  filename := format('.\SVG\%s.SVG',[caption]);
  with TSvgWriter.Create(fillRule) do
  try
    if Assigned(openSub) then
      AddPaths(openSub, not isJoined, $0, $800099FF, 0.8);
    if Assigned(clip) then
      AddPaths(clip, false, $12F99F00, $80FF9900, 0.8);
    if Assigned(sol) then
    begin
      if solIsOpen then
        AddPaths(sol, false, $0, $FF006600, 1.5) else
        AddPaths(sol, false, $2000FF00, $FF006600, 1.0);
    end;
    r := GetBounds(sol);
    if not hideCaption then
      AddText(caption, Round(r.Left) + 20, Round(r.Top) + 20);
    SaveToFile(filename);
  finally
    free;
  end;
  ShellExecute(0, 'open', PChar(filename), nil, nil, SW_SHOW);
end;
//------------------------------------------------------------------------------

function RandomColor: Cardinal; inline;
begin
  Result := Cardinal(Random($1000000)) or $FF000000;
end;
//------------------------------------------------------------------------------

procedure DisplayAsSvg_MultiColor(const caption: string;
  fillRule: TFillRule; const subj, sol: TPathsD);
var
  i: integer;
  filename: string;
begin
  ForceDirectories('.\SVG');
  filename := format('.\SVG\%s.SVG',[caption]);
  with TSvgWriter.Create(fillRule) do
  try
    if Assigned(subj) then
      AddPaths(subj, false, $1000BBFF, $800099FF, 0.8);
    if Assigned(sol) then
    begin
      Randomize;
      for i := 0 to High(sol) do
        AddPath(sol[i], false, RandomColor, $20000000, 1.0, false);
    end;
    SaveToFile(filename);
  finally
    free;
  end;
  ShellExecute(0, 'open', PChar(filename), nil, nil, SW_SHOW);
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

function ScaleAndOffset(const paths: TPathsD; scale: single; offset: Clipper.Core.TPointD): TPathsD;
var
  i, j, len: Integer;
begin
  len := length(paths);
  if len = 0 then Exit;
  setlength(Result, len);

  for i := 0 to len -1 do
  begin
    len := length(paths[i]);
    setlength(Result[i], len);
    for j := 0 to len -1 do
    begin
      Result[i][j].X := offset.X + round(paths[i][j].X * scale);
      Result[i][j].Y := offset.Y + round(paths[i][j].Y * scale);
    end;
  end;
end;
//------------------------------------------------------------------------------

function MakeRandomPath(maxWidth, maxHeight, count: Integer;
  margin: Integer): TPath64;
var
  i: Integer;
begin
  setlength(Result, count);
  for i := 0 to count -1 do with Result[i] do
  begin
    X := Random(maxWidth - 2 * margin) + margin;
    Y := Random(maxHeight - 2 * margin) + margin;
  end;
end;
//------------------------------------------------------------------------------

function MakeRandomPathD(maxWidth, maxHeight, count: Integer;
  margin: Integer = 10): TPathD;
var
  tmp: TPath64;
begin
  tmp := MakeRandomPath(maxWidth, maxHeight, count, margin);
  Result := PathD(tmp);
end;
//------------------------------------------------------------------------------

function MakeNPointedStar(const rec: TRect64; points: integer = 5): TPath64;
var
  i,j, jump, len: integer;
  tmp: TPath64;
begin
  if not Odd(points) then dec(points);
  if (points < 5) then points := 5;
  tmp := Clipper.Core.Ellipse(rec, points);
  len := Length(tmp);
  SetLength(Result, len);
  jump := len div 2;
  j := 0;
  for i := 0 to len -1 do
  begin
    Result[i] := tmp[j mod len];
    inc(j, jump);
  end;
end;
//------------------------------------------------------------------------------

function PointInPath(const pt: TPointD; const path: TPathD): Boolean;
var
  i: integer;
begin
  Result := true;
  for i := 0 to high(path) do
    if Clipper.Core.PointsNearEqual(pt, path[i], 0.001) then Exit;
  Result := false;
end;
//------------------------------------------------------------------------------

end.