Problem mit schriftgröße

[Bjoerk]

Wenn ich’s richtig aufgedröselt hab dann isses so. Ob das ganze belastbar ist weiß ich nicht recht, aber jedenfalls stimmen so mal DeviceCaps mit RoleDeviceCaps und PageWidth/ PageHeight mit RolePDFPageWidth/RolePDFPageHeight überein. Man müßte halt an die dll ran..

Notlösung:

Delphi-Quellcode:

// TRolePDF
// A freeware VCL component for use with pdf.dll
// author: mohab elsherif
// email: [e-mail]
// version 1.16
// license: as is, without any kind of warrantee.

// Added 2014 ("Bjoerk"): PixelsPerInch = DeviceCaps; ???

unit pdfhdr;

interface

uses
  Windows, SysUtils, Dialogs, Classes, Graphics, ShellAPI;

type
  TPageSize = (psCustom, psA4, psLetter, psLegal);
  TPageOrientation = (poPortrait, poLandscape);

  TRolePDF = class
  private
    FFileName: string;
    FAuthor: string;
    FTitle: string;
    FSubject: string;
    FKeywords: string;
    FCreator: string;
    FPageWidth: integer;
    FPageHeight: integer;
    FPixelsPerInch: integer;
    FAutoLaunch: boolean;
    FPageSize: TPageSize;
    FOrientation: TPageOrientation;
    FCanvas: TCanvas;
    function GetCanvas: TCanvas;
    function GetPageCount: integer;
    function GetPageWidth: integer;
    function GetPageHeight: integer;
    function DeviceCaps: integer;
    procedure SetPageSize(Value: TPageSize);
    procedure SetOrientation(Value: TPageOrientation);
  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 PageSize: TPageSize read FPageSize write SetPageSize;
    property PageWidth: integer read GetPageWidth write FPageWidth;
    property PageHeight: integer read GetPageHeight write FPageHeight;
    property Orientation: TPageOrientation read FOrientation write SetOrientation;
    property AutoLaunch: boolean read FAutoLaunch write FAutoLaunch;
    property PixelsPerInch: integer read FPixelsPerInch;
    constructor Create;
    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;

function RolePDFAddOutline(Title: PChar; ParentID, PageNo, Top: integer): integer;
  stdcall; external cPdfDll;

constructor TRolePDF.Create;
begin
  inherited Create;
  FCanvas := TCanvas.Create;
  FCanvas.Font.Charset := ANSI_CHARSET;
  FPixelsPerInch := DeviceCaps;
  FAutoLaunch := true;
  SetPageSize(psA4);
end;

destructor TRolePDF.Destroy;
begin
  FCanvas.Free;
  inherited Destroy;
end;

procedure Exchange(var A, B: integer);
var
  C: integer;
begin
  C := A;
  A := B;
  B := C;
end;

procedure TRolePDF.SetOrientation(Value: TPageOrientation);
begin
  FOrientation := Value;
  if FOrientation = poPortrait then
  begin
    if FPageWidth > FPageHeight then
      Exchange(FPageWidth, FPageWidth);
  end
  else
  begin
    if FPageWidth < FPageHeight then
      Exchange(FPageWidth, FPageWidth);
  end;
end;

procedure TRolePDF.SetPageSize(Value: TPageSize);
begin
  FPageSize := Value;
  case Value of
    psA4:
    begin
      FPageWidth := Round(210 * FPixelsPerInch / 25.4);
      FPageHeight := Round(297 * FPixelsPerInch / 25.4);
    end;
    psLetter:
    begin
      FPageWidth := Round(8.5 * FPixelsPerInch);
      FPageHeight := Round(11 * FPixelsPerInch);
    end;
    psLegal:
    begin
      FPageWidth := Round(8.5 * FPixelsPerInch);
      FPageHeight := Round(14 * FPixelsPerInch);
    end;
  end;
end;

procedure TRolePDF.BeginDoc;
begin
  RolePDFBeginDoc(PChar(''), PChar(FFileName), PChar(FTitle), PChar(FAuthor),
    PChar(FSubject), PChar(FKeywords), PChar(FCreator),
    Round(cPdfDllPixelsPerInch / FPixelsPerInch * FPageWidth),
    Round(cPdfDllPixelsPerInch / FPixelsPerInch * FPageHeight));
end;

procedure TRolePDF.NewPage;
begin
  RolePDFNewPage;
end;

procedure TRolePDF.EndDoc;
begin
  RolePDFEndDoc;
  if FAutoLaunch then
    ShellExecute(0, 'open', PChar(FFileName), nil, nil, SW_SHOW);
end;

function TRolePDF.GetCanvas: TCanvas;
begin
  FCanvas.Handle := RolePDFGetDC;
  Result := FCanvas;
end;

function TRolePDF.DeviceCaps: integer;
var
  DC: HDC;
begin
  DC := GetDC(0);
  try
    Result := GetDeviceCaps(DC, LOGPIXELSX);
  finally
    ReleaseDC(0, DC);
  end;
end;

function TRolePDF.GetPageCount: integer;
begin
  Result := RolePDFPageCount;
end;

function TRolePDF.GetPageWidth: integer;
begin
  Result := RolePDFPageWidth;
  if Result = 0 then
    Result := MulDiv(FPageWidth, DeviceCaps, FPixelsPerInch);
end;

function TRolePDF.GetPageHeight: integer;
begin
  Result := RolePDFPageHeight;
  if Result = 0 then
    Result := MulDiv(FPageHeight, DeviceCaps, FPixelsPerInch);
end;

function TRolePDF.MMToPixel(const MMX, MMY: double): TPoint;
begin
  Result.X := Round(FPixelsPerInch * MMX / 25.4);
  Result.Y := Round(FPixelsPerInch * MMY / 25.4);
end;

end.