unit frxExportPSDocument;

interface

{$I frx.inc}

uses
{$IFNDEF Linux}
  Windows,
{$ELSE}
  LCLType, LCLIntf, LCLProc,
{$ENDIF}
  Messages, frxExportBaseDialog, SysUtils, Classes, Graphics, frxClass, frxExportMatrix, Math, frxBarcod, frxBarcode, frxBarcode2D,
  frxBarcodeMaxiCode, frxTableObject, frxRes, frxImageConverter, frxExportPSHelper;

type
  PSDocument = class
  protected
    psData: String;
    windowWidth, windowHeight: Double;

  protected
    procedure CreateWindow(name: String; Width, Height: Double); virtual;

    procedure createText(x, y: Double; HorizontalAlignment: TfrxHAlign; VerticalAlignment: TfrxVAlign; Width, Height: Double; font: TFont; textstr: String;
                PaddingLeft, PaddingRight, PaddingTop, PaddingBottom, BorderThickness: Double; Foreground, Background: String; Angle, Indent: Double);
    function TextAlignments(x: Double; var y: Double; HorizontalAlignment: TfrxHAlign; VerticalAlignment: TfrxVAlign; Width, Height: Double; font: TFont; txt_lns: TStringList;
               PaddingLeft, PaddingRight, PaddingTop, PaddingBottom, BorderThikness: Double): AOF;

    procedure MoveTo(x, y: Double);

    //procedure AppendBezier(x, y: Double;p1, p2, p3: TPoint);
    procedure AppendLine(x2, y2: Double);
    procedure StartFig(StrokeThickness: Double);
    function PSFont(font: String): String;
    //procedure EndFig(stroke, fill: String); overload;
    procedure EndFig(stroke: String);// overload;
    function ColorToPsRgb(htmlcolor: String): String;
    function FloatToString(flt: Double): String;
    //procedure ClosePath();
  public
    procedure AddPage(); virtual;
    procedure PSWrite(s: String);
    procedure PSWriteLn(s: String);

    procedure Convert(var left, top, width, height: Double);

    procedure AddTextLine(t_x: AOF; t_y: Double; Foreground: String; font: TFont; Width, Height: Double; txt_lns: TStringList; Angle, Indent: Double);

    procedure AddRectangle(x, y, Width, Height: Double; Stroke: String; StrokeThickness: Double; Fill: String; Rounded: Boolean);
    procedure AddEllipse(x, y, Width, Height: Double; Stroke: String; StrokeThickness: Double; Fill: String);
    procedure AddTriangle(x, y, Width, Height: Double; Stroke: String; StrokeThickness: Double; Fill: String);
    procedure AddDiamond(x, y, Width, Height: Double; Stroke: String; StrokeThickness: Double; Fill: String);
    procedure AddLine(x, y, x2, y2: Double; Stroke: String; StrokeThickness: Double; dash: TfrxFrameStyle); overload;
    procedure AddLine(x, y, x2, y2: Double; Stroke: String; StrokeThickness: Double); overload;
    procedure AddBezier(x, y: Double; p0, p1, p2, p3: TPoint; Stroke: String; StrokeThickness: Double);
    procedure AddImage(data: String;left, top, width, height: Double; pwidth, pheight: Integer; Involve: Boolean = True);

    procedure AddTextObject(x, y, Width, Height: Double;
       HorizontalAlignment: TfrxHAlign; VerticalAlignment: TfrxVAlign; BorderBrush: String;
       BorderThickness, LeftLine, TopLine, RightLine, BottomLine: Double;
       LeftLineDashStile, TopLineDashStile, RightLineDashStile, BottomLineDashStile: TfrxFrameStyle;
       colorLeftLine, colorTopLine, colorRightLine, colorBottomLine: String; Shadow: Boolean;
       ShadowColor: String; ShadowWidth: Double; Background: String; Typ: TfrxFrameTypes;Text, Foreground: String;
       PaddingLeft, PaddingTop, PaddingRight, PaddingBottom: Double;
       WordWrap: Boolean; Angle: Double; Glass: Boolean; colorTop: String; font: TFont; FIndent: Double);

    constructor Create(); overload;
    constructor Create(name: String; Width, Height: Double); overload;
    procedure Save(stream: TStream); overload; virtual;
    procedure Save(fn: String); overload; virtual;
    procedure Finish(); virtual;
