unit uPdf;
interface
uses
Windows, SysUtils, Dialogs, Graphics, Math, ShellAPI;
type
TDinAFormat = (DinAPortrait0, DinALandscape0,
DinAPortrait1, DinALandscape1,
DinAPortrait2, DinALandscape2,
DinAPortrait3, DinALandscape3,
DinAPortrait4, DinALandscape4);
TDinAPage =
record
private
FMMHeight: integer;
FMMWidth: integer;
FDinAFormat: TDinAFormat;
function GetLandscape: boolean;
procedure SetDinAFormat(
const Value: TDinAFormat);
public
property Landscape: boolean
read GetLandscape;
property MMHeight: integer
read FMMHeight;
property MMWidth: integer
read FMMWidth;
property DinAFormat: TDinAFormat
read FDinAFormat
write SetDinAFormat;
end;
TPdf =
class
private
FFileName:
string;
FAuthor:
string;
FTitle:
string;
FSubject:
string;
FKeywords:
string;
FCreator:
string;
FPixelsPerInch: integer;
FAutoLaunch: boolean;
FCanvas: TCanvas;
FDinAPage: TDinAPage;
function GetCanvas: TCanvas;
function GetPageCount: integer;
function GetPageWidth: integer;
function GetPageHeight: integer;
function GetPdfPageWidth: integer;
function GetPdfPageHeight: integer;
function GetMMWidth: double;
function GetMMHeight: double;
function GetDinAFormat: TDinAFormat;
function DeviceCaps: integer;
public
procedure BeginDoc;
procedure NewPage;
procedure EndDoc;
function MMToPixel(
const MMX, MMY: double): TPoint;
property Canvas: TCanvas
read GetCanvas;
property FileName:
string read FFileName
write FFileName;
property Author:
string read FAuthor
write FAuthor;
property Title:
string read FTitle
write FTitle;
property Subject:
string read FSubject
write FSubject;
property Keywords:
string read FKeywords
write FKeywords;
property Creator:
string read FCreator
write FCreator;
property PageCount: integer
read GetPageCount;
property PageWidth: integer
read GetPageWidth;
property PageHeight: integer
read GetPageHeight;
property PdfPageWidth: integer
read GetPdfPageWidth;
property PdfPageHeight: integer
read GetPdfPageHeight;
property MMWidth: double
read GetMMWidth;
property MMHeight: double
read GetMMHeight;
property AutoLaunch: boolean
read FAutoLaunch
write FAutoLaunch;
property DinAFormat: TDinAFormat
read GetDinAFormat;
property PixelsPerInch: integer
read FPixelsPerInch;
constructor Create(
const DinAFormat: TDinAFormat);
destructor Destroy;
override;
end;
implementation
const
cPdfDllPixelsPerInch = 72;
cPdfDll = '
pdf.dll';
procedure RolePDFBeginDoc(License, FileName, Title, Author, Subject, Keywords, Creator: PChar;
PageWidth, PageHeight: integer);
stdcall;
external cPdfDll;
procedure RolePDFNewPage;
stdcall;
external cPdfDll;
procedure RolePDFEndDoc;
stdcall;
external cPdfDll;
function RolePDFGetDC: HDC;
stdcall;
external cPdfDll;
function RolePDFPageCount: integer;
stdcall;
external cPdfDll;
function RolePDFPageWidth: integer;
stdcall;
external cPdfDll;
function RolePDFPageHeight: integer;
stdcall;
external cPdfDll;
{ TDinAPage }
function TDinAPage.GetLandscape: boolean;
begin
Result := FDinAFormat
in [DinALandscape0, DinALandscape1, DinALandscape2,
DinALandscape3, DinALandscape4];
end;
procedure TDinAPage.SetDinAFormat(
const Value: TDinAFormat);
var
X, Y: integer;
begin
FDinAFormat := Value;
case FDinAFormat
of
DinAPortrait3, DinALandscape3:
begin
X := 297;
Y := 2 * 210;
end;
DinAPortrait2, DinALandscape2:
begin
X := 2 * 210;
Y := 2 * 297;
end;
DinAPortrait1, DinALandscape1:
begin
X := 2 * 297;
Y := 4 * 210;
end;
DinAPortrait0, DinALandscape0:
begin
X := 4 * 210;
Y := 4 * 297;
end
else // DinAPortrait4, DinALandscape4:
begin
X := 210;
Y := 297;
end;
end;
if Landscape
then
begin
FMMWidth := Max(X, Y);
FMMHeight := Min(X, Y);
end
else
begin
FMMWidth := Min(X, Y);
FMMHeight := Max(X, Y);
end;
end;
{ TPdf }
constructor TPdf.Create(
const DinAFormat: TDinAFormat);
begin
FCanvas := TCanvas.Create;
FCanvas.Font.Charset := ANSI_CHARSET;
FPixelsPerInch := DeviceCaps;
FAutoLaunch := true;
FDinAPage.DinAFormat := DinAFormat;
end;
destructor TPdf.Destroy;
begin
FCanvas.Free;
inherited;
end;
function TPdf.GetPageWidth: integer;
begin
Result := Round(FPixelsPerInch / 25.4 * FDinAPage.MMWidth);
end;
function TPdf.GetPageHeight: integer;
begin
Result := Round(FPixelsPerInch / 25.4 * FDinAPage.MMHeight);
end;
function TPdf.GetMMWidth: double;
begin
Result := FDinAPage.MMWidth;
end;
function TPdf.GetMMHeight: double;
begin
Result := FDinAPage.MMHeight;
end;
function TPdf.GetDinAFormat: TDinAFormat;
begin
Result := FDinAPage.DinAFormat;
end;
function TPDF.DeviceCaps: integer;
var
DC: HDC;
begin
DC := GetDC(0);
try
Result := GetDeviceCaps(
DC, LOGPIXELSX);
finally
ReleaseDC(0,
DC);
end;
end;
procedure TPdf.BeginDoc;
begin
RolePDFBeginDoc(PChar('
'), PChar(FFileName), PChar(FTitle), PChar(FAuthor),
PChar(FSubject), PChar(FKeywords), PChar(FCreator),
Round(cPdfDllPixelsPerInch / FPixelsPerInch * PageWidth),
Round(cPdfDllPixelsPerInch / FPixelsPerInch * PageHeight));
end;
procedure TPdf.NewPage;
begin
RolePDFNewPage;
end;
procedure TPdf.EndDoc;
begin
RolePDFEndDoc;
if FAutoLaunch
then
ShellExecute(0, '
open', PChar(FFileName),
nil,
nil, SW_SHOW);
end;
function TPdf.GetCanvas: TCanvas;
begin
FCanvas.Handle := RolePDFGetDC;
Result := FCanvas;
end;
function TPdf.GetPageCount: integer;
begin
Result := RolePDFPageCount;
end;
function TPdf.GetPdfPageWidth: integer;
begin
Result := RolePDFPageWidth;
end;
function TPdf.GetPdfPageHeight: integer;
begin
Result := RolePDFPageHeight;
end;
function TPdf.MMToPixel(
const MMX, MMY: double): TPoint;
begin
Result.X := Round(FPixelsPerInch * MMX / 25.4);
Result.Y := Round(FPixelsPerInch * MMY / 25.4);
end;
end.