TXTファイルをPDFファイルへ変換する(Delphi)
TXTファイルをPDFファイルへ変換する事のできるDelphiのソースコードです。クラスになっていますのでそのまま使用できます
ソースコード
10年以上前に作成した古いコードで私すら覚えていないのですが、何かのお役に立てると嬉しいです。
(* -------------- Support Japanese charcode "ShiftJIS" Only! -----------------*)
unit txt2pdf;
interface
uses
Windows,Classes, Graphics, SysUtils;
procedure TXTtoPDF(OpenName,SaveName:String);
implementation
// ---------------------------
// A3 842x1191 297x420mm
// A4 595x842 210x297mm
// A5 420x595 148x210mm
// B4 729x1032 257x364mm
// B5 516x729 182x257mm
// ---------------------------
const
m_PageWidth = 595; // 用紙の横サイズ
m_PageHeight = 842; // 用紙の縦サイズ
m_MarginX = 30; // 余白 (← →)
m_MarginY = 30; // 余白 (↑ ↓)
m_FontSize = 12; // フォントのサイズ (1-100ぐらいまで)
m_FontName = 'F0'; // フォントの変数名
m_FontEncoding = '90ms-RKSJ-H'; // フォントのエンコーディング
m_FontWidth = '231 389 500 631 631 500'; // 1byteフォントの幅
type
pDword =^Dword;
type
pDwordArray = ^TDwordArray ;
TDwordArray = array[0..1234] of Dword;
{ TPDFObjMemManager }
type
TPDFObjMemManager = class(TPersistent)
private
Buffer : Pointer;
FObjectCount : Dword;
FReallocCount: Dword;
function GetSize():Dword;
public
ObjectIndex : Dword;
ObjectPosArray : pDwordArray;
constructor Create(ObjectCount,ReallocCount :Dword);
destructor Destroy;override;
procedure MemoryCheck();
property MemorySize :Dword read GetSize;
end;
////////////////////////////////////////////////////////////////////////////////
{ TPDFObjMemManager }
constructor TPDFObjMemManager.Create(ObjectCount,ReallocCount :Dword);
begin
inherited Create;
if (ObjectCount=0) or (ReallocCount= 0) then
raise EInvalidOperation.Create('初期サイズは0にはできません。');
FObjectCount :=ObjectCount;
FReallocCount :=ReallocCount;
GetMem(buffer,FObjectCount*SizeOf(TDwordArray));
ObjectPosArray :=buffer;
if Buffer=nil then
raise EOutOfMemory.Create('メモリが不足しています。');
end;
destructor TPDFObjMemManager.Destroy;
begin
FreeMem(Buffer,FObjectCount*SizeOf(SizeOf(TDwordArray)));
inherited Destroy;
end;
function TPDFObjMemManager.GetSize():Dword;
begin
Result:=FObjectCount* SizeOf(TDwordArray);
end;
procedure TPDFObjMemManager.MemoryCheck();
begin
// メモリの再編成
if ObjectIndex >= FObjectCount then
begin
FObjectCount:=FObjectCount+FReallocCount;
ReallocMem(Buffer,FObjectCount*SizeOf(TDwordArray));
if Buffer=nil then
raise EOutOfMemory.Create('メモリが不足しています。');
// ポインタのアドレスが変更される場合があるので再割り当て
ObjectPosArray := buffer;
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure Write_CrossReferenceTable(AStream: TStream;ObjectPosArray : pDwordArray;Count:Integer);
Var
i :Integer;
begin
With TStringStream(AStream) do
begin
WriteString('xref'#10);
WriteString(Format('0 %d'#10,[Count+1]));
WriteString('0000000000 65535 f '#10);
for i:= 0 to Count-1 do
begin
WriteString(Format('%0.10d',[ObjectPosArray[i]])+' 00000 n '#10);
end;
end;
end;
procedure DrawText(AStream: TStream;x,y:Integer;Lines :TStringList);
function AsciiHexEncoding(Buffer :PByteArray;Size: Dword):String;
Var
i : integer;
begin
TStringStream(AStream).WriteString('<');
for i:= 0 to size-1 do
TStringStream(AStream).WriteString(IntToHex(Buffer[i],2));
TStringStream(AStream).WriteString('>');
end;
Var
i : Dword;
Matrix : Single;
begin
if Lines.Text='' then Exit;
y := m_PageHeight - y;
Matrix :=y - m_FontSize*0.87;
With TStringStream(AStream) do
begin
WriteString('BT'#10);
WriteString(Format('/%s %d Tf'#10,[m_FontName,m_FontSize]));
WriteString(Format('0 0 0 rg %d TL %d %f Td ',[m_FontSize,x,Matrix]));
AsciiHexEncoding(PByteArray(Lines[0]),Length(Lines[0]));
WriteString(' Tj'#10);
if Lines.Count<> 1 then
begin
for i:= 1 to Lines.Count -1 do
begin
WriteString('T* ');
AsciiHexEncoding(PByteArray(Lines[i]),Length(Lines[i]));
WriteString(' Tj'#10);
end;
end;
WriteString('ET'#10);
end;
end;
procedure AutoLineFeed(var Lines : TStringList);
function GetTextWidth(S:String):Integer;
begin
Result:=(Length(S)* (m_FontSize div 2));
end;
var
P : Pchar;
S : String;
i,MaxWidth : integer;
StringList : TStringList;
begin
MaxWidth:=m_PageWidth-m_MarginX*2;
StringList :=TStringList.Create;
try
for i:= 0 to Lines.Count-1 do
begin
// テキストがページの描画範囲を越える場合は改行する
if GetTextWidth(Lines[i]) > MaxWidth then
begin
S :='';
P :=Pchar(Lines[i]);
While not (P^=#0) do
begin
// Sjis漢字コード
if Byte(P^) in [$81..$9F,$E0..$FC] then
begin
S :=S+P^; inc(P);
S :=S+P^;
if GetTextWidth(S) > MaxWidth-(m_FontSize) then
begin
StringList.Add(S);
S :='';
end;
if P^=#0 then break;
end
// Ascii + 半角カタカナなど
else
begin
S :=S+P^;
if GetTextWidth(S) > MaxWidth-(m_FontSize div 2) then
begin
StringList.Add(S);
S :='';
end;
end;
Inc(P);
end;
if S<>'' then
StringList.Add(S);
end
else
StringList.Add(Lines[i]);
end;
Lines.Text:= StringList.Text;
finally
StringList.free;
end;
end;
procedure Write_PageObject(AStream: TStream;ObjectMem :TPDFObjMemManager; Lines,PageList : TStringList);
Var
PageText :TStringList;
i,j,k,Pages,Streamsize,MaxHeight,PageRows : integer;
begin
PageText := TStringList.Create;
try
// テキストの自動整形
AutoLineFeed(Lines);
// 1ページで描画可能なサイズ
MaxHeight:=m_PageHeight-m_MarginY*2;
// 1ページに入る配列数
PageRows:=Lines.count;
for i:= 1 to Lines.count do
begin
if MaxHeight <= i * m_FontSize then
begin
PageRows:=i-1;
break;
end
end;
// ページ数の計算
if Lines.Count<>0 then
begin
Pages := (Lines.Count div PageRows);
if (Lines.Count-PageRows)<>0 then
Inc(Pages);
end
else
Pages:=1;
k:=0;
for i :=0 to Pages-1 do
begin
// 1ページ分の配列を受け取る
PageText.Text:='';
for j:= 0 to PageRows-1 do
begin
if k >=Lines.Count then break;
PageText.Add(Lines[k]);
Inc(k);
end;
// Kids Page
PageList.Add(Inttostr(ObjectMem.ObjectIndex+1));
ObjectMem.ObjectPosArray[ObjectMem.ObjectIndex] :=AStream.Position;
With TStringStream(AStream) do
begin
WriteString(Format('%d 0 obj'#10,[ObjectMem.ObjectIndex+1]));
WriteString('<<'#10);
WriteString('/Type /Page'#10);
WriteString('/Parent 2 0 R'#10);
WriteString('/Resources'#10);
WriteString('<<'#10);
WriteString(Format('/Font << /%s 3 0 R >>'#10,[m_FontName]));
WriteString('/ProcSet [ /PDF /Text ]'#10);
WriteString('>>'#10);
WriteString(Format('/MediaBox [ 0 0 %d %d ]'#10, [m_PageWidth,m_PageHeight]));
WriteString(Format('/Contents %d 0 R'#10,[ObjectMem.ObjectIndex+2]));
WriteString('>>'#10);
WriteString('endobj'#10);
end;
Inc(ObjectMem.ObjectIndex);
ObjectMem.MemoryCheck;
// Contents Object
ObjectMem.ObjectPosArray[ObjectMem.ObjectIndex] :=AStream.Position;
With TStringStream(AStream) do
begin
WriteString(Format('%d 0 obj'#10,[ObjectMem.ObjectIndex+1]));
WriteString(Format('<< /Length %d 0 R >>'#10,[ObjectMem.ObjectIndex+2]));
WriteString('stream'#10);
// stream
Streamsize := AStream.Position;
DrawText(AStream,m_MarginX,m_MarginY,PageText);
Streamsize := ASTream.Position-Streamsize;
WriteString('endstream'#10);
WriteString('endobj'#10);
end;
Inc(ObjectMem.ObjectIndex);
ObjectMem.MemoryCheck;
// Length Object
ObjectMem.ObjectPosArray[ObjectMem.ObjectIndex] :=AStream.Position;
With TStringStream(AStream) do
begin
WriteString(Format('%d 0 obj'#10,[ObjectMem.ObjectIndex+1]));
WriteString(Format('%d'#10,[Streamsize]));
WriteString('endobj'#10);
end;
Inc(ObjectMem.ObjectIndex);
ObjectMem.MemoryCheck;
end;
finally
PageText.Free;
end;
end;
procedure TXTtoPDF(OpenName,SaveName:String);
Var
i :integer;
AStream : TStream;
ObjectMem : TPDFObjMemManager;
PageList,StringList : TStringList;
begin
if OpenName='' then
raise Exception.Create('OpenName is Empty');
if SaveName='' then
raise Exception.Create('SaveName is Empty');
AStream :=TFileStream.Create(SaveName,fmCreate) ;
PageList :=TStringList.Create;
StringList :=TStringList.Create;
ObjectMem :=TPDFObjMemManager.Create(1000,1000);
Try
// ファイルの読み込み
StringList.LoadFromFile(OpenName);
// 最初のヘッダ部分は後で書き込む
ObjectMem.ObjectIndex:=ObjectMem.ObjectIndex+2;
// PDF version
TStringStream(AStream).WriteString('%PDF-1.2'#10);
// Font Resource
ObjectMem.ObjectPosArray[ObjectMem.ObjectIndex] :=AStream.Position;
With TStringStream(AStream) do
begin
WriteString(Format('%d 0 obj'#10,[ObjectMem.ObjectIndex+1]));
WriteString('<<'#10);
WriteString('/Type /Font'#10);
WriteString(Format('/Name /%s'#10,[m_FontName]));
WriteString(Format('/BaseFont /HeiseiKakuGo-W5-%s'#10,[m_FontEncoding]));
WriteString('/Subtype /Type0'#10);
WriteString(Format('/Encoding /%s'#10,[m_FontEncoding]));
WriteString('/DescendantFonts [ << /Type /Font /Subtype /CIDFontType0 /BaseFont /HeiseiKakuGo-W5'#10);
WriteString('/FontDescriptor << /Type /FontDescriptor /FontName /HeiseiKakuGo-W5 /ItalicAngle 0 /FontBBox [ -92 -250 1010 922 ]'#10);
WriteString('/Style << /Panose <');
WriteString('0801020B0600000000000000');
WriteString('>>> /Ascent 752 /CapHeight 737 /Descent -221'#10);
WriteString('/Flags 4 /StemV 114 /XHeight 553 >>'#10);
WriteString('/CIDSystemInfo << /Registry (Adobe)/Ordering (Japan1)/Supplement 2 >>'#10);
WriteString(Format('/DW 1000 /W [ %s ] >>'#10,[m_FontWidth]));
WriteString(']'#10);
WriteString('>>'#10);
WriteString('endobj'#10);
end;
Inc(ObjectMem.ObjectIndex);
ObjectMem.MemoryCheck;
// Write Page
Write_PageObject(AStream,ObjectMem,StringList,PageList);
// Catalog
ObjectMem.ObjectPosArray[0] :=AStream.Position;
With TStringStream(AStream) do
begin
WriteString('1 0 obj'#10);
WriteString('<<'#10);
WriteString('/Type /Catalog'#10);
WriteString('/Pages 2 0 R'#10);
WriteString('>>'#10);
WriteString('endobj'#10);
end;
// Parent Pages
ObjectMem.ObjectPosArray[1] :=AStream.Position;
With TStringStream(AStream) do
begin
WriteString('2 0 obj'#10);
WriteString('<<'#10);
WriteString('/Type /Pages'#10);
// Kids Pages
WriteString('/Kids [');
for i:= 0 to PageList.Count-1 do
begin
WriteString(Format(' %s 0 R',[PageList[i]]));
end;
WriteString(' ]'#10);
WriteString(Format('/Count %d'#10,[PageList.Count]));
WriteString('>>'#10);
WriteString('endobj'#10);
end;
// CrossReferenceTable
ObjectMem.ObjectPosArray[ObjectMem.ObjectIndex] :=AStream.Position;
Write_CrossReferenceTable(AStream,ObjectMem.ObjectPosArray,ObjectMem.ObjectIndex);
// trailer
With TStringStream(AStream) do
begin
WriteString('trailer'#10);
WriteString('<<'#10);
WriteString(Format('/Size %d'#10,[ObjectMem.ObjectIndex+1]));
WriteString('/Root 1 0 R'#10);
WriteString('>>'#10);
WriteString('startxref'#10);
WriteString(Format('%d'#10,[ObjectMem.ObjectPosArray[ObjectMem.ObjectIndex]]));
WriteString('%%EOF');
end;
finally
AStream.Free;
PageList.free;
StringList.free;
ObjectMem.free;
end;
end;
end.
スポンサーリンク
関連記事
公開日：2015年01月08日 最終更新日：2015年02月18日
記事NO：00093