end;


implementation

uses frxUtils;

function PSDocument.FloatToString(flt: Double): String;
begin
  result := FloatToStrF(flt, ffFixed, 18, 2);
  result  := StringReplace(result, ',', '.', [rfReplaceAll, rfIgnoreCase]);
  if (result[length(result)] = '0') then
  begin
    delete(result, length(result), 1);
    if (result[length(result)] = '0') then
      delete(result, length(result)-1, 2);
  end;
end;

procedure PSDocument.CreateWindow(name: String; Width, Height: Double);
begin
 { PSWriteLn('%!PS-Adobe');
  PSWriteLn('%%Title: postscriptdoc');
  PSWriteLn('%%Creator: FastReport');
  PSWriteLn('%%BoundingBox:   0   0   595   842');
  PSWriteLn('%% Pages: (atend)');
  PSWriteLn('%% DocumentFonts:');
  PSWriteLn('%% EndComments');
  PSWriteLn('%% EndProlog');
  PSWriteLn('%% Page: 1 1');  }
  windowHeight := Height * 2.835;
  windowWidth := Width * 2.835;
  if (Round(windowWidth) = 595) and (Round(windowHeight) = 842) then
    PSWrite('a4 ');
end;

procedure PSDocument.createText(x, y: Double; HorizontalAlignment: TfrxHAlign; VerticalAlignment: TfrxVAlign; Width, Height: Double; font: TFont; textstr: String;
            PaddingLeft, PaddingRight, PaddingTop, PaddingBottom, BorderThickness: Double; Foreground, Background: String; Angle, Indent: Double);
var
  t_x: AOF;
  t_y: Double;
  txt_lns: TStringList;
  line, testLine: String;
  n, rn: Integer;
  words: TStringList;
  BitWid: TBitmap;

  procedure AddStr();
  begin
   txt_lns.Add(line);
  end;

