unit Prndata;
{$I DEFINE.PAS}
interface
uses
  Forms, WinTypes, WinProcs, Graphics, Printers,{guess what - for printing}
  SysUtils,
  objects, mylib, binhex, globals,

  datasrc;

procedure PrintData(const ADataSrcInfo:TDataSrcInfo; AData:PData);


implementation

type
  TPrinterPage = record
    Width,
    Height,
    FixLeftMargin,
    FixTopMargin,
    FixRightMargin,
    FixBottomMargin:integer;
  end;

  PDataPrinter = ^TDataPrinter;
  TDataPrinter = object(TObject)
    DataSrc:PDataSrc;

    Index:integer;

    PrinterPage:TPrinterPage;
    ppix,ppiy:integer;{pixels per inch in given directions}

    Columns:integer;{1 or 2 (or more?), also for printing tellist}
    CurCol:integer;
    ColumnWidth:Integer;{= AreaWidth or AreaWidth / 2, pixels}
    CharsPerLine,
    LinesPerPage,
    CharHeight,
    CharWidth,
    LineHeight:integer;{pixels}

    LeftMargin,
    TopMargin,
    BottomMargin,
    RightMargin,

    HeadHeight, {area above TopMargin for printing page headings}
    FootHeight:integer;{area below BottomMargin for printing page footers}
    {printing area (does not includes head and foot:}
    AreaWidth,
    AreaHeight:integer;{pixels}

    RecordLeftMargin,
    RecordTopMargin:integer;{for subareas on page}
    RecordWidth,
    RecordHeight : integer;{pixels}
    CurRecordOffset:integer;{current distance of
      left end of string to be printed from RecordLeftMargin pos
      in the record area}
    RecordColumns, RecordRows,
    CurRecordCol, CurRecordRow : integer;{for printing labels, using
      globals LabelRows and LabelColumns}

    CurX, CurY : integer;{cur line start (left top edge)
      in points}
    CheckBottomLines :integer;{how many char lines before reaching
      bottom of printable erea to skip to new column or page; default = 1}
    RecordsRemainedToPrint:integer;{how many records still remain to be
      printed, used to decide if formfeed at the end is necessary}
    ExactPageSize:boolean;
    constructor Init(const ADataSrcInfo:TDataSrcInfo; AData:PData);
    function InspectPrinter:boolean;

    procedure SetPaperMargins;virtual;{called from init
      before adjusting; set paper margins and columns
      to what ever you want(, footheight, headheigh..)}
    procedure SetDefaults;virtual;{e.g. for records}

    procedure Print;virtual;
    procedure PrintRecord;virtual;
      procedure PrintSimpleRecord;{generic just dump it}

    procedure Write(s:string);
    procedure WriteLine(s:string);
    procedure NewColumn;{moves to new column or page}
    procedure MoveTo(X,Y:integer);
    procedure NextRecord;
    procedure FixRecordWidth(var s:string);
    procedure StartPage;virtual;{write heading, page num or anything,
      call at the beggining of print and before Printer.NewPage}
    procedure FinishPage;virtual;{write footing or anyting, call before
      Printer.NewPage}
    procedure SetCurRecordOffset(AOffset:integer);
    destructor Done;virtual;

    function ScanOrPrintRecord(APrint:boolean):integer;
  end;

{**************************************************}
{**************************************************}
{***********************************************}


function MMToPixels(MM:integer):integer;
begin
end;

function TDataPrinter.InspectPrinter:boolean;
var
  n, ADeviceName, ADriver, ADriverName, APort:array[0..255] of char;

  I, J: Integer;

  StubDevMode:TDevMode;
  Pin, Pout: PDevMode;

  FDeviceHandle:THandle;
  DeviceMode:word;
  loutDeviceMode:word;
  linDeviceMode:word;
  dmSize:word;

  FExtDeviceMode:function(Wnd: HWnd; Driver: THandle;
    var DevModeOutput: TDevMode; DeviceName, Port: PChar;
    var DevModeInput: TDevMode; Profile: PChar; Mode: Word): Integer;


  function SetSizes:boolean;
  const mmPerInch = 25.4;
  var w,h:real;{in 0.1 mm units}
  begin
    SetSizes := false;
    w := 0;
    h := 0;
    if Pout^.dmPaperSize <> 0 then begin
      case Pout^.dmPaperSize of
      {DMPAPER_FIRST,}
      DMPAPER_LETTER:{Letter, 8 1/2 x 11 in.}begin
        w := 8.5 * mmPerInch;
        h := 11 * mmPerInch;
      end;
      DMPAPER_LETTERSMALL:{Letter Small, 8 1/2 x 11 in.}begin
        w := 8.5 * mmPerInch;
        h := 11 * mmPerInch;
      end;
      DMPAPER_TABLOID:{Tabloid, 11 x 17 in.} begin
        w := 11 * mmPerInch;
        h := 17 * mmPerInch;
      end;
      DMPAPER_LEDGER:{Ledger, 17 x 11 in.}begin
        w := 17 * mmPerInch;
        h := 11 * mmPerInch;
      end;
      DMPAPER_LEGAL:{Legal, 8 1/2 x 14 in.}begin
        w := 8.5 * mmPerInch;
        h := 14 * mmPerInch;
      end;
      DMPAPER_STATEMENT:{Statement, 5 1/2 x 8 1/2 in.}begin
        w := 5.5 * mmPerInch;
        h := 8.5 * mmPerInch;
      end;
      DMPAPER_EXECUTIVE:{Executive, 7 1/2 x 10 1/2 in.}begin
        w := 7.5 * mmPerInch;
        h := 10.5 * mmPerInch;
      end;
      DMPAPER_A3:{A3, 297 x 420 mm}begin
        w := 297;
        h := 420;
      end;
      DMPAPER_A4:{A4, 210 x 297 mm}begin
        w := 210;
        h := 297;
      end;
      DMPAPER_A4SMALL:{A4 Small, 210 x 297 mm}begin
        w := 210;
        h := 297;
      end;
      DMPAPER_A5:{A5, 148 x 210 mm}begin
        w := 148;
        h := 210;
      end;
      DMPAPER_B4:{B4, 250 x 354 mm}begin
        w := 250;
        h := 354;
      end;
      DMPAPER_B5:{B5, 182 x 257 mm}begin
        w := 250;
        h := 354;
      end;
      DMPAPER_FOLIO:{Folio, 8 1/2 x 13 in.}begin
        w := 8.5 * mmperinch;
        h := 13 * mmperinch;
      end;
      DMPAPER_QUARTO:{Quarto, 215 x 275 mm}begin
        w := 215;
        h := 275;
      end;
      DMPAPER_10X14:{10 x 14 in.}begin
        w := 10 * mmperinch;
        h := 14 * mmperinch;
      end;
      DMPAPER_11X17:{11 x 17 in.}begin
        w := 11 * mmperinch;
        h := 17 * mmperinch;
      end;
      DMPAPER_NOTE:{Note, 8 1/2 x 11 in.}begin
        w := 8.5 * mmperinch;
        h := 11 * mmperinch;
      end;
      DMPAPER_ENV_9:{Envelope #9, 3 7/8 x 8 7/8 in.}begin
        w := 3.875 * mmperinch;
        h := 8.875 * mmperinch;
      end;
      DMPAPER_ENV_10:{Envelope #10, 4 1/8 x 9 1/2 in.}begin
        w := 4.125 * mmperinch;
        h := 9.5 * mmperinch;
      end;
      DMPAPER_ENV_11:{Envelope #11, 4 1/2 x 10 3/8 in.}begin
        w := 4.5 * mmperinch;
        h := 10.375 * mmperinch;
      end;
      DMPAPER_ENV_12:{Envelope #12, 4 1/2 x 11 in.}begin
        w := 4.5 * mmperinch;
        h := 11 * mmperinch;
      end;
      DMPAPER_ENV_14:{Envelope #14, 5 x 11 1/2 in.}begin
        w := 5 * mmperinch;
        h := 11.5 * mmperinch;
      end;
      DMPAPER_CSHEET:{C size sheet}begin{?}
        w := 8.5 * mmperinch;
        h := 11 * mmperinch;
      end;
      DMPAPER_DSHEET:{D size sheet}begin
        w := 8.5 * mmperinch;
        h := 11 * mmperinch;
      end;
      DMPAPER_ESHEET:{E size sheet}begin
        w := 8.5 * mmperinch;
        h := 11 * mmperinch;
      end;
      (*
      DMPAPER_ENV_DL:{Envelope DL, 110 x 220 mm}begin
        w := 110;
        h := 220;
      end;

      DMPAPER_ENV_C3:{Envelope C3, 324 x 458 mm}begin
        w := 324;
        h := 458;
      end;
      DMPAPER_ENV_C4:{Envelope C4, 229 x 324 mm}begin
        w := 229;
        h := 324;
      end;
      DMPAPER_ENV_C5:{Envelope C5, 162 x 229 mm}begin
        w := 162;
        h := 229;
      end;
      DMPAPER_ENV_C6:{Envelope C6, 114 x 162 mm}begin
        w := 114;
        h := 162;
      end;
      DMPAPER_ENV_C65:{Envelope C65, 114 x 229 mm}begin
        w := 114;
        h := 229;
      end;
      DMPAPER_ENV_B4:{Envelope B4, 250 x 353 mm}begin
        w := 250;
        h := 353;
      end;
      DMPAPER_ENV_B5:{Envelope B5, 176 x 250 mm}begin
        w := 176;
        h := 250;
      end;
      DMPAPER_ENV_B6:{Envelope B6, 176 x 125 mm}begin
        w := 176;
        h := 125;
      end;
      DMPAPER_ENV_ITALY:{Envelope, 110 x 230 mm}begin
        w := 110;
        h := 230;
      end;
      DMPAPER_ENV_MONARCH:{Envelope Monarch, 3 7/8 x 7 1/2 in.}begin
        w := 3.875 * mmperinch;
        h := 7.2 * mmperinch;
      end;
      DMPAPER_ENV_PERSONAL:{Envelope, 3 5/8 x 6 1/2 in.}begin
        w := 3.875 * mmperinch;
        h := 7.2 * mmperinch;
      end;
      DMPAPER_FANFOLD_US:{U.S. Standard Fanfold, 14 7/8 x 11 in.}begin
        w := 14.875 * mmperinch;
        h := 11 * mmperinch;
      end;
      *)
      258{DMPAPER_FANFOLD_STD_GERMAN}:{German Standard Fanfold, 8 1/2 x 12 in.}begin
        w := 8.5 * mmperinch;
        h := 12 * mmperinch;
      end;
      (*
      {DMPAPER_FANFOLD_LGL_GERMAN,}
      DMPAPER_LAST:{German Legal Fanfold, 8 1/2 x 13 in.}begin
        w := 8.5 * mmperinch;
        h := 13 * mmperinch;
      end;
      DMPAPER_USER:{User-defined}exit;
      *)
      else
        exit;
      end;
      w := w * 10;
      h := h * 10;
    end else begin
      w := Pout^.dmPaperWidth;
      h := Pout^.dmPaperLength;
    end;
    with PrinterPage do begin
      Height := round(h * ppiy / 254);
      Width := round(w *  ppix / 254);
    end;
    SetSizes := true;
  end;


label ex;
var what:integer;
begin
  InspectPrinter:= false;
  ExactPageSize:= false;

  {CheckPrinting(False);}
  DeviceMode := 0;
  loutDeviceMode:= 0;
  linDeviceMode := 0;

  Printer. GetPrinter(ADeviceName, ADriver, APort, DeviceMode);
  StrCat(StrCopy(ADriverName, ADriver), '.DRV');
  FDeviceHandle := LoadLibrary(ADriverName);
  if FDeviceHandle < HINSTANCE_ERROR{16} then
    exit;

  @FExtDeviceMode := GetProcAddress(FDeviceHandle, 'ExtDeviceMode');
  if not Assigned(FExtDeviceMode) then
    goto ex;

  dmSize := FExtDeviceMode(0, FDeviceHandle, StubDevMode,
    ADeviceName, APort, StubDevMode, nil, 0);
  if DeviceMode = 0 then begin
    linDeviceMode := GlobalAlloc(HeapAllocFlags or GMEM_ZEROINIT,
      dmSize);
  end else begin
    linDeviceMode := DeviceMode;
  end;

  loutDeviceMode := GlobalAlloc(HeapAllocFlags or GMEM_ZEROINIT,
      dmSize);

  if (linDeviceMode = 0) or (loutDeviceMode = 0) then
    goto ex;

  Pin := Ptr(linDeviceMode, 0);
  Pout := Ptr(loutDeviceMode, 0);
  move(Pin^, Pout^, dmSize);

  if pp^.printtype = prLabels then
    what := DM_OUT_BUFFER{DM_IN_PROMPT}
  else
    what := DM_OUT_BUFFER;
  if FExtDeviceMode(0, FDeviceHandle, Pin^, ADeviceName, APort, Pout^, nil,
    what) < 0 then
    goto ex;

  if not SetSizes then
    goto ex;
  ExactPageSize:= true;
  InspectPrinter := true;
ex:
  if (linDeviceMode <> 0) and (DeviceMode = 0) then
    GlobalFree(linDeviceMode);
  if (loutDeviceMode <> 0) then
    GlobalFree(loutDeviceMode);
  linDeviceMode := 0;
  loutDeviceMode := 0;
  FreeLibrary(FDeviceHandle);
end;

constructor TDataPrinter.Init(const ADataSrcInfo:TDataSrcInfo; AData:PData);

  procedure InitPrinterPageSizes;
  label ex;
  begin

    if InspectPrinter then begin{i.e. got exact paper sizes to
      height, width vars}
      with PrinterPage do begin
        FixLeftMargin := (Width - Printer.PageWidth) div 2;
        if FixLeftMargin < 0 then
          FixLeftMargin := 0;
        FixRightMargin := Width - FixLeftMargin - Printer.PageWidth;
        if FixRightMargin < 0 then
          FixRightMargin := 0;

        FixTopMargin := (Height - Printer.PageHeight) div 2;
        if FixTopMargin < 0 then
          FixTopMargin := 0;
        FixBottomMargin := Height - FixTopMargin - Printer.PageHeight;
        if FixBottomMargin < 0 then
          FixBottomMargin := 0;
      end;
    end else begin
      with PrinterPage do begin
        Height := Printer.PageHeight;
        Width := Printer.PageWidth;
        FixLeftMargin := 0;
        FixTopMargin := 0;
        FixRightMargin := 0;
        FixBottomMargin := 0;
      end;
      with PrinterPage do begin
        FixRightMargin := Width - Printer.PageWidth - FixLeftMargin;
        FixBottomMargin := Height - Printer.PageHeight - FixTopMargin;
      end;
    end;

    {A4:}
    if (Printer.PageWidth > 2300) and (Printer.PageWidth < 2500) then begin
    {HP 300dpi A4}
      with PrinterPage do begin
        Height := 3507;
        Width := 2480;
        FixLeftMargin := 50;
        FixTopMargin := 60;
        FixRightMargin := 92;
        FixBottomMargin := 58;
      end;
    end else begin
    end;

  ex:
  end;

  procedure ConvertPaperMargins;
  begin
    TopMargin := TopMargin - PrinterPage.FixTopMargin;
    BottomMargin := BottomMargin - PrinterPage.FixBottomMargin;
    LeftMargin := LeftMargin - PrinterPage.FixLeftMargin;
    RightMargin := RightMargin - PrinterPage.FixRightMargin;
    if (HeadHeight > 0) and (TopMargin - HeadHeight < 0) then begin
      TopMargin := HeadHeight;
    end;
  end;

begin
  if not inherited Init then
    Fail;
  if not DataSrcInit(ADataSrcInfo, AData, @Self, DataSrc) then
    Fail;
  ppix := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
  ppiy := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
  ExactPageSize := false;
  RecordsRemainedToPrint := 0;
  CurRecordCol := 0;
  CurRecordRow := 0;

  Index := 0;
  CurCol := 0;
  Columns := 1;
  HeadHeight := 0;{eventually changed in SetPaperMargins}
  FootHeight := 0;
  CharWidth := Printer.Canvas.TextWidth('M');
  CharHeight := Printer.Canvas.TextHeight('M');
  LineHeight := CharHeight;

  InitPrinterPageSizes;
    SetPaperMargins;{override to set page margins and columns}
  ConvertPaperMargins;{so that they reflect accessible area, not paper area}

  AreaHeight := Printer.PageHeight - TopMargin - BottomMargin;
  AreaWidth := Printer.PageWidth - LeftMargin - RightMargin;
  ColumnWidth := AreaWidth div Columns;
  CharsPerLine := AreaWidth div CharWidth;
  LinesPerPage := AreaHeight div CharHeight;


  RecordWidth := AreaWidth div Columns;
  RecordHeight := 1;
  RecordLeftMargin := 0;
  RecordTopMargin := 0;
  CurRecordOffset := 0;
  SetDefaults;{override to set record margins and sizes}

  MoveTo(LeftMargin + RecordLeftMargin, TopMargin + RecordTopMargin);
end;

procedure TDataPrinter.SetDefaults;
begin
  CheckBottomLines := 1;
end;

procedure TDataPrinter.StartPage;{write heading, page num or anything,
      call at the beggining of print and before Printer.NewPage}
begin
  DataSrcDo(DataSrc, ddStartPage);
end;

procedure TDataPrinter.FinishPage;{write footing or anyting, call before
      Printer.NewPage}
begin
  DataSrcDo(DataSrc, ddFinishPage);
end;

procedure TDataPrinter.SetPaperMargins;
begin
  LeftMargin := ppix;
  RightMargin := LeftMargin;
  TopMargin := ppiy;
  BottomMargin := TopMargin;
  DataSrcDo(DataSrc, ddSetPaperMargins);
{  if (PP^.opts and op2columns) <> 0 then
    Columns := 2;}
end;

procedure TDataPrinter.MoveTo(X,Y:integer);
begin
  CurX := X;
  CurY := Y;
  Printer.Canvas.MoveTo(X,Y);
end;

procedure TDataPrinter.SetCurRecordOffset(AOffset:integer);
begin
  CurRecordOffset := AOffset;
  MoveTo(LeftMargin + RecordLeftMargin + CurRecordOffset +
    CurCol * RecordWidth, CurY);
end;

procedure TDataPrinter.Write(S:String);
begin
  FixRecordWidth(s);
  Printer.Canvas.TextOut(CurX, CurY, S);
end;

procedure TDataPrinter.WriteLine(S:string);
begin
  Write(S);
  MoveTo(CurX, CurY + LineHeight);
  if CurY > TopMargin + AreaHeight - (LineHeight * CheckBottomLines) then
    NewColumn;
end;

procedure TDataPrinter.NewColumn;
begin
  inc(CurCol);
  if Columns = CurCol then begin
    FinishPage;
    Printer.NewPage;
    StartPage;
    CurCol := 0;
    MoveTo(LeftMargin + RecordLeftMargin, TopMargin + RecordTopMargin);
  end else begin
   {if CurX < (ColumnWidth * CurCol + LeftMargin) then begin}
    MoveTo(LeftMargin + ColumnWidth * CurCol + RecordLeftMargin,
     TopMargin + RecordTopMargin);
  end;
end;

procedure TDataPrinter.Print;
begin
  Printer.BeginDoc;
  StartPage;
  MoveTo(LeftMargin + RecordLeftMargin, TopMargin + RecordTopMargin);
  {$IFDEF DEBUG}
  Printer.Canvas.Rectangle(0,0, Printer.PageWidth, Printer.PageHeight);
  {$ENDIF}
  RecordsRemainedToPrint := DataSrcGetInt(DataSrc, dpRecordCount);
  Index := 0;
  if not DataSrcDoAction(DataSrc, daResetSource) then
    exit;
  repeat
    if Printer.Aborted then
      break;
    PrintRecord;
    dec(RecordsRemainedToPrint);
    inc(Index);
  until not DataSrcDoAction(DataSrc, daSkip);

  FinishPage;
  Printer.EndDoc;
end;

procedure TDataPrinter.PrintRecord;
begin
  PrintSimpleRecord;
end;

procedure TDataPrinter.NextRecord;
begin
  inc(CurRecordCol);
  if CurRecordCol = RecordColumns then begin
    inc(CurRecordRow);
    if (CurRecordRow = RecordRows) then
    begin
      if RecordsRemainedToPrint > 1 {i.e. more than just the one just printed}
      then
        Printer.NewPage;
      CurRecordRow := 0;
    end;
    CurRecordCol := 0;
  end;
  CurCol := CurRecordCol;

  MoveTo(LeftMargin + CurRecordCol * RecordWidth + RecordLeftMargin,
    TopMargin + CurRecordRow * RecordHeight + RecordTopMargin);

  if (CurY > (TopMargin + AreaHeight - RecordHeight)) then
  begin
    if RecordsRemainedToPrint > 1 {i.e. more than just the one just printed}
    then begin
      Printer.NewPage;
      CurRecordRow := 0;
      CurRecordCol := 0;
      MoveTo(LeftMargin + CurRecordCol * RecordWidth + RecordLeftMargin,
        TopMargin + CurRecordRow * RecordHeight + RecordTopMargin);
    end;
  end;
end;

function TDataPrinter.ScanOrPrintRecord(APrint:boolean):integer;
begin
  ScanOrPrintRecord := DataSrcGetInt(DataSrc, dpRecordLineCount);
  if APrint then
    DataSrcDoAction(DataSrc, daPrintRecord);
end;

procedure TDataPrinter.PrintSimpleRecord;{generic just dump it}
var
  recordDist:integer;
begin
  recordDist := LineHeight div 2;
  if (ScanOrPrintRecord(false) * LineHeight + recordDist) >= (TopMargin + AreaHeight - CurY) then
    NewColumn;
  ScanOrPrintRecord(true);
  MoveTo(CurX, CurY + recordDist);
end;

procedure TDataPrinter.FixRecordWidth(var s:string);
var i:integer;
begin
  i := (RecordWidth - RecordLeftMargin - CurRecordOffset);
  if i <= 0 then
    s := ''
  else begin
    while Printer.Canvas.TextWidth(s) > i do
      dec(s[0]);
  end;
end;

destructor TDataPrinter.Done;
begin
  inherited Done;
end;

{*********************************************************}

(*
procedure TUserPrinter.StartPage;{write heading, page num or anything,
      call at the beggining of print and before Printer.NewPage}
begin
  if (PP^.opts and opHeading) <> 0 then begin
    HeadHeight := LineHeight + LineHeight div 2;
    if TopMargin - HeadHeight < 0 then begin
      TopMargin := HeadHeight;
    end;
    MoveTo(LeftMargin + (AreaWidth - Printer.Canvas.TextWidth(PP^.Heading)) div 2,
      TopMargin - HeadHeight);
    Write(PP^.Heading);
  end;
end;

procedure TUserPrinter.FinishPage;{write footing or anyting, call before
      Printer.NewPage}
begin
end;

procedure TUserPrinter.SetPaperMargins;
begin
  inherited SetPaperMargins;
  if (PP^.opts and opHeading) <> 0 then begin
    HeadHeight := LineHeight + LineHeight div 2;
    if TopMargin - HeadHeight < 0 then begin
      TopMargin := HeadHeight;
    end;
  end;
end;

procedure TUserPrinter.PrintRecord;
begin
  {$IFDEF SYSLOG}
  syslog.log(slDebug, 'UserPrinter.PrintRecord begin');
  {$ENDIF}

  if DC <> nil then begin
    case DC^.RecordID of
      id_tel : PrintUserTelRecord;
      id_business : PrintUserBusinessRecord;
      id_schedule : PrintUserScheduleRecord;
      id_reminder : PrintUserReminderRecord;
      id_memo : PrintUserMemoRecord;
      else
        PrintSimpleRecord;
    end;
  end else begin
    case XC^.FileID of
      fid_tel1, fid_tel2, fid_tel3 : PrintUserTelRecord;
      {id_business : PrintUserBusinessRecord;}
      fid_schedule : PrintUserScheduleRecord;{x5pkt}
      fid_reminder : PrintUserReminderRecord;
      fid_memo1..fid_memo3 : PrintUserMemoRecord;
      else
        PrintSimpleRecord;
    end;
  end;
end;

procedure TUserPrinter.PrintUserTelRecord;
begin
  PrintSimpleRecord;
end;

procedure TUserPrinter.PrintUserBusinessRecord;
begin
  PrintSimpleRecord;
end;

procedure TUserPrinter.PrintUserScheduleRecord;
begin
  PrintSimpleRecord;
end;

procedure TUserPrinter.PrintUserMemoRecord;
begin
  PrintSimpleRecord;
end;

procedure TUserPrinter.PrintUserReminderRecord;
begin
  PrintSimpleRecord;
end;

{
   fiteName = 1;
   fiteNumber = 2;
   fiteAddress = 3;
   fiteFree1 = 4;

   fibuName = 1;
   fibuEmployer= 2;
   fibuNumber = 3;
   fibuPosition = 4;
   fibuDepartment = 5;
   fibuPOBox = 6;
   fibuAddress = 7;
   fibuTelex = 8;
   fibuFax = 9;
   fibuFree1 = 10;
}

{****************************************************************}

procedure TAddressPrinter.SplitPSC(var s:string; var psc:string);
var
  p:byte;
  i:integer;
begin
  s := trim(s);
  psc := '';
  if length(s) < 6 then
    exit;
  for i := 1 to 6 do begin
    if (i = 4) then begin
     if (s[i] <> ' ') then
      exit
    end else if not (s[i] in ['0'..'9']) then
      exit;
  end;
  psc := copy(s, 1, 6);
  s := trim(copy(s, 7, 255));
end;

procedure TAddressPrinter.PrintBusinessAddress;
var
  s:string;
  ps:PSubString;
  orx:integer;
  psc:string;
begin
{  if CurY + (5 * LineHeight) >
    TopMargin + AreaHeight - (LineHeight * CheckBottomLines)
  then
    NewColumn;
}

  orx := CurX;
  MoveTo(CurX + PSCOffset, CurY);
  CurRecordOffset := PSCOffset;
  if DR <> nil then begin
    s := DR^.GetFieldLineString(1{fibuEmployer}, 1);
    WriteLine(s);
    s := DR^.GetFieldLineString(2{fibuName}, 1);
    WriteLine(s);
    s := DR^.GetFieldLineString(fibuAddress, 1);
    WriteLine(s);
    s := DR^.GetFieldLineString(fibuAddress, 2);
    if s = '' then
      s := DR^.GetFieldLineString(fibuPOBox, 1);
    SplitPSC(s, psc);
    if psc <> '' then begin
      MoveTo(orx, CurY);
      Write(psc);
      MoveTo(orx + PSCOffset, CurY);
    end;
    WriteLine(s);
     {gets specified line (from 1) from specified field in record
      of maximal width ADisplayWidth, fills in ASubString and returns it}
  end;
end;

procedure TAddressPrinter.SetDefaults;
begin
  inherited SetDefaults;
  PSCOffset := Printer.Canvas.TextWidth('000 00  ');{8 * CharWidth;}
end;

procedure TAddressPrinter.PrintTelAddress;
var
  s:string;
  ps:PSubString;
  orx:integer;
  psc:string;
  freeused:boolean;

begin
 { if CurY + (5 * LineHeight) >
    TopMargin + AreaHeight - (LineHeight * CheckBottomLines)
  then
    NewColumn;
}

  orx := CurX;
  MoveTo(CurX + PSCOffset, CurY);
  CurRecordOffset := PSCOffset;

  if DR <> nil then begin

    freeused := false;
    s := DR^.GetFieldLineString(fiteName, 1);
    WriteLine(s);
    s := DR^.GetFieldLineString(fiteName, 2);
    WriteLine(s);
    s := DR^.GetFieldLineString(fiteAddress, 1);
    WriteLine(s);

    s := DR^.GetFieldLineString(fiteAddress, 2);
    if s = '' then begin
      s := DR^.GetFieldLineString(fiteFree1, 1);
      freeused:= true;
    end;
    SplitPSC(s, psc);
    if psc <> '' then begin
      MoveTo(orx, CurY);
      Write(psc);
      MoveTo(orx + PSCOffset, CurY);
    end;
    WriteLine(s);

    if not freeused then begin
      s := DR^.GetFieldLineString(fiteAddress, 3);
      if s <> '' then
        WriteLine(s);{country}
    end;

  end else begin

    s := XR^.GetFieldLineString(fiX5Name, 1);
    WriteLine(s);
    s := XR^.GetFieldLineString(fiX5Name, 2);
    WriteLine(s);
    s := XR^.GetFieldLineString(fiX5Address, 1);
    WriteLine(s);
    s := XR^.GetFieldLineString(fiX5Address, 2);
    {if s = '' then x5data
      s := XR^.GetFieldLineString(fiteFree1, 1);}
    SplitPSC(s, psc);
    if psc <> '' then begin
      MoveTo(orx, CurY);
      Write(psc);
      MoveTo(orx + PSCOffset, CurY);
    end;
    WriteLine(s);
    s := XR^.GetFieldLineString(fiX5Address, 3);
    if s <> '' then
      WriteLine(s);{country}
  end;

{gets specified line (from 1) from specified field in record
 of maximal width ADisplayWidth, fills in ASubString and returns it}
end;

procedure TAddressPrinter.PrintRecord;
begin
  {$IFDEF SYSLOG}
  syslog.log(slDebug, 'AddressPrinter.PrintRecord begin');
  {$ENDIF}
  if DC <> nil then begin
    case DC^.RecordID of
     id_tel : PrintTelAddress;
     id_business: PrintBusinessAddress;
    end;
  end else begin
    case XC^.FileID of
      fid_tel1..fid_tel3: PrintTelAddress;
    end;
  end;
end;

{******************************************************}
procedure TTelListPrinter.SetPaperMargins;
begin
  inherited SetPaperMargins;
  Columns := 2;
  LeftMargin := CharWidth * 5;
  RightMargin := LeftMargin;
end;

procedure TTelListPrinter.SetDefaults;
begin
  inherited SetDefaults;
  RecordLeftMargin := 0;
  CheckBottomLines := 2;
  RecordTopMargin := 0;{Printer.Canvas.TextWidt('M');}
  TelRecordWidth := AreaWidth div 2;
  NameOffset := Printer.Canvas.TextWidth('MM');
  AddressOffset := Printer.Canvas.TextWidth('MMM');
  TelOffset := TelRecordWidth - Printer.Canvas.TextWidth('12345789012345');
  AddressLinesWritten := 0;
  CheckBottomLines := 2;
  NormalFontSize := Printer.Canvas.Font.Size;
  AddressFontSize:= round(NormalFontSize * 0.8);
  NormalFontStyle := Printer.Canvas.Font.Style;
  NameFontStyle := [fsBold];
  AddressFontStyle := [fsItalic];
end;

procedure TTelListPrinter.PrintRecord;
begin
  {$IFDEF SYSLOG}
  syslog.log(slDebug, 'TelListPrinter.PrintRecord begin');
  {$ENDIF}
  if CurY + (4 * LineHeight) >
    TopMargin + AreaHeight - (LineHeight * CheckBottomLines)
  then
    NewColumn;

  if DC <> nil then begin
    case DC^.RecordID of
      id_tel : PrintTelListTelRecord;
      id_business: PrintTelListBusinessRecord;
    end;
  end else begin
    case XC^.FileID of
      fid_tel1..fid_tel3: PrintTelListTelRecord;
    end;
  end;
  MoveTo(CurX, CurY + CharHeight div 4);
end;

{
   fiteName = 1;
   fiteNumber = 2;
   fiteAddress = 3;
   fiteFree1 = 4;

   fibuName = 1;
   fibuEmployer= 2;
   fibuNumber = 3;
   fibuPosition = 4;
   fibuDepartment = 5;
   fibuPOBox = 6;
   fibuAddress = 7;
   fibuTelex = 8;
   fibuFax = 9;
   fibuFree1 = 10;
}

procedure TTelListPrinter.WriteTelListAddressLine(AFieldNo, ALineNo:integer);
var s:string;
begin
  if AddressLinesWritten = 3 then
    exit;
  if DR <> nil then begin
    s := DR^.GetFieldLineString(AFieldNo, ALineNo)
  end else begin
    s := XR^.GetFieldLineString(AFieldNo, ALineNo)
  end;
  if s = '' then
    exit;
  WriteLine(s);
  inc(AddressLinesWritten);
end;

procedure TTelListPrinter.PrintTelListTelRecord;
begin
  SetCurRecordOffset(NameOffset);
  Printer.Canvas.Font.Style := NameFontStyle;

  if DR <> nil then begin

    Write(DR^.GetFieldLineString(fiteName, 1));
    SetCurRecordOffset(TelOffset);
    WriteLine(DR^.GetFieldLineString(fiteNumber, 1));

    Printer.Canvas.Font.Style := NormalFontStyle;

    SetCurRecordOffset(AddressOffset);
    AddressLinesWritten := 0;
    Printer.Canvas.Font.Size := AddressFontSize;
    Printer.Canvas.Font.Style := AddressFontStyle;

    WriteTelListAddressLine(fiteName, 2);
    WriteTelListAddressLine(fiteAddress, 1);
    WriteTelListAddressLine(fiteAddress, 2);
    WriteTelListAddressLine(fiteFree1, 1);
  end else begin
    Write(XR^.GetFieldLineString(fix5Name, 1));
    SetCurRecordOffset(TelOffset);
    WriteLine(XR^.GetFieldLineString(fiX5Phone1, 1));

    Printer.Canvas.Font.Style := NormalFontStyle;

    SetCurRecordOffset(AddressOffset);
    AddressLinesWritten := 0;
    Printer.Canvas.Font.Size := AddressFontSize;
    Printer.Canvas.Font.Style := AddressFontStyle;

    WriteTelListAddressLine(fiX5Name, 2);
    WriteTelListAddressLine(fiX5Address, 1);
    WriteTelListAddressLine(fiX5Address, 2);
    WriteTelListAddressLine(fiX5Address, 3);

  end;

  Printer.Canvas.Font.Size := NormalFontSize;
  Printer.Canvas.Font.Style := NormalFontStyle;
end;

{
   fibuName = 1;
   fibuEmployer= 2;
   fibuNumber = 3;
   fibuPosition = 4;
   fibuDepartment = 5;
   fibuPOBox = 6;
   fibuAddress = 7;
   fibuTelex = 8;
   fibuFax = 9;
   fibuFree1 = 10;
}

procedure TTelListPrinter.PrintTelListBusinessRecord;
begin
  if DR <> nil then begin
    SetCurRecordOffset(NameOffset);
    Write(DR^.GetFieldLineString(1{fibuName}, 1));

    SetCurRecordOffset(TelOffset);
    WriteLine(DR^.GetFieldLineString(fibuNumber, 1));
    AddressLinesWritten := 0;
    Printer.Canvas.Font.Size := AddressFontSize;
    SetCurRecordOffset(AddressOffset);
    WriteTelListAddressLine(2, 1);
    WriteTelListAddressLine(fibuAddress, 1);
    WriteTelListAddressLine(fibuAddress, 2);
    WriteTelListAddressLine(fibuPOBox, 1);
    Printer.Canvas.Font.Size := NormalFontSize;
  end;
end;

{********************************************************}

{
   fibuName = 1;
   fibuEmployer= 2;
   fibuNumber = 3;
   fibuPosition = 4;
   fibuDepartment = 5;
   fibuPOBox = 6;
   fibuAddress = 7;
   fibuTelex = 8;
   fibuFax = 9;
   fibuFree1 = 10;
}
const
  MMPerInch = 25.4;

procedure TLabelPrinter.SetPaperMargins;
begin
  NaklMargin := round(ppiy * NaklMarginMM / MMPerInch);

  LeftMargin := round(ppix * NaklMarginMM / MMPerInch);
  RightMargin := LeftMargin;

  TopMargin := NaklMargin;
  BottomMargin := NaklMargin;
  Columns := LabelColumns;
end;

procedure TLabelPrinter.SetDefaults;
begin
  inherited SetDefaults;
  RecordColumns := LabelColumns;{globals}
  RecordRows := LabelRows;
  RecordWidth := (PrinterPage.Width - LeftMargin - RightMargin) div RecordColumns;
  if ExactPageSize then
    RecordHeight := (PrinterPage.Height - 2 * NaklMargin) div RecordRows
  else
    RecordHeight := (PrinterPage.Height - TopMargin - BottomMargin) div RecordRows;

  RecordLeftMargin := RecordWidth div 10;{5 * CharWidth;}
  if RecordLeftMargin + LeftMargin < 0 then
    RecordLeftMargin := - LeftMargin;
  RecordTopMargin := RecordHeight div 8;
end;

procedure TLabelPrinter.PrintRecord;
begin
  {$IFDEF SYSLOG}
  syslog.log(slDebug, 'LabelPrinter.PrintRecord begin');
  {$ENDIF}

  while CurY < 0 do
    NextRecord;
  inherited PrintRecord;
  NextRecord;
end;

{*******************************************************}

procedure TEnvelopePrinter.SetDefaults;
begin
  inherited SetDefaults;
  EnvelopeX := round(ppix * EnvelopeXcm / 2.54) - PrinterPage.FixLeftMargin;
  EnvelopeY := round(ppiy * EnvelopeYcm / 2.54) - PrinterPage.FixTopMargin;
end;

procedure TEnvelopePrinter.PrintRecord;
begin
  {$IFDEF SYSLOG}
  syslog.log(slDebug, 'EnvelopePrinter.PrintRecord begin');
  {$ENDIF}

  MoveTo(EnvelopeX, EnvelopeY);
  inherited PrintRecord;
  if RecordsRemainedToPrint > 1 then
    Printer.NewPage;
end;
*)
{********************************************************}

procedure PrintData(const ADataSrcInfo:TDataSrcInfo; AData:PData);
var dp:PDataPrinter;
begin
  dp := New(PDataPrinter, Init(ADataSrcInfo, AData));
  if dp <> nil then begin
    dp^.Print;
    Dispose(dp, Done);
  end;


(*
procedure PrintData(AIW:TForm; PP:PPrintParams);
var dp:PDataPrinter;
begin
  dp := nil;
  if PP = nil then begin
    ErrorBox('Invalid PrintParams');
    exit;
  end;
  case PP^.PrintType of
    prUserDefined: dp := New(PUserPrinter, Init(AIW, PP));
    prTelList: dp := New(PTelListPrinter, Init(AIW, PP));
    prLabels: dp := New(PLabelPrinter, Init(AIW, PP));
    prEnvelopes : dp := New(PEnvelopePrinter, Init(AIW, PP));
  else
    begin
      ErrorBox('Neznámý typ tisku');
      exit;
    end;
  end;
  if dp <> nil then begin
    dp^.Print;
    Dispose(dp, Done);
  end;
end;
*)
end.
