AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Problem mit schriftgröße

Ein Thema von Natcree · begonnen am 16. Okt 2014 · letzter Beitrag vom 17. Okt 2014
 
Bjoerk

Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
 
Delphi 10.4 Sydney
 
#6

AW: Problem mit schriftgröße

  Alt 17. Okt 2014, 12:25
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: info@roledata.com
// 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.
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:41 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz