TOPIC:

//***
Uses
 LCLIntf, LCLType, LCLProc,
 LR_Class, LResources,
 Windows, SysUtils, Classes, Clipbrd,StdCtrls,
 Controls, Forms, Dialogs, ExtCtrls,
 Buttons, Menus,
 sqlite3dyn, sqlite3conn, sqldb, db, DbCtrls, DBGrids,
 DateUtils, FileUtil,
 Variants, Printers, OSPrinters, RTTICtrls,
 IntfGraphics, GraphType, Graphics, Types;
//***
procedure TFviewer.PrintForm(centredOnPage: boolean; anOrientation: TPrinterOrientation);
var
   VARmyBitMap: TBitMap;
   VARprnBmp: TBitmap;
   VARprnRct: TRect;
   VARHScaleFactor: Single;
   VARVScaleFactor: Single;
   VARaLeft: Integer;
   VARaTop: Integer;
   VARaSize: TSize;
begin
Try
  VARHScaleFactor:=Printer.XDPI/Screen.PixelsPerInch;
  VARVScaleFactor:=Printer.YDPI/Screen.PixelsPerInch;
  VARmyBitMap:= TBitMap.Create;
  VARprnBmp:=TBitmap.Create;
  try
    Printer.Orientation:=anOrientation;
    VARmyBitMap.LoadFromDevice(Canvas.Handle);
    VARprnBmp.SetSize(trunc(VARmyBitMap.Width*VARHScaleFactor),
                   trunc(VARmyBitMap.Height*VARVScaleFactor));
    VARprnRct:=Rect(0, 0, VARprnBmp.Width, VARprnBmp.Height);
    VARprnBmp.Canvas.StretchDraw(VARprnRct, VARmyBitMap);
    if centredOnPage then
    begin
       VARaSize:=Size(Printer.PaperSize.PaperRect.WorkRect);
       case Printer.Orientation of
         poPortrait: begin
                       VARaLeft:=(VARaSize.cx - VARprnBmp.Width) div 2;
                       VARaTop:=(VARaSize.cy - VARprnBmp.Height) div 2;
                     end;
         poLandscape: begin
                        VARaTop:=(VARaSize.cy - VARprnBmp.Height) div 2;
                        VARaLeft:=(VARaSize.cx - VARprnBmp.Width) div 2;
                      end;
       end;
    end
    else
    begin
      VARaLeft:=0;
      VARaTop:=0;
    end;
    Printer.BeginDoc;
    try
      Printer.Canvas.Draw(VARaLeft, VARaTop, VARprnBmp);
    finally
      Printer.EndDoc;
    end;
  finally
    VARmyBitMap.Free;
    VARprnBmp.Free;
  end;
except On E: Exception do
  Begin
    QuestionDlg('Error', ' ! ! ! '+#13+
    '' +#13+ '' +#13+#13+ 'ERROR: '+ E.Message, mtError, [mrOk, 'DRUK HIER  <--- '], '');
  end;
end;
end;
//***
procedure TFviewer.BitBtnPRINTClick(Sender: TObject);
begin
     PanelbtnVIEWER.Visible:=False;
     Screen.cursor := crHourGlass;
     Application.ProcessMessages;
     Sleep(1000);
     PrintForm(True, poPortrait);
     //PrintForm(True, poLandscape);
     Screen.Cursor := crDefault;
     Application.ProcessMessages;
     PanelbtnVIEWER.Visible:=True;
end;
//***