unit uBafPdfModule;

// this code is under the BAF fair use license (BFUL) - https://bafbal.de/index.php?title=Bful
// module for creating PDFs
// https://bafbal.de/index.php?title=Modul_PDF

interface

//{$DEFINE with_zint}
//{$DEFINE with_mormot}

uses System.Math, System.SysUtils, System.Classes, uBafTypes, uBafInterpreter,
  System.Contnrs, System.StrUtils, System.UiTypes, FMX.Graphics,

  {$IFDEF with_mormot}
  SynPdfFmx,
  {$ENDIF}

  {$IFDEF with_zint}
  zint, zint_helper, zint_render_fmx_bmp,
  {$ENDIF}

  FMX.Dialogs, uBafPage, System.Types, DB, dmMain, FMX.Types;

type
  TBafPdfMargins = record
    Left: single;
    Right: single;
  end;

  TBafPdfPicture = class
    Width: integer;
    Height: integer;
  end;

  TBafPdfGridColumn = class
    Index: integer;
    Page: integer;
    Left: single;
    Right: single;
  end;

  TBafPdfModule = class(TBafInterpreterCustomModule)
  protected
  {$IFDEF with_mormot}
    FPDF: TPdfDocument;
  {$ENDIF}
    FPage: integer;
    FY: single;
    FLineHeight: single;
    FZoom: single;
    FPageFooter: boolean;
    FNow: string;
    FColCount, FColNum: integer;  // FColNum is 0 relative
    FColYPos: single;
    FColMargins: array[0..9] of TBafPdfMargins;
    FLineGroup: TStringList;
    FPicList: TStringList;
    procedure PdfStart(AIntern: boolean = false; ALandscape: boolean = false);
    procedure PdfStop(AFileName: string = '');
    procedure PdfAddPage;
    procedure PdfAddCol;
    procedure PdfLine(ALineFeed: boolean);
    procedure PdfMultiline;
    procedure PdfMultilineBB;
    procedure PdfFont;
    procedure PdfSetY;
    procedure PdfLoadPic;
    procedure PdfInsertPic;
    procedure PdfDrawLine;
    procedure PdfDrawRectangle;
    procedure PdfExecSub;
    procedure PdfCheckNewLine;
    procedure PdfColfDef;
    procedure PdfColfClear;
    {$IFDEF with_zint}
    procedure PdfCreateBarcode;
    {$ENDIF}
    procedure PdfBus;
  protected
    FGrid: TBafSimpleGrid;
    FLandscape: boolean;
    FColumns: TObjectList;
    FPageWidth, FPageWidthUse, FPageHeight, FPageHeightUse, FPageScale: single;
    FPageMarginLeft, FPageMarginTop, FPageMarginRight, FPageMarginBottom: single;
    FPagesPerRow: integer;
    function OpenFileDialog(var AFileName: string): boolean;
    procedure ExportSimpleGrid(AGrid: TBafSimpleGrid);
    procedure MakeColumns;
    procedure PrintHeader(APage: integer);
    procedure PrintRows(APage: integer; AStart: integer; var ALast: integer);
    procedure InitPage;
    procedure PrintCell(ACell: TBafSgCell; ACol: integer;
        APdfGridColumn: TBafPdfGridColumn);
  protected
    function CalcTextLeft(AText: string; AWidth: single; AAlignment: TBafAlignment): single;
    procedure CheckNewLine(AMarginBottom: single);
  public
    constructor Create; override;
    destructor Destroy; override;
    function InterpretLine(AExecInter: TBafCustomInterpreter): boolean; override;
    function ReplaceFunction(ACommand: string; AParams: TStrings; var AResult: string): boolean; override;
    procedure ExportSegmentPdf(ASegment: TObject); override;
  end;


implementation

{ TBafPdfModule }

uses uOsStuff;

function TBafPdfModule.CalcTextLeft(AText: string; AWidth: single; AAlignment: TBafAlignment): single;
// Calcs start position of text regarding to alignment
var
  p: integer;
  LTextWidth: single;
begin
  {$IFDEF with_mormot}
  result := 0;
  case AAlignment of
    taLeftJustify, taExplicitLeft: result := 0;
    taRightJustify: begin
      LTextWidth := FPdf.Canvas.TextWidth(AnsiString(AText));
      result := AWidth - 2 - LTextWidth;
    end;
    taCenter: begin
      LTextWidth := FPdf.Canvas.TextWidth(AText);
      result := (AWidth - LTextWidth) / 2;
    end;
    taDecimal2: begin
      p := Pos(',', AText);
      if p > 0 then
        AText := copy(AText, 1, p - 1);
      AText := AText + ',00';
      LTextWidth := FPdf.Canvas.TextWidth(AText);
      result := AWidth - 2 - LTextWidth;
    end;
    taDecimal4: begin
      p := Pos(',', AText);
      if p > 0 then
        AText := copy(AText, 1, p - 1);
      AText := AText + ',0000';
      LTextWidth := FPdf.Canvas.TextWidth(AText);
      result := AWidth - 2 - LTextWidth;
    end;
  end; // case
  result := result + FColMargins[FColNum].Left;
  {$ENDIF}
end;

procedure TBafPdfModule.CheckNewLine(AMarginBottom: single);
begin
  FY := FY - FLineHeight;
  if FY < AMarginBottom then
    PdfAddCol;
end;

constructor TBafPdfModule.Create;
begin
  inherited;
  FLineGroup := TStringList.Create;
end;

destructor TBafPdfModule.Destroy;
begin
  FreeAndNil(FLineGroup);
  inherited;
end;

procedure TBafPdfModule.ExportSegmentPdf(ASegment: TObject);
var
  LSegment: TBafPageSegment;
  LFileName: string;
begin
  if OpenFileDialog(LFileName) then begin
    LSegment := (ASegment as TBafPageSegment);
    FLandscape := FindParamBooleanReplaced(LSegment.LineP, 'pal', false);
    PdfStart(true, FLandscape);
    if LSegment.PdfCommand = '' then begin
      case LSegment.SegmentType of
        stValueList, stGrid, stXGrid: ExportSimpleGrid(LSegment.Grid);

      end;
    end // if LSegment.PdfCommand = ''
    else
      TBafInterpreterLevel.ExecInNewLevel(LSegment.PdfCommand, FExecInter, FInter);
    PdfStop(LFileName);
  end; // if OpenFileDialog
end;

procedure TBafPdfModule.ExportSimpleGrid(AGrid: TBafSimpleGrid);
var
  LRow, LLast, LPage: integer;
begin
  FPage := 0;
  FGrid := AGrid;
  FColumns := TObjectList.Create(true);
  try
    InitPage;
    MakeColumns;
    LRow := 0;
    while LRow < AGrid.RowCount(rtData) do begin
      for LPage := 1 to FPagesPerRow do begin
        PrintHeader(LPage);
        PrintRows(LPage, LRow, LLast);
      end;
      LRow := LLast + 1;
    end;
  finally
    FreeAndNil(FColumns);
  end;
