mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-02 00:23:38 +02:00
53 lines
978 B
ObjectPascal
53 lines
978 B
ObjectPascal
{
|
|
*****************************************************************************
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
|
|
Authors: Alexander Klenin
|
|
|
|
}
|
|
unit TAPrint;
|
|
|
|
{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Printers, TADrawerCanvas;
|
|
|
|
type
|
|
|
|
{ TPrinterDrawer }
|
|
|
|
TPrinterDrawer = class(TCanvasDrawer)
|
|
private
|
|
FPrinter: TPrinter;
|
|
FCoeff: Double;
|
|
public
|
|
constructor Create(APrinter: TPrinter);
|
|
function Scale(ADistance: Integer): Integer; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Forms, Math;
|
|
|
|
{ TPrinterDrawer }
|
|
|
|
constructor TPrinterDrawer.Create(APrinter: TPrinter);
|
|
begin
|
|
FPrinter := APrinter;
|
|
inherited Create(FPrinter.Canvas);
|
|
FCoeff := Max(FPrinter.XDPI, FPrinter.YDPI) / Screen.PixelsPerInch;
|
|
end;
|
|
|
|
function TPrinterDrawer.Scale(ADistance: Integer): Integer;
|
|
begin
|
|
Result := Round(ADistance * FCoeff);
|
|
end;
|
|
|
|
end.
|
|
|