begin
  t_y := y;

  BitWid := TBitmap.Create();
  BitWid.Canvas.Font := font;

  txt_lns := TStringList.Create();
  words := TStringList.Create();
  words.Delimiter     := ' ';
  words.DelimitedText := textstr;
  line := '';
  for n := 0 to words.Count - 1 do
  begin
    testLine := line + words[n];
    if(BitWid.Canvas.TextWidth(testLine) * 0.75 > Width) then
    begin
      AddStr();
      line := words[n] + ' ';
    end
    else
    begin
      if ((pos(#13, words[n]) <> 0) and (pos(#10, words[n]) <> 0)) then
      begin
        if (pos(#10, testLine) <> 0) then
          rn := pos(#10, testLine)
        else
          rn := pos(#13, testLine);
        line := Copy(testLine, rn, Length(line) - rn);
        AddStr();
        line := Copy(testLine, 0, rn);
        line := StringReplace(StringReplace(line, #10, '', [rfReplaceAll, rfIgnoreCase]), #13, '', [rfReplaceAll, rfIgnoreCase]);
      end
      else
        line := testLine + ' ';
    end;
  end;
  if (txt_lns.Count = 0) then
    AddStr()
  else
    if (String(txt_lns[txt_lns.Count - 1]) <> line) then
      AddStr();

  t_x := TextAlignments(x, t_y, HorizontalAlignment, VerticalAlignment, Width, Height, font, txt_lns, PaddingLeft, PaddingRight, PaddingTop, PaddingBottom, BorderThickness);

  AddTextLine(t_x, t_y, Foreground, font, Width, Height, txt_lns, Angle, Indent);
  FreeAndNil(txt_lns);
  FreeAndNil(words);
  FreeAndNil(BitWid);
end;

procedure PSDocument.MoveTo(x, y: Double);
begin
  PSWrite(' ' + FloatToString(x) + ' ' + FloatToString(windowHeight - y) + ' moveto ');
end;

procedure PSDocument.AddTextLine(t_x: AOF; t_y: Double; Foreground: String; font: TFont; Width, Height: Double; txt_lns: TStringList; Angle, Indent: Double);
var
  fstart: Boolean;
  internal_data, gsave, coords, text_col: String;
  cur_y: Double;
  i: Integer;
begin
  fstart := true;
  internal_data := '';
  cur_y := 0;

  for i := 0 to txt_lns.Count-1 do
  begin
    text_col := ColorToPsRgb(Foreground);

    if (Angle = 0) then
    begin
      internal_data := '/' + PSFont(font.Name) + ' findfont ';
      internal_data := internal_data + FloatToString(font.Size) + ' scalefont setfont ';
      internal_data := internal_data + FloatToString(t_x[i]);
      internal_data := internal_data + ' ' + FloatToString(windowHeight - t_y - Height) + ' moveto ' + text_col + ' setrgbcolor (';
      internal_data := internal_data + txt_lns[i] + ') show ';
    end
    else
    begin
      if (Angle <= 90) then
      begin
        t_x[i] := Width / 2;
        t_y := t_y - Height / 2;
      end;

      if (fstart) then
      begin
        gsave := ' gsave ';
        fstart := false;
        coords := FloatToString(t_x[i]) + ' ' + FloatToString(windowHeight - t_y - Height) + ' translate 0 0 moveto ' + FloatToString(-Angle) + ' rotate ';
      end
      else
      begin
        gsave := '';
        coords := FloatToString(t_x[i] - t_x[0]) + ' ' + FloatToString(cur_y) + ' moveto ';
      end;
      cur_y := cur_y - font.Height * 0.75;                                      //not sure
      internal_data := gsave + '/' + font.Name + ' findfont ' + FloatToString(font.Size) + ' scalefont setfont ' +
      coords + text_col + ' setrgbcolor (' + txt_lns[i] + ') show ';
      if (i = txt_lns.Count - 1) then
        internal_data := internal_data + 'grestore ';
    end;
    PSWriteLn(internal_data + ' ');
    t_y := t_y + font.Size * Indent;
  end;
end;

function PSDocument.TextAlignments(x: Double; var y: Double; HorizontalAlignment: TfrxHAlign; VerticalAlignment: TfrxVAlign; Width, Height: Double; font: TFont; txt_lns: TStringList;
           PaddingLeft, PaddingRight, PaddingTop, PaddingBottom, BorderThikness: Double): AOF;
var
  objBmpImage: TBitmap;
  Xold, Yold: Double;
  n, i: Integer;
  x_alignments: AOF;
begin
  objBmpImage := TBitmap.Create();
  objBmpImage.Canvas.Font := font;

  Xold := x;
  Yold := y;
  n := txt_lns.Count;
  SetLength(x_alignments, txt_lns.Count);
  for i := 0 to txt_lns.Count - 1 do
    case (HorizontalAlignment) of
      haCenter:
        x_alignments[i] := (x + Width / 2 - objBmpImage.Canvas.TextWidth(String(txt_lns[i])) / 2 * 0.75);
      haRight:
        x_alignments[i] := (x + Width - objBmpImage.Canvas.TextWidth(String(txt_lns[i])) * 0.75);
      haLeft, haBlock: x_alignments[i] := x;
    end;
  case (VerticalAlignment) of
    vaCenter:
    begin
      y := y - Height / 2 + (font.Size)/2;
      if (N > 1) then y := y - (font.Size) / 2 * N;
    end;
    vaTop:
      y := y - Height + font.Size;
    vaBottom:
      if (N > 1) then y := y - font.Size * N;
  end;
  //Paddings
  if (Yold - Height + font.Size + PaddingTop > y) then
  begin
    y := Yold - Height + font.Size + PaddingTop;
  end;
  if (Yold - PaddingBottom < y) then
  begin
    y := Yold - PaddingBottom;
  end;
  for i := 0 to  length(x_alignments) - 1 do
  begin
    if (Xold + PaddingLeft > x_alignments[i]) then
    begin
      x_alignments[i] := Xold + PaddingLeft;
    end;
    if (Xold + Width - PaddingRight < x_alignments[i]) then
    begin
      x_alignments[i] := Xold + Width - PaddingRight;
    end;
  end;
  result := x_alignments;
  FreeAndNil(objBmpImage);
end;

procedure PSDocument.AddRectangle(x, y, Width, Height: Double; Stroke: String; StrokeThickness: Double; Fill: String; Rounded: Boolean);
var
  rgb_stroke, rgb_fill, fill_str, border_col, rect_stroke, gsave, grestore, internal_data, x1, y1, x2, y2, x3, y3, x4, y4: String;
begin
  if ((StrokeThickness = 0) and (Fill = 'none')) then
    Exit;
  fill_str := '';
  border_col := '';
  rect_stroke := '';
  gsave := 'gsave ';
  grestore := 'grestore ';

  if (StrokeThickness = 0) then
  begin
    gsave := '';
    grestore := '';
  end
  else
  begin
    rgb_stroke := ColorToPsRgb(Stroke);
    border_col := rgb_stroke + ' setrgbcolor ';
  end;
  if (Fill <> 'none') then
  begin
    rgb_fill := ColorToPsRgb(Fill);
    fill_str := gsave + rgb_fill + ' setrgbcolor fill ' + grestore;
  end;

  rect_stroke := FloatToString(StrokeThickness) + ' setlinewidth ';
  if (Rounded) then
  begin
    x1 := FloatToString(x);
    y1 := FloatToString(windowHeight - y - Height);
    x2 := FloatToString(x);
    y2 := FloatToString(windowHeight - y);
    x3 := FloatToString(x + Width);
    y3 := FloatToString(windowHeight - y); ;
    x4 := FloatToString(x + Width);
    y4 := FloatToString(windowHeight - y - Height);
    internal_data := FloatToString(StrokeThickness) + ' setlinewidth ' + FloatToString(x + Width/2) + ' ' +
    FloatToString(windowHeight - y - Height) + ' moveto ' +
    x1 + ' ' + y1 + ' ' + x2 + ' ' + y2 + ' 5 arct ' +
    x2 + ' ' + y2 + ' ' + x3 + ' ' + y3 + ' 5 arct ' +
    x3 + ' ' + y3 + ' ' + x4 + ' ' + y4 + ' 5 arct ' +
    x4 + ' ' + y4 + ' ' + x1 + ' ' + y1 + ' 5 arct closepath ' + fill_str + border_col + 'stroke';
  end
  else
  begin
    internal_data := FloatToString(StrokeThickness) + ' setlinewidth ' + FloatToString(x) + ' ' +
    FloatToString(windowHeight - y - Height) + ' newpath moveto ' + FloatToString(x) + ' ' + FloatToString(windowHeight - y) +
    ' lineto  ' + FloatToString(x + Width) + ' ' + FloatToString(windowHeight - y) +
    ' lineto  ' + FloatToString(x + Width) + ' ' + FloatToString(windowHeight - y - Height) +
    ' lineto  closepath ' + fill_str + border_col + 'stroke';
  end;
  PSWrite(internal_data + ' ');
end;

procedure PSDocument.AddEllipse(x, y, Width, Height: Double; Stroke: String; StrokeThickness: Double; Fill: String);
var
  rgb_stroke, rgb_fill, fill_str, border_col, ell_stroke, gsave, grestore, internal_data: String;
begin
  if ((StrokeThickness = 0) and (Fill = 'none')) then
    Exit;
  fill_str := '';
  border_col := '';
  ell_stroke := '';
  gsave := 'gsave ';
  grestore := 'grestore ';

  if (StrokeThickness = 0) then
  begin
    gsave := '';
    grestore := '';
  end
  else
  begin
    rgb_stroke := ColorToPsRgb(Stroke);
    border_col := rgb_stroke + ' setrgbcolor ';
  end;
  if (Fill <> 'none') then
  begin
    rgb_fill := ColorToPsRgb(Fill);
    fill_str := gsave + rgb_fill + ' setrgbcolor fill ' + grestore;
  end;
  ell_stroke := FloatToString(StrokeThickness) + ' setlinewidth ';
  internal_data := '';


  internal_data := FloatToString(StrokeThickness) + ' setlinewidth ' +
  FloatToString(x + Width/2) + ' ' + FloatToString(windowHeight - y - Height / 2) +
  ' ' + FloatToString(Width/2) + ' 0 360 arc closepath '
  + fill_str + border_col + 'stroke';

  PSWrite(internal_data + ' ');
end;

procedure PSDocument.AddTriangle(x, y, Width, Height: Double; Stroke: String; StrokeThickness: Double; Fill: String);
var
  x2, y2, x3, y3: Double;
  rgb_stroke, rgb_fill, fill_str, border_col, tri_stroke, gsave, grestore, internal_data: String;
begin
  if ((StrokeThickness = 0) and (Fill = 'none')) then
    Exit;
  x2 := Width + x;
  y2 := y;
  x3 := x + Width/2;
  y3 := y;

  fill_str := '';
  border_col := '';
  tri_stroke := '';
  gsave := 'gsave ';
  grestore := 'grestore ';

  if (StrokeThickness = 0) then
  begin
    gsave := '';
    grestore := '';
  end
  else
  begin
      rgb_stroke := ColorToPsRgb(Stroke);
      border_col := rgb_stroke + ' setrgbcolor ';
  end;
  if (Fill <> 'none') then
  begin
      rgb_fill := ColorToPsRgb(Fill);
      fill_str := gsave + rgb_fill + ' setrgbcolor fill ' + grestore;
  end;
  tri_stroke := FloatToString(StrokeThickness) + ' setlinewidth ';

  internal_data := FloatToString(StrokeThickness) + ' setlinewidth ' + FloatToString(x) + ' ' +
  FloatToString(windowHeight - y - Height) + ' newpath moveto ' + FloatToString(x2) + ' ' + FloatToString(windowHeight - Height - y2) +
  ' lineto  ' + FloatToString(x3) + ' ' + FloatToString(windowHeight - y3) +
  ' lineto  closepath ' + fill_str + border_col + 'stroke';

  PSWrite(internal_data + ' ');
end;

procedure PSDocument.AddDiamond(x, y, Width, Height: Double; Stroke: String; StrokeThickness: Double; Fill: String);
var
  x1, y1, x2, y2, x3, y3, x4, y4: Double;
  rgb_stroke, rgb_fill, fill_str, border_col, tri_stroke, gsave, grestore, internal_data: String;
begin
  x1 := Width / 2 + x;
  y1 := y;
  x2 := Width + x;
  y2 := Height / 2 + y;
  x3 := Width / 2 + x;
  y3 := y;
  x4 := x;
  y4 := Height / 2 + y;

  fill_str := '';
  border_col := '';
  tri_stroke := '';
  gsave := 'gsave ';
  grestore := 'grestore ';

  if (StrokeThickness = 0) then
  begin
    gsave := '';
    grestore := '';
  end
  else
  begin
      rgb_stroke := ColorToPsRgb(Stroke);
      border_col := rgb_stroke + ' setrgbcolor ';
  end;
  if (Fill <> 'none') then
  begin
      rgb_fill := ColorToPsRgb(Fill);
      fill_str := gsave + rgb_fill + ' setrgbcolor fill ' + grestore;
  end;
  tri_stroke := FloatToString(StrokeThickness) + ' setlinewidth ';

  internal_data := FloatToString(StrokeThickness) + ' setlinewidth ' + FloatToString(x1) + ' ' +
  FloatToString(windowHeight - y1 - Height) + ' newpath moveto ' + FloatToString(x2) + ' ' + FloatToString(windowHeight - y2) +
  ' lineto  ' + FloatToString(x3) + ' ' + FloatToString(windowHeight - y3) +
  ' lineto  ' + FloatToString(x4) + ' ' + FloatToString(windowHeight - y4) +
  ' lineto  closepath ' + fill_str + border_col + 'stroke';

  PSWrite(internal_data + ' ');
end;

procedure PSDocument.AddLine(x, y, x2, y2: Double; Stroke: String; StrokeThickness: Double; dash: TfrxFrameStyle);
var
  line_col, line_stroke, rgb, StrokeDashArray, internal_data: String;
begin
  line_col := '';
  line_stroke := '';
  rgb := ColorToPsRgb(Stroke);

  StrokeDashArray := '';
  case (dash) of
    fsDash: StrokeDashArray := ' [5] 0 setdash ';
    fsDot: StrokeDashArray := '[2 2] 0 setdash';
    fsDashDot: StrokeDashArray := '[2 2 5 2] 0 setdash';
    fsDashDotDot: StrokeDashArray := '[2 2 2 2 5 2] 0 setdash';
    fsDouble:
    begin
      StrokeDashArray := '';
      AddLine(x+10, y+10, x2+10, y2+10, Stroke, StrokeThickness);
    end;
  end;

  line_col := rgb + ' setrgbcolor ';
  line_stroke := FloatToString(StrokeThickness) + ' setlinewidth ' + StrokeDashArray + ' ';
  internal_data := line_stroke + FloatToString(x) + ' ' +
  FloatToString(windowHeight - y) + ' newpath moveto ' + FloatToString(x2) + ' ' + FloatToString(windowHeight - y2) +
  ' lineto  ' + line_col + 'stroke [ ] 0 setdash';
  PSWrite(internal_data + ' ');
end;

procedure PSDocument.AddLine(x, y, x2, y2: Double; Stroke: String; StrokeThickness: Double);
begin
  StartFig(StrokeThickness);
  MoveTo(x, y);
  AppendLine(x2, y2);
  EndFig(Stroke);
end;

procedure PSDocument.AddPage;
begin
///
end;

procedure PSDocument.AddBezier(x, y: Double; p0, p1, p2, p3: TPoint; Stroke: String; StrokeThickness: Double);
var
  line_col, line_stroke, rgb, internal_data: String;
begin
  line_col := '';
  line_stroke := '';
  rgb := ColorToPsRgb(Stroke);
  line_col := rgb + ' setrgbcolor ';
  line_stroke := FloatToString(StrokeThickness) + ' setlinewidth ';
  internal_data := line_stroke + FloatToString(x + p0.X) + ' ' +
  FloatToString(windowHeight - y - p0.Y) + ' newpath moveto ' +
  FloatToString(x + p1.X) + ' ' + FloatToString(windowHeight - y - p1.Y) + ' ' +
  FloatToString(x + p2.X) + ' ' + FloatToString(windowHeight - y - p2.Y) + ' ' +
  FloatToString(x + p3.X) + ' ' + FloatToString(windowHeight - y - p3.Y) + ' ' +
  ' curveto ' + line_col + 'stroke';
  PSWrite(internal_data + ' ');
end;

{procedure PSDocument.AppendBezier(x, y: Double;p1, p2, p3: TPoint);              //not used
var
  internal_data: String;
begin
   internal_data :=
   FloatToString(x + p1.X * 0.75) + ' ' + FloatToString(windowHeight - y - p1.Y * 0.75) + ' ' +
   FloatToString(x + p2.X * 0.75) + ' ' + FloatToString(windowHeight - y - p2.Y * 0.75) + ' ' +
   FloatToString(x + p3.X * 0.75) + ' ' + FloatToString(windowHeight - y - p3.Y * 0.75) + ' ' +
   ' curveto ';
   PSWrite(internal_data);
end;}

procedure PSDocument.AppendLine(x2, y2: Double);
var
  internal_data: String;
begin
  internal_data := FloatToString(x2) + ' ' + FloatToString(windowHeight - y2) + ' lineto ';
  PSWrite(internal_data);
end;

procedure PSDocument.StartFig(StrokeThickness: Double);
var
  line_stroke: String;
begin
  line_stroke := ' ';
  line_stroke := FloatToString(StrokeThickness) + ' setlinewidth ';
  PSWrite(line_stroke + ' ');
end;

function PSDocument.PSFont(font: String): String;
begin
  result := StringReplace(font, ' ', '-', [rfReplaceAll, rfIgnoreCase]);
end;

{procedure PSDocument.EndFig(stroke, fill: String);
var
  rgb_stroke, l, rgb_fill: String;
begin
  rgb_stroke := ColorToPsRgb(stroke);
  l := '';
  rgb_fill := ColorToPsRgb(stroke);
  l := l + (*' gsave ' +*) rgb_fill + ' setrgbcolor fill '(*grestore '*);
  PSWrite(l + rgb_stroke +' ');
end;}

procedure PSDocument.EndFig(stroke: String);
var
  rgb_stroke: String;
begin
  rgb_stroke := ColorToPsRgb(stroke);
  PSWrite(' gsave ' + rgb_stroke + '  setrgbcolor stroke grestore ');
end;

function PSDocument.ColorToPsRgb(htmlcolor: String): String;
var
  tmpRGB : TColorRef;
begin
  Delete(htmlcolor, 1, 1);
  tmpRGB := ColorToRGB(HexToTColor(htmlcolor)) ;
  result := FloatToString(GetRValue(tmpRGB) / 255) + ' ' + FloatToString(GetGValue(tmpRGB) / 255) + ' ' + FloatToString(GetBValue(tmpRGB) / 255);
end;

{procedure PSDocument.ClosePath();
begin
  PSWrite(' closepath ');
end;}

procedure PSDocument.Convert(var left, top, width, height: Double);
begin
  left := MmToPt(DpToMm(left));
  top := MmToPt(DpToMm(top));
  width := DpToPt(width);
  height := DpToPt(height);
end;

procedure PSDocument.PSWrite(s: String);
begin
  psData := psData + s;
end;

procedure PSDocument.PSWriteLn(s: String);
begin
  PSWrite(s + sLineBreak);
end;

procedure PSDocument.AddImage(data: String;left, top, width, height: Double; pwidth, pheight: Integer; Involve: Boolean = True);
begin
  Convert(left, top, width, height);
  PSWrite(' gsave '+ FloatToString(left) + ' '+FloatToString(windowHeight - height - top));  //set lower left of image at (360, 72)
  PSWrite(' translate ' + FloatToString(Round(width)) + ' ' + FloatToString(Round(height))); //size of rendered image is 175 points by 47 points
  PSWrite(' scale ' + IntToStr(pwidth) + ' ' + IntToStr(pheight)); //number of columns per row and number of rows
  PSWrite(' 8 '); //bits per color channel (1, 2, 4, or 8)
  PSWrite('['+ IntToStr(pwidth) + ' 0 0 -' + IntToStr(pheight) + ' 0 ' + IntToStr(pheight) + '] ');     //transform array... maps unit square to pixel
  if (Involve) then
    PSWrite(data + ' /ASCIIHexDecode filter 0 dict /DCTDecode filter ')
  else
    PSWrite('(' + data + ') (r) file /DCTDecode filter ');
  PSWrite('false '); //pull channels from separate sources
  PSWrite('3 ');     // 3 color channels (RGB)
  PSWrite('colorimage ');
  PSWrite('grestore ');
end;

procedure PSDocument.AddTextObject(x, y, Width, Height: Double;
   HorizontalAlignment: TfrxHAlign; VerticalAlignment: TfrxVAlign; BorderBrush: String;
   BorderThickness, LeftLine, TopLine, RightLine, BottomLine: Double;
   LeftLineDashStile, TopLineDashStile, RightLineDashStile, BottomLineDashStile: TfrxFrameStyle;
   colorLeftLine, colorTopLine, colorRightLine, colorBottomLine: String; Shadow: Boolean;
   ShadowColor: String; ShadowWidth: Double; Background: String; Typ: TfrxFrameTypes;Text, Foreground: String;
   PaddingLeft, PaddingTop, PaddingRight, PaddingBottom: Double;
   WordWrap: Boolean; Angle: Double; Glass: Boolean; colorTop: String; font: TFont; FIndent: Double);
var
  All, Left, Right, Top, Bottom: Boolean;
begin
  Convert(x, y, Width, Height);
  Right := ftRight in Typ;
  Left := ftLeft in Typ;
  Top := ftTop in Typ;
  Bottom := ftBottom in Typ;
  All := (Left and Right and Top and Bottom);

  if (All and ((LeftLine = TopLine) and (TopLine = RightLine) and (RightLine = BottomLine)) and
    ((LeftLineDashStile = TopLineDashStile) and (TopLineDashStile = RightLineDashStile) and
    (RightLineDashStile = BottomLineDashStile) and (BottomLineDashStile = fsSolid)) and
    ((colorLeftLine = colorTopLine) and (colorTopLine = colorRightLine) and (colorRightLine = colorBottomLine)
    (*&& colorBottomLine == Background*))) then
  begin
    AddRectangle(x, y, Width, Height, BorderBrush, BorderThickness, Background, false);
  end
  else
  begin
    if (Background <> 'none') then
      AddRectangle(x, y, Width, Height, BorderBrush, 0, Background, false);
    if (Left or All) then
      case (LeftLineDashStile) of
        fsSolid: AddLine(x, y, x, y + Height, colorLeftLine, LeftLine);
        fsDouble:
        begin
          AddLine(x, y, x, y + Height, colorLeftLine, LeftLine);
          AddLine(x - BorderThickness * 2, y - BorderThickness * 2, x - BorderThickness * 2, y + Height + BorderThickness * 2, colorLeftLine, LeftLine);
        end;
        else
          AddLine(x, y, x, y + Height, colorLeftLine, LeftLine, LeftLineDashStile);
      end;
    if (Right or All) then
      case (LeftLineDashStile) of
        fsSolid: AddLine(x + Width, y, x + Width, y + Height, colorRightLine, RightLine);
        fsDouble:
        begin
          AddLine(x + Width, y, x + Width, y + Height, colorRightLine, RightLine);
          AddLine(x + Width + BorderThickness * 2, y - BorderThickness * 2, x + Width + BorderThickness * 2, y + Height + BorderThickness * 2, colorRightLine, RightLine);
        end;
        else
          AddLine(x + Width, y, x + Width, y + Height, colorRightLine, RightLine, LeftLineDashStile);
      end;
    if (Top or All) then
      case (LeftLineDashStile) of
        fsSolid: AddLine(x, y, x + Width, y, colorTopLine, TopLine);
        fsDouble:
        begin
          AddLine(x, y, x + Width, y, colorTopLine, TopLine);
          AddLine(x - BorderThickness * 2, y - BorderThickness * 2, x + Width + BorderThickness * 2, y - BorderThickness * 2, colorTopLine, TopLine);
        end;
        else
          AddLine(x, y, x + Width, y, colorTopLine, TopLine, LeftLineDashStile);
      end;
    if (Bottom or All) then
      case (LeftLineDashStile) of
        fsSolid: AddLine(x, y + Height, x + Width, y + Height, colorBottomLine, BottomLine);
        fsDouble:
        begin
          AddLine(x, y + Height, x + Width, y + Height, colorBottomLine, BottomLine);
          AddLine(x - BorderThickness * 2, y + Height + BorderThickness * 2, x + Width + BorderThickness * 2, y + Height + BorderThickness * 2, colorBottomLine, BottomLine);
        end;
        else
          AddLine(x, y + Height, x + Width, y + Height, colorBottomLine, BottomLine, LeftLineDashStile);
      end;
  end;
  //Glass--------------------
  if (Glass) then
  begin
    AddRectangle(x, y, Width, Height / 2, BorderBrush, 0, colorTop, false);
    AddRectangle(x, y + Height / 2, Width, Height / 2, BorderBrush, 0, Background, false);
  end;
  //Shadow-------------------
  if (Shadow) then
  begin
    AddLine(x + ShadowWidth, y + Height + ShadowWidth / 2, x + Width + ShadowWidth, y + Height + ShadowWidth / 2, ShadowColor, ShadowWidth);
    AddLine(x + Width + ShadowWidth / 2, y + ShadowWidth, x + Width + ShadowWidth / 2, y + Height + ShadowWidth, ShadowColor, ShadowWidth);
  end;

  if (Text <> '') then
    createText(x, y, HorizontalAlignment, VerticalAlignment, Width, Height, font, Text, PaddingLeft, PaddingRight, PaddingTop, PaddingBottom, BorderThickness, Foreground, Background, Angle, FIndent);
end;

constructor PSDocument.Create();
begin

end;

constructor PSDocument.Create(name: String; Width, Height: Double);
begin
  CreateWindow(name, Width, Height);
end;

procedure PSDocument.Save(stream: TStream);
{$IFDEF Delphi14}
var AnsStr: AnsiString;
{$ENDIF}
begin
{$IFDEF Delphi14}
 {$WARNINGS OFF}
  AnsStr := psData;
 {$WARNINGS ON}
  stream.Write(Pointer(AnsStr)^, length(AnsStr));
{$ELSE}
  stream.Write(Pointer(psData)^, length(psData));
{$ENDIF}
end;

procedure PSDocument.Save(fn: String);
var
  f:TextFile;
begin
  AssignFile(f, fn);
  ReWrite(f);
  Write(f, psData);
  CloseFile(f);
end;

procedure PSDocument.Finish();
begin
  PSWriteLn('showpage');
  {PSWriteLn('%%Trailer');
  PSWriteLn('%% Pages: 1');
  PSWrite('%% EOF');}
end;

end.