end;

function TBafPdfModule.ReplaceFunction(ACommand: string; AParams: TStrings;
    var AResult: string): boolean;
begin
  inherited;
  result := true;
  if ACommand = '$PDF_PAGE' then AResult := IntToStr(FPage)
  else if ACommand = '$PDF_YMM' then AResult := FormatFloat('0.00',
      FY / System.Math.Max(FZoom, 0.001))

  else result := false;
end;

procedure TBafPdfModule.PdfAddCol;
begin
  inc(FColNum);
  if FColNum >= FColCount then
    PdfAddPage;
  FY := FColYPos;
end;

procedure TBafPdfModule.PdfAddPage;
begin
  {$IFDEF with_mormot}
  FPDF.AddPage;
  inc(FPage);
  FColNum := 0;
  if FPDF.DefaultPageLandscape then
    FZoom := FPDF.Canvas.Page.PageHeight / 210
  else
    FZoom := FPDF.Canvas.Page.PageHeight / 297;
  if FPageFooter then begin
    FPDF.Canvas.SetFont('Helvetica', 8, []);
    FPDF.Canvas.SetRGBStrokeColor(TColorRec.DarkGray);
    FPDF.Canvas.MoveTo(18 * FZoom, 10 * FZoom);
    FPDF.Canvas.LineTo(100 * FZoom, 10 * FZoom);
    FPDF.Canvas.Stroke;
    FPDF.Canvas.TextOut(18 * FZoom, 5 * FZoom, FNow + Format('  -  Seite %d', [FPage]));
  end;
  FPDF.Canvas.SetFont('Helvetica', 10, []);
  FLineHeight := 12;
  FY := FPDF.Canvas.Page.PageHeight - 15 * FZoom;
  FColYPos := FY;
  {$ENDIF}
end;

function PreisListenSort(List: TStringList; Index1, Index2: Integer): Integer;
var
  LPreis1, LPreis2: currency;
begin
  LPreis1 := StrToCurrDef(List[Index1], 0) * 100;
  LPreis2 := StrToCurrDef(List[Index2], 0) * 100;
  result := round(LPreis2 - LPreis1);
end;

procedure TBafPdfModule.PdfBus;
const
  SITZ = 100;
  ZWI = 20;


type
  TBusPlatz = record
    platz: string[3];
    status: Char;
    ausrichtung: Char;
    preis: currency;
  end;

