Распечатать 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;