БОЛЬШОЙ FAQ ПО DELPHI



Распечатать TStrings на принтере по умолчанию


 procedure PrintStrings(S: TStrings; Font: TFont; Title: string);
 var
  LeftMargin, TopMargin, LineCoord, LineOnPage, LinesOnDoc,
  CurrentLine, TextHeight, LinesPerPage, LineInterval: integer;
 
  procedure StartDoc;
  begin
    LinesOnDoc := S.Count;
    Printer.Canvas.Font.Assign(Font);
    Printer.Canvas.TextOut(0, 0, ' ');
    LeftMargin := (Printer.Canvas.Font.PixelsPerInch) div 2;
    TopMargin  := (Printer.Canvas.Font.PixelsPerInch) div 2;
    TextHeight := Abs(Printer.Canvas.Font.Height);
    LineInterval := TextHeight + (TextHeight div 2);
    LinesPerPage := (Printer.PageHeight - TopMargin) div LineInterval;
    CurrentLine := 0;
  end;
 
  function MorePages:boolean;
  begin
    Result := (CurrentLine <  LinesOnDoc) and
              not Printer.Aborted;
  end;
 
  procedure StartPage;
  begin
    LineOnPage := 0;
    LineCoord := TopMargin;
  end;
 
  procedure NextPage;
  begin
    if MorePages then Printer.NewPage;
  end;
 
  function MoreLines:boolean;
  begin
    Result := (LineOnPage <  LinesPerPage) and
              (LineOnPage <  LinesOnDoc) and
              not Printer.Aborted;
  end;
 
  procedure NextLine;
  begin
    Inc(LineOnPage);
    Inc(LineCoord, LineInterval);
    Inc(CurrentLine);
  end;
 
  procedure PrintLine;
  begin
    Printer.Canvas.TextOut(LeftMargin, LineCoord, S.Strings[CurrentLine]);
  end;
 
 begin
  Printer.Title := Title;
  Printer.BeginDoc;
  StartDoc;
  while MorePages do
  begin
    StartPage;
    while MoreLines do
    begin
      PrintLine;
      NextLine;
      Application.ProcessMessages;
    end;
    NextPage;
  end;
  Printer.EndDoc;
 end;
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Видеокурс ВЗЛОМ