var
  {$IFDEF with_mormot}
  LBild: TPdfImage;
  {$ENDIF}
  LBitmap: TBitmap;
  LCan: TCanvas;
  LName, LFileName: string;
  LBus: array[0..17, 0..4] of TBusPlatz;
  LRowCount: integer;
  LBafPdfPicture: TBafPdfPicture;
  LPlatz: TBusPlatz;
  LPreisListe: TStringList;
  LFontSize: integer;
  LFmtString: string;

  procedure lokLinie(x1, y1, x2, y2: integer);
  begin
    LCan.DrawLine(PointF(x1, y1), PointF(x2, y2), 1);
  end; // procedure lokLinie

  procedure lokText(x1, y1, x2, y2, ASize: integer; ABold: boolean; AText: string);
  var
    w, h, l, t: integer;
    LColor: TAlphaColor;
  begin
    LCan.Font.Size := ASize;
    if ABold then
      LCan.Font.Style := [TFontStyle.fsBold]
    else
      LCan.Font.Style := [];
    LColor := LCan.Fill.Color;
    LCan.Fill.Color := TAlphaColorRec.Black;
    try
      LCan.FillText(RectF(x1, y1, x2, y2), AText, false, 1, [], TTextAlign.Center);
    finally
      LCan.Fill.Color := LColor;
    end;
  end; // procedure lokText

  procedure lokBusSitz(AReihe, ASpalte, ASitzX, ASitzY: integer;
      AZeile2: string; ASize: integer; ABold: boolean);
  begin
    case LPlatz.ausrichtung of
      'V': begin
        LCan.FillRect(RectF(ASitzX - 15, ASitzY, ASitzX - SITZ, ASitzY + SITZ), 0, 0, [], 1);
        LCan.DrawRect(RectF(ASitzX - 15, ASitzY, ASitzX - SITZ, ASitzY + SITZ), 0, 0, [], 1);
        lokLinie(ASitzX - SITZ + 15, ASitzY, ASitzX - SITZ + 15, ASitzY + SITZ - 1);
        lokText(ASitzX - SITZ + 15, ASitzY + 10, ASitzX - 15, ASitzY + SITZ div 2, LFontSize,
            ABold, LPlatz.platz);
        lokText(ASitzX - SITZ + 15, ASitzY + SITZ div 2, ASitzX - 15, ASitzY + SITZ,
            ASize, ABold, AZeile2);
      end;
      'H': begin
        LCan.FillRect(RectF(ASitzX, ASitzY, ASitzX - SITZ + 15, ASitzY + SITZ), 0, 0, [], 1);
        LCan.DrawRect(RectF(ASitzX, ASitzY, ASitzX - SITZ + 15, ASitzY + SITZ), 0, 0, [], 1);
        lokLinie(ASitzX - 15, ASitzY, ASitzX - 15, ASitzY + SITZ - 1);
        lokText(ASitzX - SITZ + 15, ASitzY + 10, ASitzX - 15, ASitzY + SITZ div 2, LFontSize,
            ABold, LPlatz.platz);
        lokText(ASitzX - SITZ + 15, ASitzY + SITZ div 2, ASitzX - 15, ASitzY + SITZ,
            ASize, ABold, AZeile2);
      end;
      'L': begin
        LCan.FillRect(RectF(ASitzX, ASitzY + 15, ASitzX - SITZ, ASitzY + SITZ), 0, 0, [], 1);
        LCan.DrawRect(RectF(ASitzX, ASitzY + 15, ASitzX - SITZ, ASitzY + SITZ), 0, 0, [], 1);
        lokLinie(ASitzX, ASitzY + SITZ - 15, ASitzX - SITZ - 1, ASitzY + SITZ - 15);
        lokText(ASitzX - SITZ, ASitzY + 25, ASitzX, ASitzY + 15 + (SITZ - 15) div 2, LFontSize,
            ABold, LPlatz.platz);
        lokText(ASitzX - SITZ, ASitzY + 15 + (SITZ - 15) div 2, ASitzX, ASitzY + SITZ - 15,
            ASize, ABold, AZeile2);
      end;
      'R': begin
        LCan.FillRect(RectF(ASitzX, ASitzY, ASitzX - SITZ, ASitzY + SITZ - 15), 0, 0, [], 1);
        LCan.DrawRect(RectF(ASitzX, ASitzY, ASitzX - SITZ, ASitzY + SITZ - 15), 0, 0, [], 1);
        lokLinie(ASitzX, ASitzY + 15, ASitzX - SITZ - 1, ASitzY + 15);
        lokText(ASitzX - SITZ, ASitzY + 20, ASitzX, ASitzY + 15 + (SITZ - 15) div 2, LFontSize,
            ABold, LPlatz.platz);
        lokText(ASitzX - SITZ, ASitzY + 15 + (SITZ - 25) div 2, ASitzX, ASitzY + SITZ - 15,
            ASize, ABold, AZeile2);
      end;
    end;
  end; // procedure lokBusSitz

  procedure lokDouble(ASpalte, ASitzX, ASitzY, ASize: integer; AText: string);
  var
    s: string;
  begin
    if ASpalte in [0, 3] then begin
      LCan.DrawRect(RectF(ASitzX, ASitzY, ASitzX - SITZ, ASitzY + SITZ + ZWI + SITZ), 0, 0, [], 1);
      lokText(ASitzX - SITZ, ASitzY, ASitzX, ASitzY + SITZ + ZWI + SITZ, ASize, false, AText);
    end;
  end; // procedure lokDouble

  procedure lokFahrer(ASpalte, ASitzX, ASitzY, ASize: integer);
  var
    LHalb: integer;
  begin
    if ASpalte in [0, 3] then begin
      LHalb := (SITZ + ZWI) div 2;
      LCan.DrawRect(RectF(ASitzX, ASitzY + LHalb, ASitzX - SITZ, ASitzY + SITZ + LHalb), 0, 0, [], 1);
      lokLinie(ASitzX - SITZ + 15, ASitzY + LHalb, ASitzX - SITZ + 15,
          ASitzY + SITZ + LHalb - 1);
      lokText(ASitzX, ASitzY + LHalb, ASitzX - SITZ + 15, ASitzY + SITZ + LHalb,
          ASize, false, 'Fahrer');
    end;
  end; // procedure lokFahrer

  procedure lokEinstieg(ASpalte, ASitzX, ASitzY, ASize: integer);
  begin
    if ASpalte = 0 then begin
      LCan.Fill.Color := TAlphaColorRec.Silver;
      LCan.Stroke.Color := TAlphaColorRec.Silver;
      LCan.DrawRect(RectF(ASitzX, 3, ASitzX - SITZ, 10), 0, 0, [], 1);
      LCan.Fill.Color := TAlphaColorRec.White;
      LCan.Stroke.Color := TAlphaColorRec.Black;
      lokText(ASitzX - SITZ, 15, ASitzX, ASitzY + 35, ASize, true, 'Einstieg');
    end;
    if ASpalte = 4 then begin
      LCan.Fill.Color := TAlphaColorRec.Silver;
      LCan.Stroke.Color := TAlphaColorRec.Silver;
      LCan.DrawRect(RectF(ASitzX, LBitmap.Height - 3, ASitzX - SITZ, LBitmap.Height - 10), 0, 0, [], 1);
      LCan.Fill.Color := TAlphaColorRec.White;
      LCan.Stroke.Color := TAlphaColorRec.Black;
      lokText(ASitzX - SITZ, LBitmap.Height - 35, ASitzX, LBitmap.Height - 15,
          ASize, true, 'Einstieg');
    end;
  end; // procedure lokEinstieg

  procedure lokUmriss;
  begin
    LCan.DrawArc(PointF(15, 15), PointF(10, 10), 180, 90, 1);
    lokLinie(15, 5, LBitmap.Width - 65, 5);
    LCan.DrawArc(PointF(LBitmap.Width - 65, 65), PointF(60, 60), 270, 90, 1);
    lokLinie(LBitmap.Width - 5, 65, LBitmap.Width - 5, LBitmap.Height - 65);
    LCan.DrawArc(PointF(LBitmap.Width - 65, LBitmap.Height - 65), PointF(60, 60), 0, 90, 1);
    lokLinie(LBitmap.Width - 65, LBitmap.Height - 5, 15, LBitmap.Height - 5);
    LCan.DrawArc(PointF(15, LBitmap.Height - 15), PointF(10, 10), 90, 90, 1);
    lokLinie(5, LBitmap.Height - 15, 5, 15);
  end; // procedure lokUmriss

  procedure lokBusSitze;
  var
    LReihe, LSpalte: integer;
    LSitzX, LSitzY, ix: integer;
  begin
    LBitmap.Width := LRowCount * 120 + 100;
    LBitmap.Height := 618;
    LCan := LBitmap.Canvas;
    if LCan.BeginScene then
    try
      LCan.Fill.Color := TAlphaColorRec.White;
      LCan.FillRect(RectF(0, 0, LBitmap.Width, LBitmap.Height), 0, 0, [], 1);
      LCan.Stroke.Thickness := 3;
      lokUmriss;
      for LReihe := 0 to LRowCount - 1 do begin
        LSitzX := LBitmap.Width - LReihe * (SITZ + ZWI) - SITZ;
        for LSpalte := 0 to 4 do begin
          LSitzY := LSpalte * (SITZ + ZWI) + ZWI;
          LPlatz := LBus[LReihe, LSpalte];
          ix := LPreisListe.IndexOf(FormatFloat('0.00', LPlatz.preis));
          if ix = -1 then
            ix := 0;
          LCan.Fill.Color := TAlphaColor(LPreisListe.Objects[ix]);
          case LPlatz.status of
            'G': lokBusSitz(LReihe, LSpalte, LSitzX, LSitzY,             // gesperrt
                '-', LFontSize, false);
            'R': lokBusSitz(LReihe, LSpalte, LSitzX, LSitzY,
                FormatFloat(LFmtString, LPlatz.preis), LFontSize, true);
            'L': lokBusSitz(LReihe, LSpalte, LSitzX, LSitzY, 'R-Leiter', 10, true);
            'Z': lokBusSitz(LReihe, LSpalte, LSitzX, LSitzY, '2. Fahrer', 10, true);
            'T': lokDouble(LSpalte, LSitzX, LSitzY, 15, 'Toilette');
            'K': lokDouble(LSpalte, LSitzX, LSitzY, 15, 'Küche');
            'F': lokFahrer(LSpalte, LSitzX, LSitzY, 15);
            'E': lokEinstieg(LSpalte, LSitzX, LSitzY, 15);
          end;

        end;
      end;
    finally
      LCan.EndScene;
    end;
  end; // procedure lokBusBitmap

  procedure lokPreisFarben;
  var
    i: integer;
    LColor : TAlphaColor;
  begin
    LPreisListe.CustomSort(PreisListenSort);
    for i := 0 to LPreisListe.Count - 1 do begin
      if StrToCurrDef(LPreisListe[i], 0) = 0 then
        LColor := TAlphaColorRec.Alpha
            or FindParamIntegerReplaced('cl_0', $FFFFFF)
      else
        LColor := TAlphaColorRec.Alpha
            or FindParamIntegerReplaced('cl_' + IntToStr(i + 1), $FFFF00);
      LPreisListe.Objects[i] := TObject(LColor);
    end;
  end; // procedure lokPreisFarben

  procedure lokBusDaten;
  var
    LSql, LPreis, LBafConName: string;
    LData: TDataSet;
    LReihe, LSpalteNum: integer;
    LSpalte: Char;
  begin
    LSql := FInter.GetSqlAndClear(1);
    LBafConName := AnsiLowerCase(FindParamStringReplaced('db', DC_DEFAULT));
    SqlAndParams(LBafConName, FInter.Name, LSql);
    LData := dataMain.QueryOpen(LBafConName, FInter.Name);
    LRowCount := 0;
    while not LData.Eof do begin
      FInter.DebugDbRow(LData);
      LReihe := LData.FieldByName('reihe').AsInteger;
      LSpalte := (LData.FieldByName('spalte').AsString + ' ')[1];
      case LSpalte of
        'A': LSpalteNum := 0;
        'B': LSpalteNum := 1;
        'M': LSpalteNum := 2;
        'C': LSpalteNum := 3;
        'D': LSpalteNum := 4;
      end;
      if (LReihe in [0..17]) and (LSpalteNum in [0..4]) then begin
        LBus[LReihe, LSpalteNum].platz := IntToStr(LReihe) + LSpalte;
        LBus[LReihe, LSpalteNum].status
            := (LData.FieldByName('status').AsString + ' ')[1];
        LBus[LReihe, LSpalteNum].ausrichtung
            := (LData.FieldByName('ausrichtung').AsString + ' ')[1];
        LBus[LReihe, LSpalteNum].preis := LData.FieldByName('preis').AsCurrency;
        LPreis := FormatFloat('0.00', LBus[LReihe, LSpalteNum].preis);
        if LPreisListe.IndexOf(LPreis) = -1 then
          LPreisListe.Add(LPreis);
        LRowCount := System.Math.Max(LRowCount, LReihe + 1);
        LData.Next;
      end;
    end; // while
  end; // procedure lokBusDaten;

