Adobe Reader einbinden

[Bjoerk]

Zitat von idefix2:

Danke, ich glaube, das werde ich auch noch brauchen können.
Einen Fehler solltest du ausbessern [..]

Kann sein. Hatte das damals so auf die Schnelle gemacht. Bevor ich aber was in meine Software einbaue schau ich für gewöhnlich nochmal drüber. Hier, wie ich es schließlich implementiert hab.

Delphi-Quellcode:

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.