home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d3456 / POWERPDF.ZIP / PowerPdf / PdfGBFonts.pas < prev    next >
Pascal/Delphi Source File  |  2001-09-15  |  6KB  |  216 lines
  1. {*
  2.  * << P o w e r P d f >> -- PdfGBFonts.pas
  3.  *
  4.  * << Japanese font set for Shift-JIS Charactors >>
  5.  *
  6.  * Copyright (c) 1999-1101 Takezou. <takeshi_kanno@est.hi-ho.ne.jp>
  7.  *
  8.  * This library is free software; you can redistribute it and/or modify it
  9.  * under the terms of the GNU Library General Public License as published
  10.  * by the Free Software Foundation; either version 2 of the License, or any
  11.  * later version.
  12.  *
  13.  * This library is distributed in the hope that it will be useful, but WITHOUT
  14.  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  15.  * FOR A PARTICULAR PURPOSE. See the GNU Library general Public License for more
  16.  * details.
  17.  *
  18.  * You should have received a copy of the GNU Library General Public License
  19.  * along with this library.
  20.  *
  21.  * Create 2001.04.14
  22.  *
  23.  *}
  24.  
  25. unit PdfGBFonts;
  26.  
  27. interface
  28.  
  29. uses
  30.   SysUtils, Classes, PdfDoc, PdfTypes, PdfJpFonts;
  31.  
  32. const
  33.   CIDTYPE2_GB_FONT_STR_TABLE: array[0..2] of TPDF_STR_TBL =(
  34.                          (KEY: 'Type'; VAL: 'Font'),
  35.                          (KEY: 'Subtype'; VAL: 'CIDFontType2'),
  36.                          (KEY: 'WinCharSet'; VAL: '128')
  37.                          );
  38.  
  39.   CIDTYPE2_GB_FONT_DEFAULT_WIDTH = 1000;
  40.   CIDTYPE2_GB_FONT_WIDTH_ARRAY: array[0..2] of Integer = (231, 631, 500);
  41.  
  42.   CIDTYPE2_GB_FONT_BBOX: array[0..3] of Integer = (0,-141,1000,859);
  43.  
  44.   CIDTYPE2_GB_FONT_DISC_INT_TABLE: array[0..3] of TPDF_INT_TBL =(
  45.                          (KEY: 'Ascent'; VAL: 859),
  46.                          (KEY: 'CapHeight'; VAL: 859),
  47.                          (KEY: 'Descent'; VAL: -141),
  48.                          (KEY: 'MissingWidth'; VAL: 500)
  49.                          );
  50.  
  51.   TYPE0_GB_FONT_STR_TABLE: array[0..2] of TPDF_STR_TBL =(
  52.                          (KEY: 'Type'; VAL: 'Font'),
  53.                          (KEY: 'Subtype'; VAL: 'Type0'),
  54.                          (KEY: 'Encoding'; VAL: 'GB-EUC-H')
  55.                          );
  56.  
  57. type
  58.   TCharToCMap = function(S: string; Index: integer): integer;
  59.  
  60.   TPdfGBFont = class(TPdfType0Font)
  61.   protected
  62.     procedure AddDescriptorItem(AFontDescriptor: TPdfDictionary); virtual;
  63.     procedure AddDescendantFontItem(ADescendantFont: TPdfDictionary); virtual;
  64.     function GetFontName: string; virtual;
  65.   public
  66.     constructor Create(AXref: TPdfXref; AName: string); override;
  67.   end;
  68.  
  69.   TPdfGBFixedFont = class(TPdfGBFont)
  70.   protected
  71.     procedure AddDescendantFontItem(ADescendantFont: TPdfDictionary); override;
  72.   public
  73.     constructor Create(AXref: TPdfXref; AName: string); override;
  74.   end;
  75.  
  76.   TPdfChinese = class(TPdfGBFixedFont)
  77.   protected
  78.     procedure AddDescriptorItem(AFontDescriptor: TPdfDictionary); override;
  79.     function GetFontName: string; override;
  80.   end;
  81.  
  82. implementation
  83.  
  84. //uses
  85. // PdfGBCMap;
  86.  
  87. { CharToCMap_GB_EUC_H }
  88. function CharToCMap_GB_EUC_H(S: string; Index: integer): integer;
  89. begin
  90.   case ByteType(S, Index) of
  91.     mbSingleByte: result := 0;
  92.     mbLeadByte: result := 0;
  93.     mbTrailByte: result := -1;
  94.   end;
  95. end;
  96.  
  97. { TPdfGBFont }
  98.  
  99. // AddDescriptorItem
  100. procedure TPdfGBFont.AddDescriptorItem(AFontDescriptor: TPdfDictionary);
  101. begin
  102. end;
  103.  
  104. // GetFontName
  105. function TPdfGBFont.GetFontName: string;
  106. begin
  107.   result := '';
  108. end;
  109.  
  110. // .AddDescendantFontItem
  111. procedure TPdfGBFont.AddDescendantFontItem(ADescendantFont: TPdfDictionary);
  112. begin
  113. end;
  114.  
  115. // Create
  116. constructor TPdfGBFont.Create(AXref: TPdfXref; AName: string);
  117. var
  118.   FFontDescriptor: TPdfDictionary;
  119.   FFont: TPdfDictionary;
  120.   FDescendantFont: TPdfDictionary;
  121.   FDescendantFontArray: TPdfArray;
  122.   FCIDSystemInfo: TPdfDictionary;
  123. begin
  124.   inherited Create(AXref, AName);
  125.   FFont := TPdfDictionary.CreateDictionary(AXref);
  126.   AXref.AddObject(FFont);
  127.  
  128.   FFont.AddNameItem('BaseFont', GetFontName);
  129.  
  130.   // create descendant font.
  131.   FDescendantFont := TPdfDictionary.CreateDictionary(AXref);
  132.   AXref.AddObject(FDescendantFont);
  133.  
  134.   FDescendantFontArray := TPdfArray.CreateArray(AXref);
  135.   FDescendantFontArray.AddItem(FDescendantFont);
  136.   FFont.AddItem('DescendantFonts', FDescendantFontArray);
  137.  
  138.   AddStrElements(FDescendantFont, CIDTYPE2_GB_FONT_STR_TABLE);
  139.   FDescendantFont.AddNameItem('BaseFont', GetFontName);
  140.  
  141.   FCIDSystemInfo := TPdfDictionary.CreateDictionary(AXref);
  142.   with FCIDSystemInfo do
  143.   begin
  144.     AddItem('Registry', TPdfText.CreateText('Adobe'));
  145.     AddItem('Ordering', TPdfText.CreateText('GB1'));
  146.     AddItem('Supplement', TPdfNumber.CreateNumber(2));
  147.   end;
  148.  
  149.   with FDescendantFont do
  150.   begin
  151.     AddItem('CIDSystemInfo', FCIDSystemInfo);
  152.     AddNumberItem('DW', CIDTYPE2_GB_FONT_DEFAULT_WIDTH);
  153.   end;
  154.   AddDescendantFontItem(FDescendantFont);
  155.  
  156.   // create font descriptor.
  157.   FFontDescriptor := TPdfDictionary.CreateDictionary(AXref);
  158.   AXref.AddObject(FFontDescriptor);
  159.  
  160.   FFontDescriptor.AddNameItem('Type', 'FontDescriptor');
  161.   FFontDescriptor.AddNameItem('BaseFont', GetFontName);
  162.   AddIntElements(FFontDescriptor, CIDTYPE2_GB_FONT_DISC_INT_TABLE);
  163.   AddDescriptorItem(FFontDescriptor);
  164.   FFontDescriptor.AddItem('FontBBox',
  165.              TPdfArray.CreateNumArray(AXref, CIDTYPE2_GB_FONT_BBOX));
  166.   FDescendantFont.AddItem('FontDescriptor', FFontDescriptor);
  167.  
  168.   SetData(FFont);
  169. end;
  170.  
  171. // AddDescendantFontItem
  172. procedure TPdfGBFixedFont.AddDescendantFontItem(ADescendantFont: TPdfDictionary);
  173. var
  174.   FWidths: TPdfArray;
  175. begin
  176.   FWidths := TPdfArray.CreateNumArray(nil, CIDTYPE2_GB_FONT_WIDTH_ARRAY);
  177.   ADescendantFont.AddItem('W', FWidths);
  178. end;
  179.  
  180. constructor TPdfGBFixedFont.Create(AXref: TPdfXref; AName: string);
  181. begin
  182.   inherited Create(AXref, AName);
  183.   AddStrElements(Data, TYPE0_GB_FONT_STR_TABLE);
  184.   SetCharToCMap(@CharToCMap_GB_EUC_H);
  185. end;
  186.  
  187. { TPdfGothic }
  188. procedure TPdfChinese.AddDescriptorItem(AFontDescriptor: TPdfDictionary);
  189. var
  190.   Flags: integer;
  191. begin
  192.   with AFontDescriptor do
  193.   begin
  194.     Flags := PDF_FONT_SYMBOLIC +
  195.              PDF_FONT_FIXED_WIDTH;
  196.     AddNumberItem('Flags', Flags);
  197.     AddNumberItem('ItalicAngle', 0);
  198.     AddNumberItem('StemV', 78);
  199.   end;
  200. end;
  201.  
  202. function TPdfChinese.GetFontName: string;
  203. begin
  204.   result := 'Chinese';
  205. end;
  206.  
  207. initialization
  208.  
  209.   RegisterClassAlias(TPdfChinese, 'Chinese');
  210.  
  211.   finalization
  212.  
  213.   UnRegisterClass(TPdfChinese);
  214.  
  215. end.
  216.