begin
  LName := FindParamStringReplaced('n', '');
  LPreisListe := TStringList.Create;
  LBitmap := TBitmap.Create;
  try
    LFontSize := FindParamIntegerReplaced('fs', 18);
    LFmtString := FindParamStringReplaced('fmt', '0.00');
    LPreisListe.Add('0,00');
    lokBusDaten;
    lokPreisFarben;
    lokBusSitze;
  {$IFDEF with_mormot}
    LBild := TPdfImage.Create(FPDF, LBitmap, false);
    FPDF.RegisterXObject(LBild, LName);
  {$ENDIF}
    LBafPdfPicture := TBafPdfPicture.Create;
    LBafPdfPicture.Width := LBitmap.Width;
    LBafPdfPicture.Height := LBitmap.Height;
    FPicList.AddObject(LName, LBafPdfPicture);
  finally
    LBitmap.Free;
    LPreisListe.Free;
  end;
// procedure TBafPdfModule.PdfBus
end;

procedure TBafPdfModule.PdfCheckNewLine;
// Neue Zeile und ggf. neue Seite
var
  LMarginBottom: single;
begin
  LMarginBottom := FindParamSingleReplaced('mb', 20) * FZoom;
  CheckNewLine(LMarginBottom);
end;

procedure TBafPdfModule.PdfColfClear;
begin
  FColNum := 0;
  FColMargins[0].Left := 0;
  {$IFDEF with_mormot}
  FColMargins[0].Right := FPDF.Canvas.Page.PageWidth;
  {$ENDIF}
end;

procedure TBafPdfModule.PdfColfDef;
var
  i: integer;
  LWhiteSpace, LLeft, LRight, LColWidth, LPos: single;
begin
  FColCount := FindParamIntegerReplaced('cc', 1);
  if FColCount = 1 then
    PdfColfClear
  else begin
    LLeft := FindParamSingleReplaced('l', 18) * FZoom;
    LRight := FindParamSingleReplaced('r', 15) * FZoom;
    LWhiteSpace := FindParamSingleReplaced('ws', 7) * FZoom;
  {$IFDEF with_mormot}
    LColWidth := FPDF.Canvas.Page.PageWidth - LLeft - LRight - ((FColCount - 1) * LWhiteSpace);
  {$ENDIF}
    LColWidth := LColWidth / FColCount;
    LPos := LLeft;
    for i := 0 to FColCount - 1 do begin
      FColMargins[i].Left := LPos;
      LPos := LPos + LColWidth;
      FColMargins[i].Right := LPos;
      LPos := LPos + LWhiteSpace;
    end;
    FColYPos := FY;
  end;
end;

procedure TBafPdfModule.PdfCreateBarcode;
var
  LPdfImage: TPdfImage;
  LBitmap: TBitmap;
  LName, LTyp: string;
  LSymbol: TZintSymbol;
  LSize: integer;
  LTarget: TZintBMPRenderTarget;
  LRect: TRectF;

  procedure lokCreatePdfPic;
  var
    i: integer;
    LRotation: single;
    LBafPdfPicture: TBafPdfPicture;
  begin
    LRotation := FindParamSingleReplaced('rot', 0);
    LBitmap.Rotate(LRotation);
    LName := FindParamStringReplaced('n', '');
    LPdfImage := TPdfImage.Create(FPDF, LBitmap, false);
    FPDF.RegisterXObject(LPdfImage, LName);
    LBafPdfPicture := TBafPdfPicture.Create;
    LBafPdfPicture.Width := LBitmap.Width;
    LBafPdfPicture.Height := LBitmap.Height;
    FPicList.AddObject(LName, LBafPdfPicture);
  end; // procedure lokCreatePdfPic

  procedure lokGetSymbol;
  begin
    LTyp := AnsiLowerCase(FindParamStringReplaced('y', 'code_128'));
    if LTyp = 'code_128' then
      LSymbol.SymbolType := zsCODE128
    else if LTyp = 'qr' then
      LSymbol.SymbolType := zsQRCODE
    else if LTyp = 'code_11' then
      LSymbol.SymbolType := zsCODE11
    else if LTyp = 'c25_matrix' then
      LSymbol.SymbolType := zsC25MATRIX
    else if LTyp = 'c25_inter' then
      LSymbol.SymbolType := zsC25INTER
    else if LTyp = 'c25_iata' then
      LSymbol.SymbolType := zsC25IATA
    else if LTyp = 'c25_logic' then
      LSymbol.SymbolType := zsC25LOGIC
    else if LTyp = 'c25_ind' then
      LSymbol.SymbolType := zsC25IND
    else if LTyp = 'code_39' then
      LSymbol.SymbolType := zsCODE39
    else if LTyp = 'code_39ex' then
      LSymbol.SymbolType := zsEXCODE39
    else if LTyp = 'eanx' then
      LSymbol.SymbolType := zsEANX
    else if LTyp = 'ean128' then
      LSymbol.SymbolType := zsEAN128
    else if LTyp = 'code_bar' then
      LSymbol.SymbolType := zsCODABAR
    else if LTyp = 'dp_leit' then
      LSymbol.SymbolType := zsDPLEIT
    else if LTyp = 'dp_ident' then
      LSymbol.SymbolType := zsDPIDENT
    else if LTyp = 'code_16k' then
      LSymbol.SymbolType := zsCODE16K
    else if LTyp = 'code_49' then
      LSymbol.SymbolType := zsCODE49
    else if LTyp = 'code_93' then
      LSymbol.SymbolType := zsCODE93
    else if LTyp = 'code_flat' then
      LSymbol.SymbolType := zsFLAT

      ;

    LSymbol.input_mode := UNICODE_MODE;
    LSymbol.primary := StrToArrayOfChar(FindParamStringReplaced('prim', ''));
    LSymbol.Encode(FindParamStringReplaced('z', ''), true);
  end; // procedure lokGetSymbol

begin
  LSymbol := TZintSymbol.Create(nil);
  try
    lokGetSymbol;

    LBitmap := TBitmap.Create;
    LSize := FindParamIntegerReplaced(FExecInter.LineP, 'w', 800);
    LBitmap.SetSize(LSize, LSize);
    LBitmap.Clear(TAlphaColorRec.White);
    LTarget := TZintBMPRenderTarget.Create(nil);
    LTarget.Bitmap := LBitmap;
    LTarget.HexagonScale := 1;
    LTarget.RenderAdjustMode := ramScale;
    LTarget.ShowText := false;
    try
      LSymbol.Render(LTarget);
      lokCreatePdfPic;
    finally
      LTarget.Free;
      LBitmap.Free;
    end;
  finally
    LSymbol.Free;
  end;
// procedure TBafPdfModule.PdfCreateBarcode
end;

procedure TBafPdfModule.PdfDrawLine;
var
  LX1, LX2, LY1, LY2, LWidth: single;
begin
  FY := FY - FindParamSingleReplaced('d', 0) * FZoom;
  LX1 := FindParamSingleReplaced('x1', 18) * FZoom;
  LX2 := FColMargins[FColNum].Right - FindParamSingleReplaced('x2', 15) * FZoom;
  LY1 := FindParamSingleReplaced('y1', FY / FZoom) * FZoom;
  LY2 := FindParamSingleReplaced('y2', FY / FZoom) * FZoom;
  LWidth := FindParamSingleReplaced('w', 1) * FZoom;

  FPDF.Canvas.SetLineWidth(LWidth);
  FPDF.Canvas.SetRGBStrokeColor(FindParamColor('cl', TColorRec.Black));
  FPDF.Canvas.MoveTo(LX1, LY1);
  FPDF.Canvas.LineTo(LX2, LY2);
  FPDF.Canvas.Stroke;
end;

procedure TBafPdfModule.PdfDrawRectangle;
var
  LX, LY, LWidth, LHeight: single;
begin
  LX := FindParamSingleReplaced('x', 0) * FZoom;
  LY := FindParamSingleReplaced('y', 0) * FZoom;
  LWidth := FindParamSingleReplaced('w', 0) * FZoom;
  LHeight := FindParamSingleReplaced('h', 0) * FZoom;

  FPDF.Canvas.SetLineWidth(LWidth);
  FPDF.Canvas.SetRGBStrokeColor(FindParamColor('cl', TColorRec.Black));
  FPDF.Canvas.SetRGBFillColor(FindParamColor('cl', TColorRec.Black));
  FPDF.Canvas.Rectangle(LX, LY, LWidth, LHeight);
end;

procedure TBafPdfModule.PdfExecSub;
// necessary?
var
  LCommand: string;
begin
  LCommand := FindParamString('cmd', '');
  TBafInterpreterLevel.ExecInNewLevel(LCommand, FExecInter, FInter);
end;

procedure TBafPdfModule.PdfFont;
var
  LStyles: TPdfFontStyles;
  LSize: single;
begin
  LSize := FindParamSingleReplaced('s', 10);
  FLineHeight := LSize * 1.2;
  LStyles := [];
  if FindParamBooleanReplaced('b', false) then
    Include(LStyles, pfsBold);
  if FindParamBooleanReplaced('i', false) then
    Include(LStyles, pfsItalic);
  FPDF.Canvas.SetFont(FindParamString('n', 'Helvetica'), LSize, LStyles);
  FPDF.Canvas.SetRGBFillColor(FindParamColor('cl', TColorRec.Black));
end;

procedure TBafPdfModule.PdfInsertPic;
var
  LName: string;
  LX, LY, LWidth, LHeight, LMarginBottom: single;
  LPic: TBafPdfPicture;
  ix: integer;
begin
  FY := FY - FindParamSingleReplaced('d', 0) * FZoom;
  LMarginBottom := FindParamSingleReplaced('mb', 20) * FZoom;
  LName := FindParamStringReplaced('n', '');
  ix := FPicList.IndexOf(LName);
  LWidth := FindParamSingleReplaced('w', 0) * FZoom;
  LHeight := FindParamSingleReplaced('h', 0) * FZoom;
  LX := FindParamSingleReplaced('x', 0) * FZoom;
  LY := FindParamSingleReplaced('y', -1) * FZoom;
  if (LHeight = 0) and (LWidth = 0) then
    LWidth := 100 * FZoom;
  if (LHeight = 0) and (ix >= 0) then begin
    LPic := FPicList.Objects[ix] as TBafPdfPicture;
    LHeight := LWidth * LPic.Height / System.Math.Max(1, LPic.Width);
  end;
  if (LWidth = 0) and (ix >= 0) then begin
    LPic := FPicList.Objects[ix] as TBafPdfPicture;
    LWidth := LHeight * LPic.Width / System.Math.Max(1, LPic.Height);
  end;
  if LY < 0 then begin
    FY := FY - LHeight;
    if FY < LMarginBottom then begin
      PdfAddPage;
      FY := FY - LHeight;
    end;
    LY := FY;
  end;
  FPDF.Canvas.DrawXObject(LX, LY, LWidth, LHeight, LName);
end;

procedure TBafPdfModule.PdfLine(ALineFeed: boolean);
var
  LText, LGroup, s: string;
  LWidth, LLeft, LRight, LEinr: single;
  LAlign: TBafAlignment;
  LFirst: boolean;

  function lokGroupChange: boolean;
  var
    LStyles: TPdfFontStyles;
    LSize: single;
  begin
    LFirst := FLineGroup.Count = 0;
    s := FLineGroup.Values[LGroup];
    result := s <> LText;
    FLineGroup.Values[LGroup] := LText;
    if result and not LFirst then begin
      FY := FY - FindParamSingleReplaced('dy', 0) * FZoom;
      CheckNewLine(FindParamSingleReplaced('mb', 20) * FZoom);
      LSize := FindParamSingleReplaced('s', 10);
      FLineHeight := LSize * 1.2;
      LStyles := [];
      if FindParamBooleanReplaced('b', false) then
        Include(LStyles, pfsBold);
      if FindParamBooleanReplaced('i', false) then
        Include(LStyles, pfsItalic);
      FPDF.Canvas.SetFont(FindParamString('n', 'Helvetica'), LSize, LStyles);
      FPDF.Canvas.SetRGBFillColor(FindParamColor('cl', TColorRec.Black));
    end;
  end; // function lokGroupChange

begin
  LText := FindParamStringReplaced('c', '');
  LGroup := FindParamStringReplaced('grp', '');
  if (LGroup = '') or lokGroupChange then begin
    LAlign := FInter.FindParamAlignment(FExecInter.LineP, 'a', taLeftJustify);
    LLeft := FindParamSingleReplaced('l', 18) * FZoom;
    LRight := FindParamSingleReplaced('r', 15) * FZoom;
    LEinr := CalcTextLeft(LText, FColMargins[FColNum].Right - FColMargins[FColNum].Left
        - LRight - LLeft, LAlign);

    FPDF.Canvas.TextOut(LLeft + LEinr, FY, LText);
    if ALineFeed then
      CheckNewLine(FindParamSingleReplaced('mb', 15) * FZoom);
  end;
end;

procedure TBafPdfModule.PdfLoadPic;
const
  OBJECTNAME = 'PIC-';
var
  LBild: TPdfImage;
  LBitmap: TBitmap;
  LName, LFileName: string;
  LBafPdfPicture: TBafPdfPicture;
begin
  LName := FindParamStringReplaced('n', '');
  LBitmap := TBitmap.Create;
  try
    LFileName := FindParamStringReplaced('fn', '');
    if FileExists(LFileName) then begin
      LBitmap.LoadFromFile(LFileName);
      LBild := TPdfImage.Create(FPDF, LBitmap, false);
      FPDF.RegisterXObject(LBild, LName);
      LBafPdfPicture := TBafPdfPicture.Create;
      LBafPdfPicture.Width := LBitmap.Width;
      LBafPdfPicture.Height := LBitmap.Height;
      FPicList.AddObject(LName, LBafPdfPicture);
    end;
  finally
    LBitmap.Free;
  end;
end;

procedure TBafPdfModule.PdfMultiline;
var
  sl: TStringList;
  i: integer;
  LAlign: string;
  LWidth, LLeft, LRight, LMaxTextWidth, LMarginBottom, LMarginBottomParagraph: single;

  procedure lokLineBreak;
  var
    sl2: TStringList;
    i: integer;
    s, t: string;
    nichtgefunden: boolean;

    procedure lokSearchSeparator(a: TSysCharSet);
    var
      j: integer;
    begin
      for j := Length(s) downto 1 do
      begin
        if CharInSet(s[j], a) then
        begin
          t := copy(s, 1, j);
          if FPDF.Canvas.TextWidth(t) < LMaxTextWidth then
          begin
            sl2.Add(t);
            Delete(s, 1, j);
            exit;
          end;
        end; {if s[j] = ' '}
      end; {for j := Length(p) downto 1 do}
      nichtgefunden := true;
    end; {procedure lokSearchSeparator}

  begin
    sl2 := TStringList.Create;
    try
      for i := 0 to sl.Count - 1 do
      begin
        s := sl[i];
        while FPDF.Canvas.TextWidth(s) > LMaxTextWidth do
        begin
          nichtgefunden := false;
          lokSearchSeparator([' ']);
          if nichtgefunden
            then lokSearchSeparator(['.', ',', ';', ':', '_', '-']);
          if nichtgefunden
            then lokSearchSeparator(['A'..'Z', 'a'..'z', '0'..'9']);
        end;
        sl2.Add(s);
      end; {for i := 0 to sl.Count - 1 do}
      sl.Assign(sl2);
    finally
      sl2.Free;
    end;
  end; // lokLineBreak

  procedure lokLine(AText: string);
  begin
    if (LAlign = 'c') then begin
      LWidth := FPDF.Canvas.TextWidth(AText);
      LLeft := LLeft + ((FColMargins[FColNum].Right - LLeft - LRight - LWidth) / 2);
    end;
    if (LAlign = 'r') then begin
      LWidth := FPDF.Canvas.TextWidth(AText);
      LLeft := FColMargins[FColNum].Right - LRight - LWidth;
    end;

    FPDF.Canvas.TextOut(LLeft, FY, AText);
    FY := FY - FLineHeight;
    if (Fy < LMarginBottom)
        or ((Fy < LMarginBottomParagraph) and (Trim(AText) = '')) then
      PdfAddCol;
  end; // procedure lokLine

begin
  LAlign := FindParamStringLower('a', '');
  LLeft := FindParamSingleReplaced('l', 18) * FZoom;
  LRight := FindParamSingleReplaced('r', 15) * FZoom;
  LMarginBottom := FindParamSingleReplaced('mb', 20) * FZoom;
  LMarginBottomParagraph := FindParamSingleReplaced('mbp', 20) * FZoom;
  LMaxTextWidth := (FColMargins[FColNum].Right - LRight - LLeft);
  sl := TStringList.Create;
  try
    sl.Text := FindParamStringReplaced('c', '');
    lokLineBreak;
    for i := 0 to sl.Count - 1 do
      lokLine(sl[i]);
  finally
    sl.Free;
  end;
// procedure TBafPdfModule.PdfMultiline
end;

procedure TBafPdfModule.PdfMultilineBB;
// You can use Pseudo-BB-Code: [b], [i], [bi], []
var
  LText, LFontName, LFontCommand: string;
  LAlign: TBafAlignment;
  LLeft, LLeft2, LRight, LSize, LWidth, LPlace, LMarginBottom,
      LMarginBottomParagraph: single;
  sl: TStringList;

  procedure lokZerlegen;
  var
    p, p1: integer;
    LItem: string;

    procedure lokSuchen(AItem: string);
    begin
      p1 := Pos(AItem, LText);
      if (p1 > 0) and (p1 < p) then begin
        p := p1;
        LItem := AItem;
      end;
    end;

  begin
    while Length(LText) > 0 do begin
      p := MaxInt;
      lokSuchen(#13);
      lokSuchen('[]');
      lokSuchen('[b]');
      lokSuchen('[i]');
      lokSuchen('[bi]');
      if p = MaxInt then begin
        sl.Add(LText);
        LText := '';
      end
      else begin
        sl.Add(copy(LText, 1, p - 1));
        sl.Add(LItem);
        Delete(LText, 1, p + Length(LItem) - 1);
      end;
    end;
  end; // procedure lokZerlegen

  function lokCheckFont(ACommand: string): boolean;
  begin
    result := true;
    if (ACommand = #10) then
    else if (ACommand = #13) then begin
      CheckNewLine(LMarginBottom);
      lokCheckFont(LFontCommand);
      LLeft2 := LLeft;
    end
    else if (ACommand = '[]') then
      FPDF.Canvas.SetFont(LFontName, LSize, [])
    else if (ACommand = '[b]') then
      FPDF.Canvas.SetFont(LFontName, LSize, [TPdfFontStyle.pfsBold])
    else if (ACommand = '[i]') then
      FPDF.Canvas.SetFont(LFontName, LSize, [TPdfFontStyle.pfsItalic])
    else if (ACommand = '[bi]') then
      FPDF.Canvas.SetFont(LFontName, LSize,
          [TPdfFontStyle.pfsBold, TPdfFontStyle.pfsItalic])
    else
      result := false;
    if result and (ACommand <> #10) and (ACommand <> #13) then
      LFontCommand := ACommand;
  end; // function lokCheckFont

  procedure lokLeft;
  var
    i: integer;
    s, t: string;
    nichtgefunden: boolean;

    function lokBis(a: TSysCharSet): boolean;
    var
      j, LPos: integer;
    begin
      result := false;
      LPos := 0;
      for j := 1 to Length(s) do begin
        if CharInSet(s[j], a) or (j = Length(s)) then begin
          t := copy(s, 1, j);
          LWidth := FPDF.Canvas.TextWidth(t);
          if LWidth < LPlace then
            LPos := j
          else
            Break;
        end;
      end;
      if LPos > 0 then begin
        result := true;
        t := copy(s, 1, LPos);
        FPDF.Canvas.TextOut(LLeft2, FY, t);
        Delete(s, 1, j);
        LLeft2 := LLeft2 + LWidth;
        exit;
      end;
    end; // function lokBisLeer

    function lokCheckUmbruch: boolean;
    begin
      result := (LLeft2 > LLeft);
      if result then begin
        CheckNewLine(LMarginBottom);
        lokCheckFont(LFontCommand);
        LLeft2 := LLeft;
      end;
    end; // function lokCheckUmbruch

  begin
    for i := 0 to sl.Count - 1 do begin
      s := sl[i];
      if not lokCheckFont(s) then begin
        while Length(s) > 0 do begin
          LPlace := FColMargins[FColNum].Right - FColMargins[FColNum].Left - LRight - LLeft2;
          if not lokBis([' ']) then
            if not lokCheckUmbruch then
              if not lokBis(['.', ',', ';', ':', '_', '-']) then
                lokBis(['A'..'Z', 'a'..'z', '0'..'9']);
        end;
      end;
    end;
  end; // procedure lokLeft

begin
  LText := FindParamStringReplaced('c', '');
  LText := FExecInter.ReplaceFunctions(LText);
  LAlign := FInter.FindParamAlignment(FExecInter.LineP, 'a', taLeftJustify);
  LLeft := FindParamSingleReplaced('l', 18) * FZoom;
  LLeft2 := LLeft;
  LRight := FindParamSingleReplaced('r', 15) * FZoom;
  LMarginBottom := FindParamSingleReplaced('mb', 20) * FZoom;
  LMarginBottomParagraph := FindParamSingleReplaced('mbp', 20) * FZoom;
  LFontName := FindParamString('n', 'Helvetica');
  LSize := FindParamSingleReplaced('s', 10);
  FLineHeight := LSize * 1.2;
  sl := TStringList.Create;
  try
    lokZerlegen;
    case LAlign of
      taLeftJustify: lokLeft;
    end;
  finally
    sl.free;
  end;
  FY := FY - FLineHeight;
// procedure TBafPdfModule.PdfMultilineBB
end;

procedure TBafPdfModule.PdfSetY;
var
  s: string;
begin
  if FindParam('y', s) then
    FY := FindParamSingleReplaced('y', 0) * FZoom;
  FY := FY - FindParamSingleReplaced('d', 0) * FZoom;
end;

procedure TBafPdfModule.PdfStart(AIntern: boolean = false; ALandscape: boolean = false);
begin
  FLineGroup.Clear;
  FPDF := TPdfDocument.Create(false,0,false);
  FPDF.GeneratePDF15File := true;
  FPDF.DefaultPaperSize := psA4;
  if not AIntern then
    FPDF.DefaultPageLandscape := FindParamBooleanReplaced('pal', false)
  else
    FPDF.DefaultPageLandscape := ALandscape;
  FPDF.CompressionMethod := cmFlateDecode;
  FPage := 0;
  PdfAddPage;
  PdfColfClear;
  FPDF.Canvas.SetTextRenderingMode(trFill);
  FPicList := TStringList.Create;
  FPicList.OwnsObjects := true;
end;

procedure TBafPdfModule.PdfStop(AFileName: string = '');
var
  LDialog: TSaveDialog;
begin
  if AFileName = '' then
    AFileName := FindParamStringReplaced('fn', '');
  if AFileName = '' then begin
    LDialog := TSaveDialog.Create(nil);
    try
      LDialog.Filter := 'PDF-Dateien *.pdf|*.pdf|Alle Dateien *.*|*.*';
      if LDialog.Execute then begin
        AFileName := LDialog.FileName;
        if FileExists(AFileName) then begin
          ShowMessage('File ' + AFileName + ' already exists');
        end
        else
          FPDF.SaveToFile(AFileName);
      end;
    finally
      LDialog.Free;
    end;
  end
  else
    FPDF.SaveToFile(AFileName);
  FreeAndNil(FPicList);
  if (AFileName <> '') and FindParamBooleanReplaced('o', false) then
    BafOpenFile(AFileName);
end;

procedure TBafPdfModule.PrintCell(ACell: TBafSgCell; ACol: integer;
    APdfGridColumn: TBafPdfGridColumn);
var
  LRect: TPdfRect;
  i: integer;
  LPdfGridColumn2: TBafPdfGridColumn;
begin
  LRect.Left := APdfGridColumn.Left * FZoom;
  LRect.Right := APdfGridColumn.Right * FZoom - 6;
  for i := 1 to ACell.ColSpan - 1 do begin
    LPdfGridColumn2 := (FColumns[ACol + i] as TBafPdfGridColumn);
    if LPdfGridColumn2.Page = APdfGridColumn.Page then
      LRect.Right := LPdfGridColumn2.Right * FZoom - 6
    else
      Break;
  end;
  LRect.Top := FY;
  LRect.Bottom := FY - 7 * FZoom;
  FPDF.Canvas.TextRect(LRect, ACell.Text, paLeftJustify, true);

end;

procedure TBafPdfModule.InitPage;
begin
  FPageScale := 0.29;
  if FLandscape then begin
    FPageWidth := 297;
    FPageHeight := 210;
    FPageMarginLeft := 15;
    FPageMarginRight := 15;
    FPageMarginTop := 25;
    FPageMarginBottom := 15;
  end
  else begin
    FPageWidth := 210;
    FPageHeight := 297;
    FPageMarginLeft := 25;
    FPageMarginRight := 15;
    FPageMarginTop := 15;
    FPageMarginBottom := 15;
  end;
  FPageWidthUse := FPageWidth - FPageMarginLeft - FPageMarginRight;
  FPageHeightUse := FPageHeight - FPageMarginTop - FPageMarginBottom;
end;

function TBafPdfModule.InterpretLine(AExecInter: TBafCustomInterpreter): boolean;
var
  LNum: integer;
  LInter: TBafCustomInterpreter;
begin
  result := false;
  LInter := FExecInter;
  try
    FExecInter := AExecInter;

    result := true;
    if FExecInter.LineF = '#pdf_start' then PdfStart                              // starts creation of a PDF
    else if FExecInter.LineF = '#pdf_stop' then PdfStop                           // stops the creation an saves the file
    else if FExecInter.LineF = '#pdf_text' then PdfLine(true)                     // draw a line, with LineFeed
    else if FExecInter.LineF = '#pdf_texto' then PdfLine(false)                   // draw a line, without LineFeed
    else if FExecInter.LineF = '#pdf_font' then PdfFont                           // sets the font
    else if FExecInter.LineF = '#pdf_sety' then PdfSetY                           // sets the Y position
    else if FExecInter.LineF = '#pdf_checknewline' then PdfCheckNewLine           // checks for the lower border of the page
    else if FExecInter.LineF = '#pdf_loadpic' then PdfLoadPic                     // load a picture as an object
    else if FExecInter.LineF = '#pdf_insertpic' then PdfInsertPic                 // insert a loaded picture
    else if FExecInter.LineF = '#pdf_newpage' then PdfAddPage                     // creates a new page
    else if FExecInter.LineF = '#pdf_newcol' then PdfAddCol                       // creates a new column
    else if FExecInter.LineF = '#pdf_execsub' then PdfExecSub                     // executes a subroutine
    else if FExecInter.LineF = '#pdf_multi' then PdfMultiline                     // draw multiline text
    else if FExecInter.LineF = '#pdf_multibb' then PdfMultilineBB                 // draw multiline text with formatting codes
    else if FExecInter.LineF = '#pdf_line' then PdfDrawLine                       // draw a line
    else if FExecInter.LineF = '#pdf_coldef' then PdfColfDef                      // defines columns

    {$IFDEF with_zint}
    else if FExecInter.LineF = '#pdf_createbarcode' then PdfCreateBarcode          // creates a barcode to insert with #pdfinsertpic
    {$ENDIF}

    else if FExecInter.LineF = '#pdf_bus' then PdfBus                              // createa a bus plan für trendtours


    else result := false;
  finally
    FExecInter := LInter;
  end;

end;

procedure TBafPdfModule.MakeColumns;
var
  LRow, LCol, LPage, LMaxColSpan, i: integer;
  LPdfGridColumn: TBafPdfGridColumn;
  LCell: TBafSgCell;
  LLeftPos, LWidthLeft, LCalcedWidth, LCalcedWidthSpan: single;

  function lokColWidth(ACol: integer): single;
  var
    LColumn: TBafSgColumn;
  begin
    LColumn := FGrid.Columns.Items[ACol];
    if LColumn.CellType in [ctButton,  ctGuid, ctLink] then
      result := 0
    else
      result := LColumn.Width * FPageScale + 6;
  end; // function lokColWidth

begin
  LPage := 1;
  LLeftPos := FPageMarginLeft;
  LWidthLeft := FPageWidthUse;
  for LCol := 0 to FGrid.Columns.Count - 1 do begin
    LCalcedWidth := lokColWidth(LCol);
    LMaxColSpan := 1;
    for LRow := 0 to FGrid.RowCount(rtHeader) - 1 do begin
      LCell := FGrid.Cells[rtHeader, LCol, LRow];
      LMaxColSpan := System.Math.Max(LMaxColSpan, LCell.ColSpan);
    end;
    LCalcedWidthSpan := 0;
    for i := 0 to LMaxColSpan - 1 do
      LCalcedWidthSpan := LCalcedWidthSpan + lokColWidth(i);
    if ((LCalcedWidthSpan > LWidthLeft) and (LCalcedWidthSpan < FPageWidthUse))
        or (LCalcedWidth > LWidthLeft) then begin
      inc(LPage);
      LLeftPos := FPageMarginLeft;
      LWidthLeft := FPageWidthUse;
    end;
    if LCalcedWidth > 1 then begin
      LPdfGridColumn := TBafPdfGridColumn.Create;
      LPdfGridColumn.Index := LCol;
      LPdfGridColumn.Page := LPage;
      LPdfGridColumn.Left := LLeftPos;
      LPdfGridColumn.Right := LLeftPos + LCalcedWidth;
      LWidthLeft := LWidthLeft - LCalcedWidth;
      LLeftPos := LPdfGridColumn.Right;
      FColumns.Add(LPdfGridColumn);
    end;
  end;
  FPagesPerRow := LPage;
// procedure TBafPdfModule.MakeColumns
end;

procedure TBafPdfModule.PrintHeader(APage: integer);
var
  LCol, LRow, i, ix: integer;
  LPdfGridColumn: TBafPdfGridColumn;
  LCell: TBafSgCell;
begin
  if FPage > 0 then
    FPDF.AddPage;
  inc(FPage);
  FColNum := 0;
  if FPDF.DefaultPageLandscape then
    FZoom := FPDF.Canvas.Page.PageHeight / 210
  else
    FZoom := FPDF.Canvas.Page.PageHeight / 297;
  FY := (FPageMarginBottom + FPageHeightUse) * FZoom;
  FPDF.Canvas.SetFont('Helvetica', 10, [pfsBold]);
  for LRow := 0 to FGrid.RowCount(rtHeader) - 1 do begin
    ix := FGrid.RowCount(rtHeader);
    for LCol := 0 to FColumns.Count - 1 do begin
      LPdfGridColumn := (FColumns[LCol] as TBafPdfGridColumn);
      if LPdfGridColumn.Page = APage then begin
        LCell := FGrid.Cells[rtHeader, LPdfGridColumn.Index, LRow];
        PrintCell(LCell, LCol, LPdfGridColumn);

      end
      else if LPdfGridColumn.Page > APage then
        Break;
    end;
    FY := FY - 8 * FZoom;
  end;
  FPDF.Canvas.SetFont('Helvetica', 10, []);

end;

procedure TBafPdfModule.PrintRows(APage, AStart: integer; var ALast: integer);
var
  LCol, LRow: integer;
  LPdfGridColumn: TBafPdfGridColumn;
  LCell: TBafSgCell;
begin
  while (AStart < FGrid.RowCount(rtData))
      and (FY > FPageMarginBottom * FZoom) do begin
    for LCol := 0 to FColumns.Count - 1 do begin
      LPdfGridColumn := (FColumns[LCol] as TBafPdfGridColumn);
      if LPdfGridColumn.Page = APage then begin
        LCell := FGrid.Cells[rtData, LPdfGridColumn.Index, AStart];
        PrintCell(LCell, LCol, LPdfGridColumn);
        ALast := AStart;
      end
      else if LPdfGridColumn.Page > APage then
        Break;
    end;
    FY := FY - 8 * FZoom;
    inc(AStart);
  end;
end;

function TBafPdfModule.OpenFileDialog(var AFileName: string): boolean;
var
  LDialog: TSaveDialog;
begin
  result := false;
  LDialog := TSaveDialog.Create(nil);
  try
    LDialog.Filter := 'PDF-Dateien *.pdf|*.pdf|Alle Dateien *.*|*.*';
    LDialog.DefaultExt := 'pdf';
    result := LDialog.Execute;
    if result then
      AFileName := LDialog.FileName;
  finally
    LDialog.Free;
  end;
end;

end.


