CREATE OR REPLACE PACKAGE BODY pdfgen_pkg AS /******************************************************************************* * Logiciel : PL_FPDF * * Version : 0.9.4 * * Date : 13/06/2006 * * Auteur : Pierre-Gilles Levallois * * Licence : GPL * * * ******************************************************************************** * Cette librairie PL/SQL est un portage de la version 1.53 de FPDF, célèbre * * classe PHP développée par Olivier PLATHEY (http://www.fpdf.org/) * ******************************************************************************** This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ********************************************************************************/ /******************************************************************************* TODO : - Known bugs : CHANGELOG : 0.9.4 -> 0.9.5 : - Merged several bug fixes and enhancements from various contributors. 0.9.3 -> 0.9.4 : - Fixed printing links on pages, both URL and internal links now work. - Added the ability to put more than one link on a page. - Rob Duke (Columbia Forest Products). 0.9.2 -> 0.9.3 : - Added Sample on setHeaderProc and setFooterProc procedures. - Added parameter implementation to thes procedures. - Modify Header and footer procedure behaviour to get parameter values - declared subtype 'word' ans type 'tv4000a' in the specs. 0.9.1 -> 0.9.2 : - Added procedure helloword Example. - Added procedure testImg Example. *******************************************************************************/ -- Privates types subtype flag is boolean; subtype car is varchar2(1); subtype phrase is varchar2(255); subtype txt is varchar2(2000); subtype bigtext is varchar2(32767); subtype margin is number; -- type tv1 is table of varchar2(1) index by binary_integer; type tbool is table of boolean index by binary_integer; type tn is table of number index by binary_integer; type tv4000 is table of varchar2(4000) index by binary_integer; type tv32k is table of varchar2(32767) index by binary_integer; type tclob is table of clob index by binary_integer; type charSet is table of pls_integer index by car; type recFont is record ( i word, n pls_integer, type word, name word, dsc tv4000, up word, ut word, cw charSet, enc word, file word, diff word, length1 word, length2 word); type fontsArray is table of recFont index by phrase; type recImage is record ( n number, -- indice d'insertion dans le document i number, -- ? w number, -- width h number, -- height cs txt, -- colorspace bpc txt, -- Bit per color f txt, -- File Format parms txt, -- pdf parameter for this image pal txt, -- colors palette informations trns tn, -- transparency data blob -- Data ); type imagesArray is table of recImage index by txt; type recFormat is record ( largeur number, hauteur number); type rec2chp is record ( zero txt, un txt); type rec5 is record ( page number, zero txt, un txt, deux txt, trois txt, quatre txt); type LinksArray is table of rec5; type Array2dim is table of rec2chp; type ArrayCharWidths is table of charSet index by word; -- Private properties page number; -- current page number n number; -- current object number offsets tv4000; -- array of object offsets --pdfDoc tv32k; -- buffer holding in-memory final PDF document. pdfDoc tclob; imgBlob blob; -- allows creation of persistent blobs for images --pages tv32k; -- array containing pages pages tclob; state word; -- current document state b_compress flag := false; -- compression flag DefOrientation car; -- default orientation CurOrientation car; -- current orientation OrientationChanges tbool; -- array indicating orientation changes k number; -- scale factor (number of points in user unit) fwPt number; fhPt number; -- dimensions of page format in points fw number; fh number; -- dimensions of page format in user unit wPt number; hPt number; -- current dimensions of page in points w number; h number; -- current dimensions of page in user unit lMargin margin; -- left margin tMargin margin; -- top margin rMargin margin; -- right margin bMargin margin; -- page break margin cMargin margin; -- cell margin x number; y number; -- current position in user unit for cell positioning lasth number; -- height of last cell printed LineWidth number; -- line width in user unit CoreFonts tv4000a; -- array of standard font names fonts fontsArray; -- array of used fonts FontFiles fontsArray; -- array of font files diffs tv4000; -- array of encoding differences images imagesArray; -- array of used images PageLinks LinksArray:=LinksArray(); -- array of links in pages links Array2dim:= Array2dim(); -- array of internal links FontFamily word; -- current font family FontStyle word; -- current font style underline flag; -- underlining flag CurrentFont recFont; -- current font info FontSizePt number; -- current font size in points FontSize number; -- current font size in user unit DrawColor phrase; -- commands for drawing color FillColor phrase; -- commands for filling color TextColor phrase; -- commands for txt color ColorFlag flag; -- indicates whether fill and txt colors are different ws word; -- word spacing AutoPageBreak flag; -- automatic page breaking PageBreakTrigger number; -- threshold used to trigger page breaks InFooter flag; -- flag set when processing footer ZoomMode word; -- zoom display mode LayoutMode word; -- layout display mode title txt; -- title subject txt; -- subject author txt; -- author keywords txt; -- keywords creator txt; -- creator AliasNbPages word; -- alias for total number of pages PDFVersion word; -- PDF version number jsIncluded boolean := false; jsNbr number; jsStr varchar2(4000); -- Proprietés ajoutées lors du portage en PLSQL. fpdf_charwidths ArrayCharWidths; -- Characters table. MyHeader_Proc txt; -- Personal Header procedure. MyHeader_ProcParam tv4000a; -- Table of parameters of the personal header Proc. MyFooter_Proc txt; -- Personal Footer procedure. MyFooter_ProcParam tv4000a; -- Table of parameters of the personal footer Proc. formatArray recFormat; -- Dimension of the format (variable : format). gb_mode_debug boolean := false; Linespacing number; -- variables dont je ne maitrise pas bien l'emploi. -- A vérifier au court de la validation du portage. originalsize word; size1 word; size2 word; /******************************************************************************* * * * Protected methods : Internal function and procedures * * * *******************************************************************************/ ---------------------------------------------------------------------------------- -- proc. and func. spécifiques ajoutées au portage. ---------------------------------------------------------------------------------- procedure print (pstr varchar2) is begin -- Choose the output mode... htp.p(pstr); -- My outpout method -- affiche.p(pstr); end print; ---------------------------------------------------------------------------------- -- Testing if method for additionnal fonts exists in this package -- lv_existing_methods MUST reference all the "p_put..." procedure of the package. ---------------------------------------------------------------------------------- function methode_exists(pMethodName varchar2) return boolean is lv_existing_methods varchar2(2000) := 'p_putstream,p_putxobjectdict,p_putresourcedict,p_putfonts,p_putimages,p_putresources,'|| 'p_putinfo,p_putcatalog,p_putheader,p_puttrailer,p_putpages'; begin if (instr(lv_existing_methods, lower(pMethodName) ) > 0 ) then return true; end if; return false; exception when others then return false; end methode_exists; ---------------------------------------------------------------------------------- -- Calculate the length of the final document contained in the plsql table pdfDoc. ---------------------------------------------------------------------------------- function getPDFDocLength return pls_integer is lg pls_integer := 0; begin for i in pdfDoc.first..pdfDoc.last loop lg := lg + nvl(length(pdfDoc(i)), 0); end loop; return lg; exception when others then error('getPDFDocLength : '||sqlerrm); return -1; end getPDFDocLength; ---------------------------------------------------------------------------------- -- Setting metric for courier Font ---------------------------------------------------------------------------------- function getFontCourier return charSet is mySet charSet; begin -- -- Courier font. -- for i in 0..255 loop mySet(chr(i)):=600; end loop; return mySet; end getFontCourier; ---------------------------------------------------------------------------------- -- Setting metric for helvetica ---------------------------------------------------------------------------------- function getFontHelvetica return charSet is mySet charSet; begin -- helvetica font. mySet(chr(0)) := 278; mySet(chr(1)) := 278; mySet(chr(2)) := 278; mySet(chr(3)) := 278; mySet(chr(4)) := 278; mySet(chr(5)) := 278; mySet(chr(6)) := 278; mySet(chr(7)) := 278; mySet(chr(8)) := 278; mySet(chr(9)) := 278; mySet(chr(10)) := 278; mySet(chr(11)) := 278; mySet(chr(12)) := 278; mySet(chr(13)) := 278; mySet(chr(14)) := 278; mySet(chr(15)) := 278; mySet(chr(16)) := 278; mySet(chr(17)) := 278; mySet(chr(18)) := 278; mySet(chr(19)) := 278; mySet(chr(20)) := 278; mySet(chr(21)) := 278; mySet(chr(22)) := 278; mySet(chr(23)) := 278; mySet(chr(24)) := 278; mySet(chr(25)) := 278; mySet(chr(26)) := 278; mySet(chr(27)) := 278; mySet(chr(28)) := 278; mySet(chr(29)) := 278; mySet(chr(30)) := 278; mySet(chr(31)) := 278; mySet(' ') := 278; mySet('!') := 278; mySet('"') := 355; mySet('#') := 556; mySet('$') := 556; mySet('%') := 889; mySet('&') := 667; mySet('''') := 191; mySet('(') := 333; mySet(')') := 333; mySet('*') := 389; mySet('+') := 584; mySet(',') := 278; mySet('-') := 333; mySet('.') := 278; mySet('/') := 278; mySet('0') := 556; mySet('1') := 556; mySet('2') := 556; mySet('3') := 556; mySet('4') := 556; mySet('5') := 556; mySet('6') := 556; mySet('7') := 556; mySet('8') := 556; mySet('9') := 556; mySet(':') := 278; mySet(';') := 278; mySet('<') := 584; mySet('=') := 584; mySet('>') := 584; mySet('?') := 556; mySet('@') := 1015; mySet('A') := 667; mySet('B') := 667; mySet('C') := 722; mySet('D') := 722; mySet('E') := 667; mySet('F') := 611; mySet('G') := 778; mySet('H') := 722; mySet('I') := 278; mySet('J') := 500; mySet('K') := 667; mySet('L') := 556; mySet('M') := 833; mySet('N') := 722; mySet('O') := 778; mySet('P') := 667; mySet('Q') := 778; mySet('R') := 722; mySet('S') := 667; mySet('T') := 611; mySet('U') := 722; mySet('V') := 667; mySet('W') := 944; mySet('X') := 667; mySet('Y') := 667; mySet('Z') := 611; mySet('[') := 278; mySet('\') := 278; mySet(']') := 278; mySet('^') := 469; mySet('_') := 556; mySet('`') := 333; mySet('a') := 556; mySet('b') := 556; mySet('c') := 500; mySet('d') := 556; mySet('e') := 556; mySet('f') := 278; mySet('g') := 556; mySet('h') := 556; mySet('i') := 222; mySet('j') := 222; mySet('k') := 500; mySet('l') := 222; mySet('m') := 833; mySet('n') := 556; mySet('o') := 556; mySet('p') := 556; mySet('q') := 556; mySet('r') := 333; mySet('s') := 500; mySet('t') := 278; mySet('u') := 556; mySet('v') := 500; mySet('w') := 722; mySet('x') := 500; mySet('y') := 500; mySet('z') := 500; mySet('{') := 334; mySet('|') := 260; mySet('}') := 334; mySet('~') := 584; mySet(chr(127)) := 350; mySet(chr(128)) := 556; mySet(chr(129)) := 350; mySet(chr(130)) := 222; mySet(chr(131)) := 556; mySet(chr(132)) := 333; mySet(chr(133)) := 1000; mySet(chr(134)) := 556; mySet(chr(135)) := 556; mySet(chr(136)) := 333; mySet(chr(137)) := 1000; mySet(chr(138)) := 667; mySet(chr(139)) := 333; mySet(chr(140)) := 1000; mySet(chr(141)) := 350; mySet(chr(142)) := 611; mySet(chr(143)) := 350; mySet(chr(144)) := 350; mySet(chr(145)) := 222; mySet(chr(146)) := 222; mySet(chr(147)) := 333; mySet(chr(148)) := 333; mySet(chr(149)) := 350; mySet(chr(150)) := 556; mySet(chr(151)) := 1000; mySet(chr(152)) := 333; mySet(chr(153)) := 1000; mySet(chr(154)) := 500; mySet(chr(155)) := 333; mySet(chr(156)) := 944; mySet(chr(157)) := 350; mySet(chr(158)) := 500; mySet(chr(159)) := 667; mySet(chr(160)) := 278; mySet(chr(161)) := 333; mySet(chr(162)) := 556; mySet(chr(163)) := 556; mySet(chr(164)) := 556; mySet(chr(165)) := 556; mySet(chr(166)) := 260; mySet(chr(167)) := 556; mySet(chr(168)) := 333; mySet(chr(169)) := 737; mySet(chr(170)) := 370; mySet(chr(171)) := 556; mySet(chr(172)) := 584; mySet(chr(173)) := 333; mySet(chr(174)) := 737; mySet(chr(175)) := 333; mySet(chr(176)) := 400; mySet(chr(177)) := 584; mySet(chr(178)) := 333; mySet(chr(179)) := 333; mySet(chr(180)) := 333; mySet(chr(181)) := 556; mySet(chr(182)) := 537; mySet(chr(183)) := 278; mySet(chr(184)) := 333; mySet(chr(185)) := 333; mySet(chr(186)) := 365; mySet(chr(187)) := 556; mySet(chr(188)) := 834; mySet(chr(189)) := 834; mySet(chr(190)) := 834; mySet(chr(191)) := 611; mySet(chr(192)) := 667; mySet(chr(193)) := 667; mySet(chr(194)) := 667; mySet(chr(195)) := 667; mySet(chr(196)) := 667; mySet(chr(197)) := 667; mySet(chr(198)) := 1000; mySet(chr(199)) := 722; mySet(chr(200)) := 667; mySet(chr(201)) := 667; mySet(chr(202)) := 667; mySet(chr(203)) := 667; mySet(chr(204)) := 278; mySet(chr(205)) := 278; mySet(chr(206)) := 278; mySet(chr(207)) := 278; mySet(chr(208)) := 722; mySet(chr(209)) := 722; mySet(chr(210)) := 778; mySet(chr(211)) := 778; mySet(chr(212)) := 778; mySet(chr(213)) := 778; mySet(chr(214)) := 778; mySet(chr(215)) := 584; mySet(chr(216)) := 778; mySet(chr(217)) := 722; mySet(chr(218)) := 722; mySet(chr(219)) := 722; mySet(chr(220)) := 722; mySet(chr(221)) := 667; mySet(chr(222)) := 667; mySet(chr(223)) := 611; mySet(chr(224)) := 556; mySet(chr(225)) := 556; mySet(chr(226)) := 556; mySet(chr(227)) := 556; mySet(chr(228)) := 556; mySet(chr(229)) := 556; mySet(chr(230)) := 889; mySet(chr(231)) := 500; mySet(chr(232)) := 556; mySet(chr(233)) := 556; mySet(chr(234)) := 556; mySet(chr(235)) := 556; mySet(chr(236)) := 278; mySet(chr(237)) := 278; mySet(chr(238)) := 278; mySet(chr(239)) := 278; mySet(chr(240)) := 556; mySet(chr(241)) := 556; mySet(chr(242)) := 556; mySet(chr(243)) := 556; mySet(chr(244)) := 556; mySet(chr(245)) := 556; mySet(chr(246)) := 556; mySet(chr(247)) := 584; mySet(chr(248)) := 611; mySet(chr(249)) := 556; mySet(chr(250)) := 556; mySet(chr(251)) := 556; mySet(chr(252)) := 556; mySet(chr(253)) := 500; mySet(chr(254)) := 556; mySet(chr(255)) := 500; return mySet; end getFontHelvetica; ---------------------------------------------------------------------------------- -- Setting metric for helvetica ITALIC ---------------------------------------------------------------------------------- function getFontHelveticai return charSet is mySet charSet; begin -- helvetica Italic font. mySet(chr(0)) := 278; mySet(chr(1)) := 278; mySet(chr(2)) := 278; mySet(chr(3)) := 278; mySet(chr(4)) := 278; mySet(chr(5)) := 278; mySet(chr(6)) := 278; mySet(chr(7)) := 278; mySet(chr(8)) := 278; mySet(chr(9)) := 278; mySet(chr(10)) := 278; mySet(chr(11)) := 278; mySet(chr(12)) := 278; mySet(chr(13)) := 278; mySet(chr(14)) := 278; mySet(chr(15)) := 278; mySet(chr(16)) := 278; mySet(chr(17)) := 278; mySet(chr(18)) := 278; mySet(chr(19)) := 278; mySet(chr(20)) := 278; mySet(chr(21)) := 278; mySet(chr(22)) := 278; mySet(chr(23)) := 278; mySet(chr(24)) := 278; mySet(chr(25)) := 278; mySet(chr(26)) := 278; mySet(chr(27)) := 278; mySet(chr(28)) := 278; mySet(chr(29)) := 278; mySet(chr(30)) := 278; mySet(chr(31)) := 278; mySet(' ') := 278; mySet('!') := 278; mySet('"') := 355; mySet('#') := 556; mySet('$') := 556; mySet('%') := 889; mySet('&') := 667; mySet('''') := 191; mySet('(') := 333; mySet(')') := 333; mySet('*') := 389; mySet('+') := 584; mySet(',') := 278; mySet('-') := 333; mySet('.') := 278; mySet('/') := 278; mySet('0') := 556; mySet('1') := 556; mySet('2') := 556; mySet('3') := 556; mySet('4') := 556; mySet('5') := 556; mySet('6') := 556; mySet('7') := 556; mySet('8') := 556; mySet('9') := 556; mySet(':') := 278; mySet(';') := 278; mySet('<') := 584; mySet('=') := 584; mySet('>') := 584; mySet('?') := 556; mySet('@') := 1015; mySet('A') := 667; mySet('B') := 667; mySet('C') := 722; mySet('D') := 722; mySet('E') := 667; mySet('F') := 611; mySet('G') := 778; mySet('H') := 722; mySet('I') := 278; mySet('J') := 500; mySet('K') := 667; mySet('L') := 556; mySet('M') := 833; mySet('N') := 722; mySet('O') := 778; mySet('P') := 667; mySet('Q') := 778; mySet('R') := 722; mySet('S') := 667; mySet('T') := 611; mySet('U') := 722; mySet('V') := 667; mySet('W') := 944; mySet('X') := 667; mySet('Y') := 667; mySet('Z') := 611; mySet('[') := 278; mySet('\') := 278; mySet(']') := 278; mySet('^') := 469; mySet('_') := 556; mySet('`') := 333; mySet('a') := 556; mySet('b') := 556; mySet('c') := 500; mySet('d') := 556; mySet('e') := 556; mySet('f') := 278; mySet('g') := 556; mySet('h') := 556; mySet('i') := 222; mySet('j') := 222; mySet('k') := 500; mySet('l') := 222; mySet('m') := 833; mySet('n') := 556; mySet('o') := 556; mySet('p') := 556; mySet('q') := 556; mySet('r') := 333; mySet('s') := 500; mySet('t') := 278; mySet('u') := 556; mySet('v') := 500; mySet('w') := 722; mySet('x') := 500; mySet('y') := 500; mySet('z') := 500; mySet('{') := 334; mySet('|') := 260; mySet('}') := 334; mySet('~') := 584; mySet(chr(127)) := 350; mySet(chr(128)) := 556; mySet(chr(129)) := 350; mySet(chr(130)) := 222; mySet(chr(131)) := 556; mySet(chr(132)) := 333; mySet(chr(133)) := 1000; mySet(chr(134)) := 556; mySet(chr(135)) := 556; mySet(chr(136)) := 333; mySet(chr(137)) := 1000; mySet(chr(138)) := 667; mySet(chr(139)) := 333; mySet(chr(140)) := 1000; mySet(chr(141)) := 350; mySet(chr(142)) := 611; mySet(chr(143)) := 350; mySet(chr(144)) := 350; mySet(chr(145)) := 222; mySet(chr(146)) := 222; mySet(chr(147)) := 333; mySet(chr(148)) := 333; mySet(chr(149)) := 350; mySet(chr(150)) := 556; mySet(chr(151)) := 1000; mySet(chr(152)) := 333; mySet(chr(153)) := 1000; mySet(chr(154)) := 500; mySet(chr(155)) := 333; mySet(chr(156)) := 944; mySet(chr(157)) := 350; mySet(chr(158)) := 500; mySet(chr(159)) := 667; mySet(chr(160)) := 278; mySet(chr(161)) := 333; mySet(chr(162)) := 556; mySet(chr(163)) := 556; mySet(chr(164)) := 556; mySet(chr(165)) := 556; mySet(chr(166)) := 260; mySet(chr(167)) := 556; mySet(chr(168)) := 333; mySet(chr(169)) := 737; mySet(chr(170)) := 370; mySet(chr(171)) := 556; mySet(chr(172)) := 584; mySet(chr(173)) := 333; mySet(chr(174)) := 737; mySet(chr(175)) := 333; mySet(chr(176)) := 400; mySet(chr(177)) := 584; mySet(chr(178)) := 333; mySet(chr(179)) := 333; mySet(chr(180)) := 333; mySet(chr(181)) := 556; mySet(chr(182)) := 537; mySet(chr(183)) := 278; mySet(chr(184)) := 333; mySet(chr(185)) := 333; mySet(chr(186)) := 365; mySet(chr(187)) := 556; mySet(chr(188)) := 834; mySet(chr(189)) := 834; mySet(chr(190)) := 834; mySet(chr(191)) := 611; mySet(chr(192)) := 667; mySet(chr(193)) := 667; mySet(chr(194)) := 667; mySet(chr(195)) := 667; mySet(chr(196)) := 667; mySet(chr(197)) := 667; mySet(chr(198)) := 1000; mySet(chr(199)) := 722; mySet(chr(200)) := 667; mySet(chr(201)) := 667; mySet(chr(202)) := 667; mySet(chr(203)) := 667; mySet(chr(204)) := 278; mySet(chr(205)) := 278; mySet(chr(206)) := 278; mySet(chr(207)) := 278; mySet(chr(208)) := 722; mySet(chr(209)) := 722; mySet(chr(210)) := 778; mySet(chr(211)) := 778; mySet(chr(212)) := 778; mySet(chr(213)) := 778; mySet(chr(214)) := 778; mySet(chr(215)) := 584; mySet(chr(216)) := 778; mySet(chr(217)) := 722; mySet(chr(218)) := 722; mySet(chr(219)) := 722; mySet(chr(220)) := 722; mySet(chr(221)) := 667; mySet(chr(222)) := 667; mySet(chr(223)) := 611; mySet(chr(224)) := 556; mySet(chr(225)) := 556; mySet(chr(226)) := 556; mySet(chr(227)) := 556; mySet(chr(228)) := 556; mySet(chr(229)) := 556; mySet(chr(230)) := 889; mySet(chr(231)) := 500; mySet(chr(232)) := 556; mySet(chr(233)) := 556; mySet(chr(234)) := 556; mySet(chr(235)) := 556; mySet(chr(236)) := 278; mySet(chr(237)) := 278; mySet(chr(238)) := 278; mySet(chr(239)) := 278; mySet(chr(240)) := 556; mySet(chr(241)) := 556; mySet(chr(242)) := 556; mySet(chr(243)) := 556; mySet(chr(244)) := 556; mySet(chr(245)) := 556; mySet(chr(246)) := 556; mySet(chr(247)) := 584; mySet(chr(248)) := 611; mySet(chr(249)) := 556; mySet(chr(250)) := 556; mySet(chr(251)) := 556; mySet(chr(252)) := 556; mySet(chr(253)) := 500; mySet(chr(254)) := 556; mySet(chr(255)) := 500; return mySet; end getFontHelveticai; ---------------------------------------------------------------------------------- -- Setting metric for helvetica BOLD ---------------------------------------------------------------------------------- function getFontHelveticab return charSet is mySet charSet; begin -- helvetica bold font. mySet(chr(0)) := 278; mySet(chr(1)) := 278; mySet(chr(2)) := 278; mySet(chr(3)) := 278; mySet(chr(4)) := 278; mySet(chr(5)) := 278; mySet(chr(6)) := 278; mySet(chr(7)) := 278; mySet(chr(8)) := 278; mySet(chr(9)) := 278; mySet(chr(10)) := 278; mySet(chr(11)) := 278; mySet(chr(12)) := 278; mySet(chr(13)) := 278; mySet(chr(14)) := 278; mySet(chr(15)) := 278; mySet(chr(16)) := 278; mySet(chr(17)) := 278; mySet(chr(18)) := 278; mySet(chr(19)) := 278; mySet(chr(20)) := 278; mySet(chr(21)) := 278; mySet(chr(22)) := 278; mySet(chr(23)) := 278; mySet(chr(24)) := 278; mySet(chr(25)) := 278; mySet(chr(26)) := 278; mySet(chr(27)) := 278; mySet(chr(28)) := 278; mySet(chr(29)) := 278; mySet(chr(30)) := 278; mySet(chr(31)) := 278; mySet(' ') := 278; mySet('!') := 333; mySet('"') := 474; mySet('#') := 556; mySet('$') := 556; mySet('%') := 889; mySet('&') := 722; mySet('''') := 238; mySet('(') := 333; mySet(')') := 333; mySet('*') := 389; mySet('+') := 584; mySet(',') := 278; mySet('-') := 333; mySet('.') := 278; mySet('/') := 278; mySet('0') := 556; mySet('1') := 556; mySet('2') := 556; mySet('3') := 556; mySet('4') := 556; mySet('5') := 556; mySet('6') := 556; mySet('7') := 556; mySet('8') := 556; mySet('9') := 556; mySet(':') := 333; mySet(';') := 333; mySet('<') := 584; mySet('=') := 584; mySet('>') := 584; mySet('?') := 611; mySet('@') := 975; mySet('A') := 722; mySet('B') := 722; mySet('C') := 722; mySet('D') := 722; mySet('E') := 667; mySet('F') := 611; mySet('G') := 778; mySet('H') := 722; mySet('I') := 278; mySet('J') := 556; mySet('K') := 722; mySet('L') := 611; mySet('M') := 833; mySet('N') := 722; mySet('O') := 778; mySet('P') := 667; mySet('Q') := 778; mySet('R') := 722; mySet('S') := 667; mySet('T') := 611; mySet('U') := 722; mySet('V') := 667; mySet('W') := 944; mySet('X') := 667; mySet('Y') := 667; mySet('Z') := 611; mySet('[') := 333; mySet('\') := 278; mySet(']') := 333; mySet('^') := 584; mySet('_') := 556; mySet('`') := 333; mySet('a') := 556; mySet('b') := 611; mySet('c') := 556; mySet('d') := 611; mySet('e') := 556; mySet('f') := 333; mySet('g') := 611; mySet('h') := 611; mySet('i') := 278; mySet('j') := 278; mySet('k') := 556; mySet('l') := 278; mySet('m') := 889; mySet('n') := 611; mySet('o') := 611; mySet('p') := 611; mySet('q') := 611; mySet('r') := 389; mySet('s') := 556; mySet('t') := 333; mySet('u') := 611; mySet('v') := 556; mySet('w') := 778; mySet('x') := 556; mySet('y') := 556; mySet('z') := 500; mySet('{') := 389; mySet('|') := 280; mySet('}') := 389; mySet('~') := 584; mySet(chr(127)) := 350; mySet(chr(128)) := 556; mySet(chr(129)) := 350; mySet(chr(130)) := 278; mySet(chr(131)) := 556; mySet(chr(132)) := 500; mySet(chr(133)) := 1000; mySet(chr(134)) := 556; mySet(chr(135)) := 556; mySet(chr(136)) := 333; mySet(chr(137)) := 1000; mySet(chr(138)) := 667; mySet(chr(139)) := 333; mySet(chr(140)) := 1000; mySet(chr(141)) := 350; mySet(chr(142)) := 611; mySet(chr(143)) := 350; mySet(chr(144)) := 350; mySet(chr(145)) := 278; mySet(chr(146)) := 278; mySet(chr(147)) := 500; mySet(chr(148)) := 500; mySet(chr(149)) := 350; mySet(chr(150)) := 556; mySet(chr(151)) := 1000; mySet(chr(152)) := 333; mySet(chr(153)) := 1000; mySet(chr(154)) := 556; mySet(chr(155)) := 333; mySet(chr(156)) := 944; mySet(chr(157)) := 350; mySet(chr(158)) := 500; mySet(chr(159)) := 667; mySet(chr(160)) := 278; mySet(chr(161)) := 333; mySet(chr(162)) := 556; mySet(chr(163)) := 556; mySet(chr(164)) := 556; mySet(chr(165)) := 556; mySet(chr(166)) := 280; mySet(chr(167)) := 556; mySet(chr(168)) := 333; mySet(chr(169)) := 737; mySet(chr(170)) := 370; mySet(chr(171)) := 556; mySet(chr(172)) := 584; mySet(chr(173)) := 333; mySet(chr(174)) := 737; mySet(chr(175)) := 333; mySet(chr(176)) := 400; mySet(chr(177)) := 584; mySet(chr(178)) := 333; mySet(chr(179)) := 333; mySet(chr(180)) := 333; mySet(chr(181)) := 611; mySet(chr(182)) := 556; mySet(chr(183)) := 278; mySet(chr(184)) := 333; mySet(chr(185)) := 333; mySet(chr(186)) := 365; mySet(chr(187)) := 556; mySet(chr(188)) := 834; mySet(chr(189)) := 834; mySet(chr(190)) := 834; mySet(chr(191)) := 611; mySet(chr(192)) := 722; mySet(chr(193)) := 722; mySet(chr(194)) := 722; mySet(chr(195)) := 722; mySet(chr(196)) := 722; mySet(chr(197)) := 722; mySet(chr(198)) := 1000; mySet(chr(199)) := 722; mySet(chr(200)) := 667; mySet(chr(201)) := 667; mySet(chr(202)) := 667; mySet(chr(203)) := 667; mySet(chr(204)) := 278; mySet(chr(205)) := 278; mySet(chr(206)) := 278; mySet(chr(207)) := 278; mySet(chr(208)) := 722; mySet(chr(209)) := 722; mySet(chr(210)) := 778; mySet(chr(211)) := 778; mySet(chr(212)) := 778; mySet(chr(213)) := 778; mySet(chr(214)) := 778; mySet(chr(215)) := 584; mySet(chr(216)) := 778; mySet(chr(217)) := 722; mySet(chr(218)) := 722; mySet(chr(219)) := 722; mySet(chr(220)) := 722; mySet(chr(221)) := 667; mySet(chr(222)) := 667; mySet(chr(223)) := 611; mySet(chr(224)) := 556; mySet(chr(225)) := 556; mySet(chr(226)) := 556; mySet(chr(227)) := 556; mySet(chr(228)) := 556; mySet(chr(229)) := 556; mySet(chr(230)) := 889; mySet(chr(231)) := 556; mySet(chr(232)) := 556; mySet(chr(233)) := 556; mySet(chr(234)) := 556; mySet(chr(235)) := 556; mySet(chr(236)) := 278; mySet(chr(237)) := 278; mySet(chr(238)) := 278; mySet(chr(239)) := 278; mySet(chr(240)) := 611; mySet(chr(241)) := 611; mySet(chr(242)) := 611; mySet(chr(243)) := 611; mySet(chr(244)) := 611; mySet(chr(245)) := 611; mySet(chr(246)) := 611; mySet(chr(247)) := 584; mySet(chr(248)) := 611; mySet(chr(249)) := 611; mySet(chr(250)) := 611; mySet(chr(251)) := 611; mySet(chr(252)) := 611; mySet(chr(253)) := 556; mySet(chr(254)) := 611; mySet(chr(255)) := 556; return mySet; end getFontHelveticab; ---------------------------------------------------------------------------------- -- Setting metric for helvetica BOLD ITALIC ---------------------------------------------------------------------------------- function getFontHelveticabi return charSet is mySet charSet; begin -- helvetica bold italic font. mySet(chr(0)) := 278; mySet(chr(1)) := 278; mySet(chr(2)) := 278; mySet(chr(3)) := 278; mySet(chr(4)) := 278; mySet(chr(5)) := 278; mySet(chr(6)) := 278; mySet(chr(7)) := 278; mySet(chr(8)) := 278; mySet(chr(9)) := 278; mySet(chr(10)) := 278; mySet(chr(11)) := 278; mySet(chr(12)) := 278; mySet(chr(13)) := 278; mySet(chr(14)) := 278; mySet(chr(15)) := 278; mySet(chr(16)) := 278; mySet(chr(17)) := 278; mySet(chr(18)) := 278; mySet(chr(19)) := 278; mySet(chr(20)) := 278; mySet(chr(21)) := 278; mySet(chr(22)) := 278; mySet(chr(23)) := 278; mySet(chr(24)) := 278; mySet(chr(25)) := 278; mySet(chr(26)) := 278; mySet(chr(27)) := 278; mySet(chr(28)) := 278; mySet(chr(29)) := 278; mySet(chr(30)) := 278; mySet(chr(31)) := 278; mySet(' ') := 278; mySet('!') := 333; mySet('"') := 474; mySet('#') := 556; mySet('$') := 556; mySet('%') := 889; mySet('&') := 722; mySet('''') := 238; mySet('(') := 333; mySet(')') := 333; mySet('*') := 389; mySet('+') := 584; mySet(',') := 278; mySet('-') := 333; mySet('.') := 278; mySet('/') := 278; mySet('0') := 556; mySet('1') := 556; mySet('2') := 556; mySet('3') := 556; mySet('4') := 556; mySet('5') := 556; mySet('6') := 556; mySet('7') := 556; mySet('8') := 556; mySet('9') := 556; mySet(':') := 333; mySet(';') := 333; mySet('<') := 584; mySet('=') := 584; mySet('>') := 584; mySet('?') := 611; mySet('@') := 975; mySet('A') := 722; mySet('B') := 722; mySet('C') := 722; mySet('D') := 722; mySet('E') := 667; mySet('F') := 611; mySet('G') := 778; mySet('H') := 722; mySet('I') := 278; mySet('J') := 556; mySet('K') := 722; mySet('L') := 611; mySet('M') := 833; mySet('N') := 722; mySet('O') := 778; mySet('P') := 667; mySet('Q') := 778; mySet('R') := 722; mySet('S') := 667; mySet('T') := 611; mySet('U') := 722; mySet('V') := 667; mySet('W') := 944; mySet('X') := 667; mySet('Y') := 667; mySet('Z') := 611; mySet('[') := 333; mySet('\') := 278; mySet(']') := 333; mySet('^') := 584; mySet('_') := 556; mySet('`') := 333; mySet('a') := 556; mySet('b') := 611; mySet('c') := 556; mySet('d') := 611; mySet('e') := 556; mySet('f') := 333; mySet('g') := 611; mySet('h') := 611; mySet('i') := 278; mySet('j') := 278; mySet('k') := 556; mySet('l') := 278; mySet('m') := 889; mySet('n') := 611; mySet('o') := 611; mySet('p') := 611; mySet('q') := 611; mySet('r') := 389; mySet('s') := 556; mySet('t') := 333; mySet('u') := 611; mySet('v') := 556; mySet('w') := 778; mySet('x') := 556; mySet('y') := 556; mySet('z') := 500; mySet('{') := 389; mySet('|') := 280; mySet('}') := 389; mySet('~') := 584; mySet(chr(127)) := 350; mySet(chr(128)) := 556; mySet(chr(129)) := 350; mySet(chr(130)) := 278; mySet(chr(131)) := 556; mySet(chr(132)) := 500; mySet(chr(133)) := 1000; mySet(chr(134)) := 556; mySet(chr(135)) := 556; mySet(chr(136)) := 333; mySet(chr(137)) := 1000; mySet(chr(138)) := 667; mySet(chr(139)) := 333; mySet(chr(140)) := 1000; mySet(chr(141)) := 350; mySet(chr(142)) := 611; mySet(chr(143)) := 350; mySet(chr(144)) := 350; mySet(chr(145)) := 278; mySet(chr(146)) := 278; mySet(chr(147)) := 500; mySet(chr(148)) := 500; mySet(chr(149)) := 350; mySet(chr(150)) := 556; mySet(chr(151)) := 1000; mySet(chr(152)) := 333; mySet(chr(153)) := 1000; mySet(chr(154)) := 556; mySet(chr(155)) := 333; mySet(chr(156)) := 944; mySet(chr(157)) := 350; mySet(chr(158)) := 500; mySet(chr(159)) := 667; mySet(chr(160)) := 278; mySet(chr(161)) := 333; mySet(chr(162)) := 556; mySet(chr(163)) := 556; mySet(chr(164)) := 556; mySet(chr(165)) := 556; mySet(chr(166)) := 280; mySet(chr(167)) := 556; mySet(chr(168)) := 333; mySet(chr(169)) := 737; mySet(chr(170)) := 370; mySet(chr(171)) := 556; mySet(chr(172)) := 584; mySet(chr(173)) := 333; mySet(chr(174)) := 737; mySet(chr(175)) := 333; mySet(chr(176)) := 400; mySet(chr(177)) := 584; mySet(chr(178)) := 333; mySet(chr(179)) := 333; mySet(chr(180)) := 333; mySet(chr(181)) := 611; mySet(chr(182)) := 556; mySet(chr(183)) := 278; mySet(chr(184)) := 333; mySet(chr(185)) := 333; mySet(chr(186)) := 365; mySet(chr(187)) := 556; mySet(chr(188)) := 834; mySet(chr(189)) := 834; mySet(chr(190)) := 834; mySet(chr(191)) := 611; mySet(chr(192)) := 722; mySet(chr(193)) := 722; mySet(chr(194)) := 722; mySet(chr(195)) := 722; mySet(chr(196)) := 722; mySet(chr(197)) := 722; mySet(chr(198)) := 1000; mySet(chr(199)) := 722; mySet(chr(200)) := 667; mySet(chr(201)) := 667; mySet(chr(202)) := 667; mySet(chr(203)) := 667; mySet(chr(204)) := 278; mySet(chr(205)) := 278; mySet(chr(206)) := 278; mySet(chr(207)) := 278; mySet(chr(208)) := 722; mySet(chr(209)) := 722; mySet(chr(210)) := 778; mySet(chr(211)) := 778; mySet(chr(212)) := 778; mySet(chr(213)) := 778; mySet(chr(214)) := 778; mySet(chr(215)) := 584; mySet(chr(216)) := 778; mySet(chr(217)) := 722; mySet(chr(218)) := 722; mySet(chr(219)) := 722; mySet(chr(220)) := 722; mySet(chr(221)) := 667; mySet(chr(222)) := 667; mySet(chr(223)) := 611; mySet(chr(224)) := 556; mySet(chr(225)) := 556; mySet(chr(226)) := 556; mySet(chr(227)) := 556; mySet(chr(228)) := 556; mySet(chr(229)) := 556; mySet(chr(230)) := 889; mySet(chr(231)) := 556; mySet(chr(232)) := 556; mySet(chr(233)) := 556; mySet(chr(234)) := 556; mySet(chr(235)) := 556; mySet(chr(236)) := 278; mySet(chr(237)) := 278; mySet(chr(238)) := 278; mySet(chr(239)) := 278; mySet(chr(240)) := 611; mySet(chr(241)) := 611; mySet(chr(242)) := 611; mySet(chr(243)) := 611; mySet(chr(244)) := 611; mySet(chr(245)) := 611; mySet(chr(246)) := 611; mySet(chr(247)) := 584; mySet(chr(248)) := 611; mySet(chr(249)) := 611; mySet(chr(250)) := 611; mySet(chr(251)) := 611; mySet(chr(252)) := 611; mySet(chr(253)) := 556; mySet(chr(254)) := 611; mySet(chr(255)) := 556; return mySet; end getFontHelveticabi; ---------------------------------------------------------------------------------- -- Setting metric for times ---------------------------------------------------------------------------------- function getFontTimes return charSet is mySet charSet; begin -- Times font. mySet(chr(0)) := 250; mySet(chr(1)) := 250; mySet(chr(2)) := 250; mySet(chr(3)) := 250; mySet(chr(4)) := 250; mySet(chr(5)) := 250; mySet(chr(6)) := 250; mySet(chr(7)) := 250; mySet(chr(8)) := 250; mySet(chr(9)) := 250; mySet(chr(10)) := 250; mySet(chr(11)) := 250; mySet(chr(12)) := 250; mySet(chr(13)) := 250; mySet(chr(14)) := 250; mySet(chr(15)) := 250; mySet(chr(16)) := 250; mySet(chr(17)) := 250; mySet(chr(18)) := 250; mySet(chr(19)) := 250; mySet(chr(20)) := 250; mySet(chr(21)) := 250; mySet(chr(22)) := 250; mySet(chr(23)) := 250; mySet(chr(24)) := 250; mySet(chr(25)) := 250; mySet(chr(26)) := 250; mySet(chr(27)) := 250; mySet(chr(28)) := 250; mySet(chr(29)) := 250; mySet(chr(30)) := 250; mySet(chr(31)) := 250; mySet(' ') := 250; mySet('!') := 333; mySet('"') := 408; mySet('#') := 500; mySet('$') := 500; mySet('%') := 833; mySet('&') := 778; mySet('''') := 180; mySet('(') := 333; mySet(')') := 333; mySet('*') := 500; mySet('+') := 564; mySet(',') := 250; mySet('-') := 333; mySet('.') := 250; mySet('/') := 278; mySet('0') := 500; mySet('1') := 500; mySet('2') := 500; mySet('3') := 500; mySet('4') := 500; mySet('5') := 500; mySet('6') := 500; mySet('7') := 500; mySet('8') := 500; mySet('9') := 500; mySet(':') := 278; mySet(';') := 278; mySet('<') := 564; mySet('=') := 564; mySet('>') := 564; mySet('?') := 444; mySet('@') := 921; mySet('A') := 722; mySet('B') := 667; mySet('C') := 667; mySet('D') := 722; mySet('E') := 611; mySet('F') := 556; mySet('G') := 722; mySet('H') := 722; mySet('I') := 333; mySet('J') := 389; mySet('K') := 722; mySet('L') := 611; mySet('M') := 889; mySet('N') := 722; mySet('O') := 722; mySet('P') := 556; mySet('Q') := 722; mySet('R') := 667; mySet('S') := 556; mySet('T') := 611; mySet('U') := 722; mySet('V') := 722; mySet('W') := 944; mySet('X') := 722; mySet('Y') := 722; mySet('Z') := 611; mySet('[') := 333; mySet('\') := 278; mySet(']') := 333; mySet('^') := 469; mySet('_') := 500; mySet('`') := 333; mySet('a') := 444; mySet('b') := 500; mySet('c') := 444; mySet('d') := 500; mySet('e') := 444; mySet('f') := 333; mySet('g') := 500; mySet('h') := 500; mySet('i') := 278; mySet('j') := 278; mySet('k') := 500; mySet('l') := 278; mySet('m') := 778; mySet('n') := 500; mySet('o') := 500; mySet('p') := 500; mySet('q') := 500; mySet('r') := 333; mySet('s') := 389; mySet('t') := 278; mySet('u') := 500; mySet('v') := 500; mySet('w') := 722; mySet('x') := 500; mySet('y') := 500; mySet('z') := 444; mySet('{') := 480; mySet('|') := 200; mySet('}') := 480; mySet('~') := 541; mySet(chr(127)) := 350; mySet(chr(128)) := 500; mySet(chr(129)) := 350; mySet(chr(130)) := 333; mySet(chr(131)) := 500; mySet(chr(132)) := 444; mySet(chr(133)) := 1000; mySet(chr(134)) := 500; mySet(chr(135)) := 500; mySet(chr(136)) := 333; mySet(chr(137)) := 1000; mySet(chr(138)) := 556; mySet(chr(139)) := 333; mySet(chr(140)) := 889; mySet(chr(141)) := 350; mySet(chr(142)) := 611; mySet(chr(143)) := 350; mySet(chr(144)) := 350; mySet(chr(145)) := 333; mySet(chr(146)) := 333; mySet(chr(147)) := 444; mySet(chr(148)) := 444; mySet(chr(149)) := 350; mySet(chr(150)) := 500; mySet(chr(151)) := 1000; mySet(chr(152)) := 333; mySet(chr(153)) := 980; mySet(chr(154)) := 389; mySet(chr(155)) := 333; mySet(chr(156)) := 722; mySet(chr(157)) := 350; mySet(chr(158)) := 444; mySet(chr(159)) := 722; mySet(chr(160)) := 250; mySet(chr(161)) := 333; mySet(chr(162)) := 500; mySet(chr(163)) := 500; mySet(chr(164)) := 500; mySet(chr(165)) := 500; mySet(chr(166)) := 200; mySet(chr(167)) := 500; mySet(chr(168)) := 333; mySet(chr(169)) := 760; mySet(chr(170)) := 276; mySet(chr(171)) := 500; mySet(chr(172)) := 564; mySet(chr(173)) := 333; mySet(chr(174)) := 760; mySet(chr(175)) := 333; mySet(chr(176)) := 400; mySet(chr(177)) := 564; mySet(chr(178)) := 300; mySet(chr(179)) := 300; mySet(chr(180)) := 333; mySet(chr(181)) := 500; mySet(chr(182)) := 453; mySet(chr(183)) := 250; mySet(chr(184)) := 333; mySet(chr(185)) := 300; mySet(chr(186)) := 310; mySet(chr(187)) := 500; mySet(chr(188)) := 750; mySet(chr(189)) := 750; mySet(chr(190)) := 750; mySet(chr(191)) := 444; mySet(chr(192)) := 722; mySet(chr(193)) := 722; mySet(chr(194)) := 722; mySet(chr(195)) := 722; mySet(chr(196)) := 722; mySet(chr(197)) := 722; mySet(chr(198)) := 889; mySet(chr(199)) := 667; mySet(chr(200)) := 611; mySet(chr(201)) := 611; mySet(chr(202)) := 611; mySet(chr(203)) := 611; mySet(chr(204)) := 333; mySet(chr(205)) := 333; mySet(chr(206)) := 333; mySet(chr(207)) := 333; mySet(chr(208)) := 722; mySet(chr(209)) := 722; mySet(chr(210)) := 722; mySet(chr(211)) := 722; mySet(chr(212)) := 722; mySet(chr(213)) := 722; mySet(chr(214)) := 722; mySet(chr(215)) := 564; mySet(chr(216)) := 722; mySet(chr(217)) := 722; mySet(chr(218)) := 722; mySet(chr(219)) := 722; mySet(chr(220)) := 722; mySet(chr(221)) := 722; mySet(chr(222)) := 556; mySet(chr(223)) := 500; mySet(chr(224)) := 444; mySet(chr(225)) := 444; mySet(chr(226)) := 444; mySet(chr(227)) := 444; mySet(chr(228)) := 444; mySet(chr(229)) := 444; mySet(chr(230)) := 667; mySet(chr(231)) := 444; mySet(chr(232)) := 444; mySet(chr(233)) := 444; mySet(chr(234)) := 444; mySet(chr(235)) := 444; mySet(chr(236)) := 278; mySet(chr(237)) := 278; mySet(chr(238)) := 278; mySet(chr(239)) := 278; mySet(chr(240)) := 500; mySet(chr(241)) := 500; mySet(chr(242)) := 500; mySet(chr(243)) := 500; mySet(chr(244)) := 500; mySet(chr(245)) := 500; mySet(chr(246)) := 500; mySet(chr(247)) := 564; mySet(chr(248)) := 500; mySet(chr(249)) := 500; mySet(chr(250)) := 500; mySet(chr(251)) := 500; mySet(chr(252)) := 500; mySet(chr(253)) := 500; mySet(chr(254)) := 500; mySet(chr(255)) := 500; return mySet; end getFontTimes; ---------------------------------------------------------------------------------- -- Setting metric for times ITALIC ---------------------------------------------------------------------------------- function getFontTimesi return charSet is mySet charSet; begin -- Times italic font. mySet(chr(0)) := 250; mySet(chr(1)) := 250; mySet(chr(2)) := 250; mySet(chr(3)) := 250; mySet(chr(4)) := 250; mySet(chr(5)) := 250; mySet(chr(6)) := 250; mySet(chr(7)) := 250; mySet(chr(8)) := 250; mySet(chr(9)) := 250; mySet(chr(10)) := 250; mySet(chr(11)) := 250; mySet(chr(12)) := 250; mySet(chr(13)) := 250; mySet(chr(14)) := 250; mySet(chr(15)) := 250; mySet(chr(16)) := 250; mySet(chr(17)) := 250; mySet(chr(18)) := 250; mySet(chr(19)) := 250; mySet(chr(20)) := 250; mySet(chr(21)) := 250; mySet(chr(22)) := 250; mySet(chr(23)) := 250; mySet(chr(24)) := 250; mySet(chr(25)) := 250; mySet(chr(26)) := 250; mySet(chr(27)) := 250; mySet(chr(28)) := 250; mySet(chr(29)) := 250; mySet(chr(30)) := 250; mySet(chr(31)) := 250; mySet(' ') := 250; mySet('!') := 333; mySet('"') := 420; mySet('#') := 500; mySet('$') := 500; mySet('%') := 833; mySet('&') := 778; mySet('''') := 214; mySet('(') := 333; mySet(')') := 333; mySet('*') := 500; mySet('+') := 675; mySet(',') := 250; mySet('-') := 333; mySet('.') := 250; mySet('/') := 278; mySet('0') := 500; mySet('1') := 500; mySet('2') := 500; mySet('3') := 500; mySet('4') := 500; mySet('5') := 500; mySet('6') := 500; mySet('7') := 500; mySet('8') := 500; mySet('9') := 500; mySet(':') := 333; mySet(';') := 333; mySet('<') := 675; mySet('=') := 675; mySet('>') := 675; mySet('?') := 500; mySet('@') := 920; mySet('A') := 611; mySet('B') := 611; mySet('C') := 667; mySet('D') := 722; mySet('E') := 611; mySet('F') := 611; mySet('G') := 722; mySet('H') := 722; mySet('I') := 333; mySet('J') := 444; mySet('K') := 667; mySet('L') := 556; mySet('M') := 833; mySet('N') := 667; mySet('O') := 722; mySet('P') := 611; mySet('Q') := 722; mySet('R') := 611; mySet('S') := 500; mySet('T') := 556; mySet('U') := 722; mySet('V') := 611; mySet('W') := 833; mySet('X') := 611; mySet('Y') := 556; mySet('Z') := 556; mySet('[') := 389; mySet('\') := 278; mySet(']') := 389; mySet('^') := 422; mySet('_') := 500; mySet('`') := 333; mySet('a') := 500; mySet('b') := 500; mySet('c') := 444; mySet('d') := 500; mySet('e') := 444; mySet('f') := 278; mySet('g') := 500; mySet('h') := 500; mySet('i') := 278; mySet('j') := 278; mySet('k') := 444; mySet('l') := 278; mySet('m') := 722; mySet('n') := 500; mySet('o') := 500; mySet('p') := 500; mySet('q') := 500; mySet('r') := 389; mySet('s') := 389; mySet('t') := 278; mySet('u') := 500; mySet('v') := 444; mySet('w') := 667; mySet('x') := 444; mySet('y') := 444; mySet('z') := 389; mySet('{') := 400; mySet('|') := 275; mySet('}') := 400; mySet('~') := 541; mySet(chr(127)) := 350; mySet(chr(128)) := 500; mySet(chr(129)) := 350; mySet(chr(130)) := 333; mySet(chr(131)) := 500; mySet(chr(132)) := 556; mySet(chr(133)) := 889; mySet(chr(134)) := 500; mySet(chr(135)) := 500; mySet(chr(136)) := 333; mySet(chr(137)) := 1000; mySet(chr(138)) := 500; mySet(chr(139)) := 333; mySet(chr(140)) := 944; mySet(chr(141)) := 350; mySet(chr(142)) := 556; mySet(chr(143)) := 350; mySet(chr(144)) := 350; mySet(chr(145)) := 333; mySet(chr(146)) := 333; mySet(chr(147)) := 556; mySet(chr(148)) := 556; mySet(chr(149)) := 350; mySet(chr(150)) := 500; mySet(chr(151)) := 889; mySet(chr(152)) := 333; mySet(chr(153)) := 980; mySet(chr(154)) := 389; mySet(chr(155)) := 333; mySet(chr(156)) := 667; mySet(chr(157)) := 350; mySet(chr(158)) := 389; mySet(chr(159)) := 556; mySet(chr(160)) := 250; mySet(chr(161)) := 389; mySet(chr(162)) := 500; mySet(chr(163)) := 500; mySet(chr(164)) := 500; mySet(chr(165)) := 500; mySet(chr(166)) := 275; mySet(chr(167)) := 500; mySet(chr(168)) := 333; mySet(chr(169)) := 760; mySet(chr(170)) := 276; mySet(chr(171)) := 500; mySet(chr(172)) := 675; mySet(chr(173)) := 333; mySet(chr(174)) := 760; mySet(chr(175)) := 333; mySet(chr(176)) := 400; mySet(chr(177)) := 675; mySet(chr(178)) := 300; mySet(chr(179)) := 300; mySet(chr(180)) := 333; mySet(chr(181)) := 500; mySet(chr(182)) := 523; mySet(chr(183)) := 250; mySet(chr(184)) := 333; mySet(chr(185)) := 300; mySet(chr(186)) := 310; mySet(chr(187)) := 500; mySet(chr(188)) := 750; mySet(chr(189)) := 750; mySet(chr(190)) := 750; mySet(chr(191)) := 500; mySet(chr(192)) := 611; mySet(chr(193)) := 611; mySet(chr(194)) := 611; mySet(chr(195)) := 611; mySet(chr(196)) := 611; mySet(chr(197)) := 611; mySet(chr(198)) := 889; mySet(chr(199)) := 667; mySet(chr(200)) := 611; mySet(chr(201)) := 611; mySet(chr(202)) := 611; mySet(chr(203)) := 611; mySet(chr(204)) := 333; mySet(chr(205)) := 333; mySet(chr(206)) := 333; mySet(chr(207)) := 333; mySet(chr(208)) := 722; mySet(chr(209)) := 667; mySet(chr(210)) := 722; mySet(chr(211)) := 722; mySet(chr(212)) := 722; mySet(chr(213)) := 722; mySet(chr(214)) := 722; mySet(chr(215)) := 675; mySet(chr(216)) := 722; mySet(chr(217)) := 722; mySet(chr(218)) := 722; mySet(chr(219)) := 722; mySet(chr(220)) := 722; mySet(chr(221)) := 556; mySet(chr(222)) := 611; mySet(chr(223)) := 500; mySet(chr(224)) := 500; mySet(chr(225)) := 500; mySet(chr(226)) := 500; mySet(chr(227)) := 500; mySet(chr(228)) := 500; mySet(chr(229)) := 500; mySet(chr(230)) := 667; mySet(chr(231)) := 444; mySet(chr(232)) := 444; mySet(chr(233)) := 444; mySet(chr(234)) := 444; mySet(chr(235)) := 444; mySet(chr(236)) := 278; mySet(chr(237)) := 278; mySet(chr(238)) := 278; mySet(chr(239)) := 278; mySet(chr(240)) := 500; mySet(chr(241)) := 500; mySet(chr(242)) := 500; mySet(chr(243)) := 500; mySet(chr(244)) := 500; mySet(chr(245)) := 500; mySet(chr(246)) := 500; mySet(chr(247)) := 675; mySet(chr(248)) := 500; mySet(chr(249)) := 500; mySet(chr(250)) := 500; mySet(chr(251)) := 500; mySet(chr(252)) := 500; mySet(chr(253)) := 444; mySet(chr(254)) := 500; mySet(chr(255)) := 444; return mySet; end getFontTimesi; ---------------------------------------------------------------------------------- -- Setting metric for times BOLD ---------------------------------------------------------------------------------- function getFontTimesb return charSet is mySet charSet; begin -- Times bold font. mySet(chr(0)) := 250; mySet(chr(1)) := 250; mySet(chr(2)) := 250; mySet(chr(3)) := 250; mySet(chr(4)) := 250; mySet(chr(5)) := 250; mySet(chr(6)) := 250; mySet(chr(7)) := 250; mySet(chr(8)) := 250; mySet(chr(9)) := 250; mySet(chr(10)) := 250; mySet(chr(11)) := 250; mySet(chr(12)) := 250; mySet(chr(13)) := 250; mySet(chr(14)) := 250; mySet(chr(15)) := 250; mySet(chr(16)) := 250; mySet(chr(17)) := 250; mySet(chr(18)) := 250; mySet(chr(19)) := 250; mySet(chr(20)) := 250; mySet(chr(21)) := 250; mySet(chr(22)) := 250; mySet(chr(23)) := 250; mySet(chr(24)) := 250; mySet(chr(25)) := 250; mySet(chr(26)) := 250; mySet(chr(27)) := 250; mySet(chr(28)) := 250; mySet(chr(29)) := 250; mySet(chr(30)) := 250; mySet(chr(31)) := 250; mySet(' ') := 250; mySet('!') := 333; mySet('"') := 555; mySet('#') := 500; mySet('$') := 500; mySet('%') := 1000; mySet('&') := 833; mySet('''') := 278; mySet('(') := 333; mySet(')') := 333; mySet('*') := 500; mySet('+') := 570; mySet(',') := 250; mySet('-') := 333; mySet('.') := 250; mySet('/') := 278; mySet('0') := 500; mySet('1') := 500; mySet('2') := 500; mySet('3') := 500; mySet('4') := 500; mySet('5') := 500; mySet('6') := 500; mySet('7') := 500; mySet('8') := 500; mySet('9') := 500; mySet(':') := 333; mySet(';') := 333; mySet('<') := 570; mySet('=') := 570; mySet('>') := 570; mySet('?') := 500; mySet('@') := 930; mySet('A') := 722; mySet('B') := 667; mySet('C') := 722; mySet('D') := 722; mySet('E') := 667; mySet('F') := 611; mySet('G') := 778; mySet('H') := 778; mySet('I') := 389; mySet('J') := 500; mySet('K') := 778; mySet('L') := 667; mySet('M') := 944; mySet('N') := 722; mySet('O') := 778; mySet('P') := 611; mySet('Q') := 778; mySet('R') := 722; mySet('S') := 556; mySet('T') := 667; mySet('U') := 722; mySet('V') := 722; mySet('W') := 1000; mySet('X') := 722; mySet('Y') := 722; mySet('Z') := 667; mySet('[') := 333; mySet('\') := 278; mySet(']') := 333; mySet('^') := 581; mySet('_') := 500; mySet('`') := 333; mySet('a') := 500; mySet('b') := 556; mySet('c') := 444; mySet('d') := 556; mySet('e') := 444; mySet('f') := 333; mySet('g') := 500; mySet('h') := 556; mySet('i') := 278; mySet('j') := 333; mySet('k') := 556; mySet('l') := 278; mySet('m') := 833; mySet('n') := 556; mySet('o') := 500; mySet('p') := 556; mySet('q') := 556; mySet('r') := 444; mySet('s') := 389; mySet('t') := 333; mySet('u') := 556; mySet('v') := 500; mySet('w') := 722; mySet('x') := 500; mySet('y') := 500; mySet('z') := 444; mySet('{') := 394; mySet('|') := 220; mySet('}') := 394; mySet('~') := 520; mySet(chr(127)) := 350; mySet(chr(128)) := 500; mySet(chr(129)) := 350; mySet(chr(130)) := 333; mySet(chr(131)) := 500; mySet(chr(132)) := 500; mySet(chr(133)) := 1000; mySet(chr(134)) := 500; mySet(chr(135)) := 500; mySet(chr(136)) := 333; mySet(chr(137)) := 1000; mySet(chr(138)) := 556; mySet(chr(139)) := 333; mySet(chr(140)) := 1000; mySet(chr(141)) := 350; mySet(chr(142)) := 667; mySet(chr(143)) := 350; mySet(chr(144)) := 350; mySet(chr(145)) := 333; mySet(chr(146)) := 333; mySet(chr(147)) := 500; mySet(chr(148)) := 500; mySet(chr(149)) := 350; mySet(chr(150)) := 500; mySet(chr(151)) := 1000; mySet(chr(152)) := 333; mySet(chr(153)) := 1000; mySet(chr(154)) := 389; mySet(chr(155)) := 333; mySet(chr(156)) := 722; mySet(chr(157)) := 350; mySet(chr(158)) := 444; mySet(chr(159)) := 722; mySet(chr(160)) := 250; mySet(chr(161)) := 333; mySet(chr(162)) := 500; mySet(chr(163)) := 500; mySet(chr(164)) := 500; mySet(chr(165)) := 500; mySet(chr(166)) := 220; mySet(chr(167)) := 500; mySet(chr(168)) := 333; mySet(chr(169)) := 747; mySet(chr(170)) := 300; mySet(chr(171)) := 500; mySet(chr(172)) := 570; mySet(chr(173)) := 333; mySet(chr(174)) := 747; mySet(chr(175)) := 333; mySet(chr(176)) := 400; mySet(chr(177)) := 570; mySet(chr(178)) := 300; mySet(chr(179)) := 300; mySet(chr(180)) := 333; mySet(chr(181)) := 556; mySet(chr(182)) := 540; mySet(chr(183)) := 250; mySet(chr(184)) := 333; mySet(chr(185)) := 300; mySet(chr(186)) := 330; mySet(chr(187)) := 500; mySet(chr(188)) := 750; mySet(chr(189)) := 750; mySet(chr(190)) := 750; mySet(chr(191)) := 500; mySet(chr(192)) := 722; mySet(chr(193)) := 722; mySet(chr(194)) := 722; mySet(chr(195)) := 722; mySet(chr(196)) := 722; mySet(chr(197)) := 722; mySet(chr(198)) := 1000; mySet(chr(199)) := 722; mySet(chr(200)) := 667; mySet(chr(201)) := 667; mySet(chr(202)) := 667; mySet(chr(203)) := 667; mySet(chr(204)) := 389; mySet(chr(205)) := 389; mySet(chr(206)) := 389; mySet(chr(207)) := 389; mySet(chr(208)) := 722; mySet(chr(209)) := 722; mySet(chr(210)) := 778; mySet(chr(211)) := 778; mySet(chr(212)) := 778; mySet(chr(213)) := 778; mySet(chr(214)) := 778; mySet(chr(215)) := 570; mySet(chr(216)) := 778; mySet(chr(217)) := 722; mySet(chr(218)) := 722; mySet(chr(219)) := 722; mySet(chr(220)) := 722; mySet(chr(221)) := 722; mySet(chr(222)) := 611; mySet(chr(223)) := 556; mySet(chr(224)) := 500; mySet(chr(225)) := 500; mySet(chr(226)) := 500; mySet(chr(227)) := 500; mySet(chr(228)) := 500; mySet(chr(229)) := 500; mySet(chr(230)) := 722; mySet(chr(231)) := 444; mySet(chr(232)) := 444; mySet(chr(233)) := 444; mySet(chr(234)) := 444; mySet(chr(235)) := 444; mySet(chr(236)) := 278; mySet(chr(237)) := 278; mySet(chr(238)) := 278; mySet(chr(239)) := 278; mySet(chr(240)) := 500; mySet(chr(241)) := 556; mySet(chr(242)) := 500; mySet(chr(243)) := 500; mySet(chr(244)) := 500; mySet(chr(245)) := 500; mySet(chr(246)) := 500; mySet(chr(247)) := 570; mySet(chr(248)) := 500; mySet(chr(249)) := 556; mySet(chr(250)) := 556; mySet(chr(251)) := 556; mySet(chr(252)) := 556; mySet(chr(253)) := 500; mySet(chr(254)) := 556; mySet(chr(255)) := 500; return mySet; end getFontTimesb; ---------------------------------------------------------------------------------- -- Setting metric for times BOLD ITALIC ---------------------------------------------------------------------------------- function getFontTimesbi return charSet is mySet charSet; begin -- Times bold italic font. mySet(chr(0)) := 250; mySet(chr(1)) := 250; mySet(chr(2)) := 250; mySet(chr(3)) := 250; mySet(chr(4)) := 250; mySet(chr(5)) := 250; mySet(chr(6)) := 250; mySet(chr(7)) := 250; mySet(chr(8)) := 250; mySet(chr(9)) := 250; mySet(chr(10)) := 250; mySet(chr(11)) := 250; mySet(chr(12)) := 250; mySet(chr(13)) := 250; mySet(chr(14)) := 250; mySet(chr(15)) := 250; mySet(chr(16)) := 250; mySet(chr(17)) := 250; mySet(chr(18)) := 250; mySet(chr(19)) := 250; mySet(chr(20)) := 250; mySet(chr(21)) := 250; mySet(chr(22)) := 250; mySet(chr(23)) := 250; mySet(chr(24)) := 250; mySet(chr(25)) := 250; mySet(chr(26)) := 250; mySet(chr(27)) := 250; mySet(chr(28)) := 250; mySet(chr(29)) := 250; mySet(chr(30)) := 250; mySet(chr(31)) := 250; mySet(' ') := 250; mySet('!') := 389; mySet('"') := 555; mySet('#') := 500; mySet('$') := 500; mySet('%') := 833; mySet('&') := 778; mySet('''') := 278; mySet('(') := 333; mySet(')') := 333; mySet('*') := 500; mySet('+') := 570; mySet(',') := 250; mySet('-') := 333; mySet('.') := 250; mySet('/') := 278; mySet('0') := 500; mySet('1') := 500; mySet('2') := 500; mySet('3') := 500; mySet('4') := 500; mySet('5') := 500; mySet('6') := 500; mySet('7') := 500; mySet('8') := 500; mySet('9') := 500; mySet(':') := 333; mySet(';') := 333; mySet('<') := 570; mySet('=') := 570; mySet('>') := 570; mySet('?') := 500; mySet('@') := 832; mySet('A') := 667; mySet('B') := 667; mySet('C') := 667; mySet('D') := 722; mySet('E') := 667; mySet('F') := 667; mySet('G') := 722; mySet('H') := 778; mySet('I') := 389; mySet('J') := 500; mySet('K') := 667; mySet('L') := 611; mySet('M') := 889; mySet('N') := 722; mySet('O') := 722; mySet('P') := 611; mySet('Q') := 722; mySet('R') := 667; mySet('S') := 556; mySet('T') := 611; mySet('U') := 722; mySet('V') := 667; mySet('W') := 889; mySet('X') := 667; mySet('Y') := 611; mySet('Z') := 611; mySet('[') := 333; mySet('\') := 278; mySet(']') := 333; mySet('^') := 570; mySet('_') := 500; mySet('`') := 333; mySet('a') := 500; mySet('b') := 500; mySet('c') := 444; mySet('d') := 500; mySet('e') := 444; mySet('f') := 333; mySet('g') := 500; mySet('h') := 556; mySet('i') := 278; mySet('j') := 278; mySet('k') := 500; mySet('l') := 278; mySet('m') := 778; mySet('n') := 556; mySet('o') := 500; mySet('p') := 500; mySet('q') := 500; mySet('r') := 389; mySet('s') := 389; mySet('t') := 278; mySet('u') := 556; mySet('v') := 444; mySet('w') := 667; mySet('x') := 500; mySet('y') := 444; mySet('z') := 389; mySet('{') := 348; mySet('|') := 220; mySet('}') := 348; mySet('~') := 570; mySet(chr(127)) := 350; mySet(chr(128)) := 500; mySet(chr(129)) := 350; mySet(chr(130)) := 333; mySet(chr(131)) := 500; mySet(chr(132)) := 500; mySet(chr(133)) := 1000; mySet(chr(134)) := 500; mySet(chr(135)) := 500; mySet(chr(136)) := 333; mySet(chr(137)) := 1000; mySet(chr(138)) := 556; mySet(chr(139)) := 333; mySet(chr(140)) := 944; mySet(chr(141)) := 350; mySet(chr(142)) := 611; mySet(chr(143)) := 350; mySet(chr(144)) := 350; mySet(chr(145)) := 333; mySet(chr(146)) := 333; mySet(chr(147)) := 500; mySet(chr(148)) := 500; mySet(chr(149)) := 350; mySet(chr(150)) := 500; mySet(chr(151)) := 1000; mySet(chr(152)) := 333; mySet(chr(153)) := 1000; mySet(chr(154)) := 389; mySet(chr(155)) := 333; mySet(chr(156)) := 722; mySet(chr(157)) := 350; mySet(chr(158)) := 389; mySet(chr(159)) := 611; mySet(chr(160)) := 250; mySet(chr(161)) := 389; mySet(chr(162)) := 500; mySet(chr(163)) := 500; mySet(chr(164)) := 500; mySet(chr(165)) := 500; mySet(chr(166)) := 220; mySet(chr(167)) := 500; mySet(chr(168)) := 333; mySet(chr(169)) := 747; mySet(chr(170)) := 266; mySet(chr(171)) := 500; mySet(chr(172)) := 606; mySet(chr(173)) := 333; mySet(chr(174)) := 747; mySet(chr(175)) := 333; mySet(chr(176)) := 400; mySet(chr(177)) := 570; mySet(chr(178)) := 300; mySet(chr(179)) := 300; mySet(chr(180)) := 333; mySet(chr(181)) := 576; mySet(chr(182)) := 500; mySet(chr(183)) := 250; mySet(chr(184)) := 333; mySet(chr(185)) := 300; mySet(chr(186)) := 300; mySet(chr(187)) := 500; mySet(chr(188)) := 750; mySet(chr(189)) := 750; mySet(chr(190)) := 750; mySet(chr(191)) := 500; mySet(chr(192)) := 667; mySet(chr(193)) := 667; mySet(chr(194)) := 667; mySet(chr(195)) := 667; mySet(chr(196)) := 667; mySet(chr(197)) := 667; mySet(chr(198)) := 944; mySet(chr(199)) := 667; mySet(chr(200)) := 667; mySet(chr(201)) := 667; mySet(chr(202)) := 667; mySet(chr(203)) := 667; mySet(chr(204)) := 389; mySet(chr(205)) := 389; mySet(chr(206)) := 389; mySet(chr(207)) := 389; mySet(chr(208)) := 722; mySet(chr(209)) := 722; mySet(chr(210)) := 722; mySet(chr(211)) := 722; mySet(chr(212)) := 722; mySet(chr(213)) := 722; mySet(chr(214)) := 722; mySet(chr(215)) := 570; mySet(chr(216)) := 722; mySet(chr(217)) := 722; mySet(chr(218)) := 722; mySet(chr(219)) := 722; mySet(chr(220)) := 722; mySet(chr(221)) := 611; mySet(chr(222)) := 611; mySet(chr(223)) := 500; mySet(chr(224)) := 500; mySet(chr(225)) := 500; mySet(chr(226)) := 500; mySet(chr(227)) := 500; mySet(chr(228)) := 500; mySet(chr(229)) := 500; mySet(chr(230)) := 722; mySet(chr(231)) := 444; mySet(chr(232)) := 444; mySet(chr(233)) := 444; mySet(chr(234)) := 444; mySet(chr(235)) := 444; mySet(chr(236)) := 278; mySet(chr(237)) := 278; mySet(chr(238)) := 278; mySet(chr(239)) := 278; mySet(chr(240)) := 500; mySet(chr(241)) := 556; mySet(chr(242)) := 500; mySet(chr(243)) := 500; mySet(chr(244)) := 500; mySet(chr(245)) := 500; mySet(chr(246)) := 500; mySet(chr(247)) := 570; mySet(chr(248)) := 500; mySet(chr(249)) := 556; mySet(chr(250)) := 556; mySet(chr(251)) := 556; mySet(chr(252)) := 556; mySet(chr(253)) := 444; mySet(chr(254)) := 500; mySet(chr(255)) := 444; return mySet; end getFontTimesbi; ---------------------------------------------------------------------------------- -- Setting metric for Symbol ---------------------------------------------------------------------------------- function getFontSymbol return charSet is mySet charSet; begin -- Symbol font. mySet(chr(0)) := 250; mySet(chr(1)) := 250; mySet(chr(2)) := 250; mySet(chr(3)) := 250; mySet(chr(4)) := 250; mySet(chr(5)) := 250; mySet(chr(6)) := 250; mySet(chr(7)) := 250; mySet(chr(8)) := 250; mySet(chr(9)) := 250; mySet(chr(10)) := 250; mySet(chr(11)) := 250; mySet(chr(12)) := 250; mySet(chr(13)) := 250; mySet(chr(14)) := 250; mySet(chr(15)) := 250; mySet(chr(16)) := 250; mySet(chr(17)) := 250; mySet(chr(18)) := 250; mySet(chr(19)) := 250; mySet(chr(20)) := 250; mySet(chr(21)) := 250; mySet(chr(22)) := 250; mySet(chr(23)) := 250; mySet(chr(24)) := 250; mySet(chr(25)) := 250; mySet(chr(26)) := 250; mySet(chr(27)) := 250; mySet(chr(28)) := 250; mySet(chr(29)) := 250; mySet(chr(30)) := 250; mySet(chr(31)) := 250; mySet(' ') := 250; mySet('!') := 333; mySet('"') := 713; mySet('#') := 500; mySet('$') := 549; mySet('%') := 833; mySet('&') := 778; mySet('''') := 439; mySet('(') := 333; mySet(')') := 333; mySet('*') := 500; mySet('+') := 549; mySet(',') := 250; mySet('-') := 549; mySet('.') := 250; mySet('/') := 278; mySet('0') := 500; mySet('1') := 500; mySet('2') := 500; mySet('3') := 500; mySet('4') := 500; mySet('5') := 500; mySet('6') := 500; mySet('7') := 500; mySet('8') := 500; mySet('9') := 500; mySet(':') := 278; mySet(';') := 278; mySet('<') := 549; mySet('=') := 549; mySet('>') := 549; mySet('?') := 444; mySet('@') := 549; mySet('A') := 722; mySet('B') := 667; mySet('C') := 722; mySet('D') := 612; mySet('E') := 611; mySet('F') := 763; mySet('G') := 603; mySet('H') := 722; mySet('I') := 333; mySet('J') := 631; mySet('K') := 722; mySet('L') := 686; mySet('M') := 889; mySet('N') := 722; mySet('O') := 722; mySet('P') := 768; mySet('Q') := 741; mySet('R') := 556; mySet('S') := 592; mySet('T') := 611; mySet('U') := 690; mySet('V') := 439; mySet('W') := 768; mySet('X') := 645; mySet('Y') := 795; mySet('Z') := 611; mySet('[') := 333; mySet('\') := 863; mySet(']') := 333; mySet('^') := 658; mySet('_') := 500; mySet('`') := 500; mySet('a') := 631; mySet('b') := 549; mySet('c') := 549; mySet('d') := 494; mySet('e') := 439; mySet('f') := 521; mySet('g') := 411; mySet('h') := 603; mySet('i') := 329; mySet('j') := 603; mySet('k') := 549; mySet('l') := 549; mySet('m') := 576; mySet('n') := 521; mySet('o') := 549; mySet('p') := 549; mySet('q') := 521; mySet('r') := 549; mySet('s') := 603; mySet('t') := 439; mySet('u') := 576; mySet('v') := 713; mySet('w') := 686; mySet('x') := 493; mySet('y') := 686; mySet('z') := 494; mySet('{') := 480; mySet('|') := 200; mySet('}') := 480; mySet('~') := 549; mySet(chr(127)) := 0; mySet(chr(128)) := 0; mySet(chr(129)) := 0; mySet(chr(130)) := 0; mySet(chr(131)) := 0; mySet(chr(132)) := 0; mySet(chr(133)) := 0; mySet(chr(134)) := 0; mySet(chr(135)) := 0; mySet(chr(136)) := 0; mySet(chr(137)) := 0; mySet(chr(138)) := 0; mySet(chr(139)) := 0; mySet(chr(140)) := 0; mySet(chr(141)) := 0; mySet(chr(142)) := 0; mySet(chr(143)) := 0; mySet(chr(144)) := 0; mySet(chr(145)) := 0; mySet(chr(146)) := 0; mySet(chr(147)) := 0; mySet(chr(148)) := 0; mySet(chr(149)) := 0; mySet(chr(150)) := 0; mySet(chr(151)) := 0; mySet(chr(152)) := 0; mySet(chr(153)) := 0; mySet(chr(154)) := 0; mySet(chr(155)) := 0; mySet(chr(156)) := 0; mySet(chr(157)) := 0; mySet(chr(158)) := 0; mySet(chr(159)) := 0; mySet(chr(160)) := 750; mySet(chr(161)) := 620; mySet(chr(162)) := 247; mySet(chr(163)) := 549; mySet(chr(164)) := 167; mySet(chr(165)) := 713; mySet(chr(166)) := 500; mySet(chr(167)) := 753; mySet(chr(168)) := 753; mySet(chr(169)) := 753; mySet(chr(170)) := 753; mySet(chr(171)) := 1042; mySet(chr(172)) := 987; mySet(chr(173)) := 603; mySet(chr(174)) := 987; mySet(chr(175)) := 603; mySet(chr(176)) := 400; mySet(chr(177)) := 549; mySet(chr(178)) := 411; mySet(chr(179)) := 549; mySet(chr(180)) := 549; mySet(chr(181)) := 713; mySet(chr(182)) := 494; mySet(chr(183)) := 460; mySet(chr(184)) := 549; mySet(chr(185)) := 549; mySet(chr(186)) := 549; mySet(chr(187)) := 549; mySet(chr(188)) := 1000; mySet(chr(189)) := 603; mySet(chr(190)) := 1000; mySet(chr(191)) := 658; mySet(chr(192)) := 823; mySet(chr(193)) := 686; mySet(chr(194)) := 795; mySet(chr(195)) := 987; mySet(chr(196)) := 768; mySet(chr(197)) := 768; mySet(chr(198)) := 823; mySet(chr(199)) := 768; mySet(chr(200)) := 768; mySet(chr(201)) := 713; mySet(chr(202)) := 713; mySet(chr(203)) := 713; mySet(chr(204)) := 713; mySet(chr(205)) := 713; mySet(chr(206)) := 713; mySet(chr(207)) := 713; mySet(chr(208)) := 768; mySet(chr(209)) := 713; mySet(chr(210)) := 790; mySet(chr(211)) := 790; mySet(chr(212)) := 890; mySet(chr(213)) := 823; mySet(chr(214)) := 549; mySet(chr(215)) := 250; mySet(chr(216)) := 713; mySet(chr(217)) := 603; mySet(chr(218)) := 603; mySet(chr(219)) := 1042; mySet(chr(220)) := 987; mySet(chr(221)) := 603; mySet(chr(222)) := 987; mySet(chr(223)) := 603; mySet(chr(224)) := 494; mySet(chr(225)) := 329; mySet(chr(226)) := 790; mySet(chr(227)) := 790; mySet(chr(228)) := 786; mySet(chr(229)) := 713; mySet(chr(230)) := 384; mySet(chr(231)) := 384; mySet(chr(232)) := 384; mySet(chr(233)) := 384; mySet(chr(234)) := 384; mySet(chr(235)) := 384; mySet(chr(236)) := 494; mySet(chr(237)) := 494; mySet(chr(238)) := 494; mySet(chr(239)) := 494; mySet(chr(240)) := 0; mySet(chr(241)) := 329; mySet(chr(242)) := 274; mySet(chr(243)) := 686; mySet(chr(244)) := 686; mySet(chr(245)) := 686; mySet(chr(246)) := 384; mySet(chr(247)) := 384; mySet(chr(248)) := 384; mySet(chr(249)) := 384; mySet(chr(250)) := 384; mySet(chr(251)) := 384; mySet(chr(252)) := 494; mySet(chr(253)) := 494; mySet(chr(254)) := 494; mySet(chr(255)) := 0; return mySet; end getFontSymbol; ---------------------------------------------------------------------------------- -- Setting metric for zapfdingbats ---------------------------------------------------------------------------------- function getFontZapfdingbats return charSet is mySet charSet; begin -- zapfdingbats font. mySet(chr(0)) := 0; mySet(chr(1)) := 0; mySet(chr(2)) := 0; mySet(chr(3)) := 0; mySet(chr(4)) := 0; mySet(chr(5)) := 0; mySet(chr(6)) := 0; mySet(chr(7)) := 0; mySet(chr(8)) := 0; mySet(chr(9)) := 0; mySet(chr(10)) := 0; mySet(chr(11)) := 0; mySet(chr(12)) := 0; mySet(chr(13)) := 0; mySet(chr(14)) := 0; mySet(chr(15)) := 0; mySet(chr(16)) := 0; mySet(chr(17)) := 0; mySet(chr(18)) := 0; mySet(chr(19)) := 0; mySet(chr(20)) := 0; mySet(chr(21)) := 0; mySet(chr(22)) := 0; mySet(chr(23)) := 0; mySet(chr(24)) := 0; mySet(chr(25)) := 0; mySet(chr(26)) := 0; mySet(chr(27)) := 0; mySet(chr(28)) := 0; mySet(chr(29)) := 0; mySet(chr(30)) := 0; mySet(chr(31)) := 0; mySet(' ') := 278; mySet('!') := 974; mySet('"') := 961; mySet('#') := 974; mySet('$') := 980; mySet('%') := 719; mySet('&') := 789; mySet('''') := 790; mySet('(') := 791; mySet(')') := 690; mySet('*') := 960; mySet('+') := 939; mySet(',') := 549; mySet('-') := 855; mySet('.') := 911; mySet('/') := 933; mySet('0') := 911; mySet('1') := 945; mySet('2') := 974; mySet('3') := 755; mySet('4') := 846; mySet('5') := 762; mySet('6') := 761; mySet('7') := 571; mySet('8') := 677; mySet('9') := 763; mySet(':') := 760; mySet(';') := 759; mySet('<') := 754; mySet('=') := 494; mySet('>') := 552; mySet('?') := 537; mySet('@') := 577; mySet('A') := 692; mySet('B') := 786; mySet('C') := 788; mySet('D') := 788; mySet('E') := 790; mySet('F') := 793; mySet('G') := 794; mySet('H') := 816; mySet('I') := 823; mySet('J') := 789; mySet('K') := 841; mySet('L') := 823; mySet('M') := 833; mySet('N') := 816; mySet('O') := 831; mySet('P') := 923; mySet('Q') := 744; mySet('R') := 723; mySet('S') := 749; mySet('T') := 790; mySet('U') := 792; mySet('V') := 695; mySet('W') := 776; mySet('X') := 768; mySet('Y') := 792; mySet('Z') := 759; mySet('[') := 707; mySet('\') := 708; mySet(']') := 682; mySet('^') := 701; mySet('_') := 826; mySet('`') := 815; mySet('a') := 789; mySet('b') := 789; mySet('c') := 707; mySet('d') := 687; mySet('e') := 696; mySet('f') := 689; mySet('g') := 786; mySet('h') := 787; mySet('i') := 713; mySet('j') := 791; mySet('k') := 785; mySet('l') := 791; mySet('m') := 873; mySet('n') := 761; mySet('o') := 762; mySet('p') := 762; mySet('q') := 759; mySet('r') := 759; mySet('s') := 892; mySet('t') := 892; mySet('u') := 788; mySet('v') := 784; mySet('w') := 438; mySet('x') := 138; mySet('y') := 277; mySet('z') := 415; mySet('{') := 392; mySet('|') := 392; mySet('}') := 668; mySet('~') := 668; mySet(chr(127)) := 0; mySet(chr(128)) := 390; mySet(chr(129)) := 390; mySet(chr(130)) := 317; mySet(chr(131)) := 317; mySet(chr(132)) := 276; mySet(chr(133)) := 276; mySet(chr(134)) := 509; mySet(chr(135)) := 509; mySet(chr(136)) := 410; mySet(chr(137)) := 410; mySet(chr(138)) := 234; mySet(chr(139)) := 234; mySet(chr(140)) := 334; mySet(chr(141)) := 334; mySet(chr(142)) := 0; mySet(chr(143)) := 0; mySet(chr(144)) := 0; mySet(chr(145)) := 0; mySet(chr(146)) := 0; mySet(chr(147)) := 0; mySet(chr(148)) := 0; mySet(chr(149)) := 0; mySet(chr(150)) := 0; mySet(chr(151)) := 0; mySet(chr(152)) := 0; mySet(chr(153)) := 0; mySet(chr(154)) := 0; mySet(chr(155)) := 0; mySet(chr(156)) := 0; mySet(chr(157)) := 0; mySet(chr(158)) := 0; mySet(chr(159)) := 0; mySet(chr(160)) := 0; mySet(chr(161)) := 732; mySet(chr(162)) := 544; mySet(chr(163)) := 544; mySet(chr(164)) := 910; mySet(chr(165)) := 667; mySet(chr(166)) := 760; mySet(chr(167)) := 760; mySet(chr(168)) := 776; mySet(chr(169)) := 595; mySet(chr(170)) := 694; mySet(chr(171)) := 626; mySet(chr(172)) := 788; mySet(chr(173)) := 788; mySet(chr(174)) := 788; mySet(chr(175)) := 788; mySet(chr(176)) := 788; mySet(chr(177)) := 788; mySet(chr(178)) := 788; mySet(chr(179)) := 788; mySet(chr(180)) := 788; mySet(chr(181)) := 788; mySet(chr(182)) := 788; mySet(chr(183)) := 788; mySet(chr(184)) := 788; mySet(chr(185)) := 788; mySet(chr(186)) := 788; mySet(chr(187)) := 788; mySet(chr(188)) := 788; mySet(chr(189)) := 788; mySet(chr(190)) := 788; mySet(chr(191)) := 788; mySet(chr(192)) := 788; mySet(chr(193)) := 788; mySet(chr(194)) := 788; mySet(chr(195)) := 788; mySet(chr(196)) := 788; mySet(chr(197)) := 788; mySet(chr(198)) := 788; mySet(chr(199)) := 788; mySet(chr(200)) := 788; mySet(chr(201)) := 788; mySet(chr(202)) := 788; mySet(chr(203)) := 788; mySet(chr(204)) := 788; mySet(chr(205)) := 788; mySet(chr(206)) := 788; mySet(chr(207)) := 788; mySet(chr(208)) := 788; mySet(chr(209)) := 788; mySet(chr(210)) := 788; mySet(chr(211)) := 788; mySet(chr(212)) := 894; mySet(chr(213)) := 838; mySet(chr(214)) := 1016; mySet(chr(215)) := 458; mySet(chr(216)) := 748; mySet(chr(217)) := 924; mySet(chr(218)) := 748; mySet(chr(219)) := 918; mySet(chr(220)) := 927; mySet(chr(221)) := 928; mySet(chr(222)) := 928; mySet(chr(223)) := 834; mySet(chr(224)) := 873; mySet(chr(225)) := 828; mySet(chr(226)) := 924; mySet(chr(227)) := 924; mySet(chr(228)) := 917; mySet(chr(229)) := 930; mySet(chr(230)) := 931; mySet(chr(231)) := 463; mySet(chr(232)) := 883; mySet(chr(233)) := 836; mySet(chr(234)) := 836; mySet(chr(235)) := 867; mySet(chr(236)) := 867; mySet(chr(237)) := 696; mySet(chr(238)) := 696; mySet(chr(239)) := 874; mySet(chr(240)) := 0; mySet(chr(241)) := 874; mySet(chr(242)) := 760; mySet(chr(243)) := 946; mySet(chr(244)) := 771; mySet(chr(245)) := 865; mySet(chr(246)) := 771; mySet(chr(247)) := 888; mySet(chr(248)) := 967; mySet(chr(249)) := 888; mySet(chr(250)) := 831; mySet(chr(251)) := 873; mySet(chr(252)) := 927; mySet(chr(253)) := 970; mySet(chr(254)) := 918; mySet(chr(255)) := 0; return mySet; end getFontZapfdingbats; ---------------------------------------------------------------------------------- -- Inclusion des métriques d'une font. ---------------------------------------------------------------------------------- procedure p_includeFont (pfontname varchar2) is mySet charSet; begin if (pfontname is not null) then case pfontname when 'courier' then -- courier mySet := getFontCourier; fpdf_charwidths(pfontname||'B') := mySet; fpdf_charwidths(pfontname||'I') := mySet; fpdf_charwidths(pfontname||'BI') := mySet; when 'helvetica' then -- helvetica font. mySet := getFontHelvetica; -- when 'helveticaI' then -- helvetica italic font. mySet := getFontHelveticai; -- when 'helveticaB' then -- helvetica bold font. mySet := getFontHelveticab; -- when 'helveticaBI' then -- helvetica bold italic font. mySet := getFontHelveticabi; -- when 'times' then -- times font. mySet := getFontTimes; -- when 'timesI' then -- times italic font. mySet := getFontTimesi; -- when 'timesB' then -- times bold font. mySet := getFontTimesb; -- when 'timesBI' then -- times bold italic font. mySet := getFontTimesbi; -- when 'symbol' then -- symbol font. mySet := getFontSymbol; -- when 'zapfdingbats' then -- zapfdingbats font. mySet := getFontZapfdingbats; -- else null; end case; fpdf_charwidths(pfontname) := mySet; end if; end p_includeFont; ---------------------------------------------------------------------------------- -- p_getFontMetrics : récupérer les metric d'une font. ---------------------------------------------------------------------------------- function p_getFontMetrics(pFontName varchar2) return charSet is mySet charSet; begin if (pfontname is not null) then case pfontname when 'courier' then -- courier mySet := getFontCourier; when 'helvetica' then -- helvetica font. mySet := getFontHelvetica; -- when 'helveticaI' then -- helvetica italic font. mySet := getFontHelveticai; -- when 'helveticaB' then -- helvetica bold font. mySet := getFontHelveticab; -- when 'helveticaBI' then -- helvetica bold italic font. mySet := getFontHelveticabi; -- when 'times' then -- times font. mySet := getFontTimes; -- when 'timesI' then -- times italic font. mySet := getFontTimesi; -- when 'timesI' then -- times bold font. mySet := getFontTimesb; -- when 'timesBI' then -- times bold italic font. mySet := getFontTimesbi; -- when 'symbol' then -- symbol font. mySet := getFontSymbol; -- when 'zapfdingbats' then -- zapfdingbats font. mySet := getFontZapfdingbats; -- else null; end case; end if; return mySet; end p_getFontMetrics; ---------------------------------------------------------------------------------- -- Parcours le tableau des images et renvoie true si l'image cherché existe -- dans le tableau. ---------------------------------------------------------------------------------- function imageExists(pFile varchar2) return boolean is begin if (images.exists(lower(pFile))) then return true; end if; return false; exception when others then error('imageExists : '||sqlerrm); return false; end imageExists; ---------------------------------------------------------------------------------- -- Parcours le tableau des charwidths et renvoie true si il existe pour la font -- donnée. ---------------------------------------------------------------------------------- function fpdf_charwidthsExists(pFontName varchar2) return boolean is chTab charSet; begin if (fpdf_charwidths.exists(pFontName)) then chTab := fpdf_charwidths(pFontName); if (nvl(chTab.count, 0) > 0) then return true; end if; end if; return false; exception when others then return false; end fpdf_charwidthsExists; ---------------------------------------------------------------------------------- -- Parcours le tableau des fonts et renvoie true si il existe pour la font -- donnée. ---------------------------------------------------------------------------------- function fontsExists(pFontName varchar2) return boolean is ft word; begin if (fonts.exists(pFontName)) then ft := fonts(pFontName).name||fonts(pFontName).type; if (nvl(ft, 0) != 0) then return true; end if; end if; return false; exception when others then return false; end fontsExists; -------------------------------------------------------------------------------- -- get an image in a blob from an http url. -- The image is converted on the fly to PNG format. -------------------------------------------------------------------------------- function getImageFromUrl(p_Url varchar2) return ordsys.ordImage is myImg ordsys.ordImage; lv_url varchar2(2000) := p_Url; urityp URIType; begin -- normalize url. if (instr(lv_url, 'http') = 0 ) then lv_url := 'http://'||owa_util.get_cgi_env('SERVER_NAME')||'/'||lv_url; end if; urityp := URIFactory.getURI(lv_url); myImg := ORDSYS.ORDImage.init(); myImg.source.localdata := urityp.getBlob(); myImg.setMimeType(urityp.getContentType()); begin myImg.setProperties(); Exception when others then null; -- Ignore exceptions, mimetype is enough. end; -- Transform image to PNG if it is a GIF, a JPG or a BMP if (myImg.getFileFormat() != 'PNGF' ) then myImg.process('fileFormat=PNGF,contentFormat=8bitlutrgb'); myImg.setProperties(); end if; return myImg; exception when others then Error('pl_fpdf.getImageFromUrl :'||sqlerrm||', image :'||p_Url); return myImg; return myImg; end getImageFromUrl; -------------------------------------------------------------------------------- -- get an image in a blob from an oracle table. -------------------------------------------------------------------------------- function getImageFromDatabase(pFile varchar2) return ordsys.ordImage is myImg ordsys.ordImage := ordsys.ordImage.init(); begin return myImg; end getImageFromDatabase; -------------------------------------------------------------------------------- -- Enables debug infos -------------------------------------------------------------------------------- procedure DebugEnabled is begin gb_mode_debug := true; end DebugEnabled; -------------------------------------------------------------------------------- -- disables debug infos -------------------------------------------------------------------------------- procedure DebugDisabled is begin gb_mode_debug := false; end DebugDisabled; -------------------------------------------------------------------------------- -- Returns the k property -------------------------------------------------------------------------------- function GetScaleFactor return number is begin -- Get scale factor return k; end GetScaleFactor; -------------------------------------------------------------------------------- -- Returns the Linespacing property -------------------------------------------------------------------------------- function GetLineSpacing return number is begin -- Get LineSpacing property return LineSpacing; end GetLineSpacing; -------------------------------------------------------------------------------- -- sets the Linespacing property -------------------------------------------------------------------------------- Procedure SetLineSpacing (pls number) is begin -- Set LineSpacing property LineSpacing := pls; end SetLineSpacing; ---------------------------------------------------------------------------------- -- Compatibilité PHP -> PLSQL : proc. and func. spécifiques au portages -- ajoutée pour des facilités de traduction ---------------------------------------------------------------------------------- function ord(pStr varchar2) return number is begin return ascii(substr(pStr, 1, 1)); end ord; function empty (p_myvar varchar2) return boolean is begin if (p_myvar is null) then return true; end if; return false; end empty; function empty (p_mynum number) return boolean is begin return empty (p_myvar => to_char(p_mynum)); end empty; function str_replace ( psearch varchar2, preplace varchar2, psubject varchar2) return varchar2 is begin return replace(psubject, psearch, preplace); end str_replace; function strlen (pstr varchar2) return number is begin return length(pstr); end strlen; function strlen (pstr clob) return number is begin return length(pstr); end strlen; function tonumber(v_str in varchar2) return number is v_num number; v_str2 varchar2(255); begin begin v_num := to_number(v_str); exception when others then v_num := null; end; if v_num is null then -- maybe wrong NLS, try again v_str2 := replace(v_str,',.','.,'); begin v_num := to_number(v_str2); exception when others then v_num := null; end; end if; return v_num; end; function tochar(pnum number, pprecision number default 2) return varchar2 is mynum word := replace(to_char(pnum),',','.'); ceilnum word; decnum word; begin if (instr(mynum,'.') = 0) then mynum := mynum || '.0'; end if; ceilnum := nvl(substr(mynum,1,instr(mynum,'.')-1), '0'); decnum := nvl(substr(mynum,instr(mynum,'.')+1), '0'); decnum := substr(decnum,1, pprecision); if (pprecision = 0 ) then mynum := ceilnum; else mynum := ceilnum || '.' ||decnum; end if; return mynum; end tochar; function date_YmdHis (p_date date default sysdate) return varchar2 is begin return to_char(p_date,'YYYYMMDDHH24MISS'); end date_YmdHis; function is_string (pstr varchar2) return boolean is temp varchar2(2000); begin temp := to_number(pstr); -- Si on passe là c'est que la variable contient un nombre sinon => exception. return false; exception when others then return true; end is_string; function function_exists (pname varchar2) return boolean is begin -- Pas de fct fdt de compression zlib sous oracle. return false; end function_exists; function strtoupper (pstr in out varchar2) return varchar2 is begin return upper(pstr); end strtoupper; function strtolower (pstr in out varchar2) return varchar2 is begin return lower(pstr); end strtolower; function substr_count (ptxt varchar2, pstr varchar2) return number is nbr number := 0; begin for i in 1..length(ptxt) loop if (substr(ptxt,i,1) = pstr) then nbr := nbr + 1; end if; end loop; return nbr; end substr_count; ---------------------------------------------------------------------------------------- -- Traduction des méthodes PHP. ---------------------------------------------------------------------------------------- procedure p_dochecks is begin -- Check for decimal separator -- MBR 15.03.2011: commented out to use the established NLS settings for session -- PDF generation seems to work without this anyway... -- execute immediate 'alter session set NLS_NUMERIC_CHARACTERS = '',.'''; null; end p_dochecks; ---------------------------------------------------------------------------------------- function p_getfontpath return varchar2 is begin -- Procedure inutile avec le PLSQL : toutes les fonts sont chargées en mémoire. return null; end p_getfontpath; ---------------------------------------------------------------------------------------- procedure p_out(pstr varchar2 default null, pCRLF boolean default true) is lv_CRLF varchar2(2) := null; begin if (pCRLF) then lv_CRLF := chr(10); end if; -- Add a line to the document if(state = 2) then pages(page):= pages(page) || pstr || lv_CRLF; else pdfDoc(pdfDoc.last + 1) := pstr || lv_CRLF; end if; exception when others then error('p_out : '||sqlerrm); end p_out; procedure p_out(pstr clob default null, pCRLF boolean default true) is lv_CRLF varchar2(2) := null; begin if (pCRLF) then lv_CRLF := chr(10); end if; -- Add a line to the document if(state = 2) then pages(page):= pages(page) || pstr || lv_CRLF; else pdfDoc(pdfDoc.last + 1) := pstr || lv_CRLF; end if; exception when others then error('p_out (clob) : '||sqlerrm); end p_out; ---------------------------------------------------------------------------------------- procedure p_newobj is begin -- Begin a new object n := n + 1; offsets(n) := getPDFDocLength(); p_out(n || ' 0 obj'); exception when others then error('p_newobj : '||sqlerrm); end p_newobj; ---------------------------------------------------------------------------------------- function p_escape(pstr varchar2) return varchar2 is begin -- Add \ before \, ( and ) return str_replace(')','\)',str_replace('(','\(',str_replace('\\','\\\\',pstr))); --return str_replace('\\','\\\\',pstr); end p_escape; ---------------------------------------------------------------------------------------- function p_textstring(pstr varchar2) return varchar2 is begin -- Format a text string return '(' || p_escape(pstr) || ')'; end p_textstring; ---------------------------------------------------------------------------------------- procedure p_putstream(pstr varchar2) is begin p_out('stream'); p_out(pstr); p_out('endstream'); exception when others then error('p_putstream : '||sqlerrm); end p_putstream; ---------------------------------------------------------------------------------------- procedure p_putstream(pstr clob) is begin p_out('stream'); p_out(pstr); p_out('endstream'); exception when others then error('p_putstream (clob): '||sqlerrm); end p_putstream; procedure p_putstream(pData in out NOCOPY blob) is offset integer := 1; lv_content_length number := dbms_lob.getlength(pdata); buf_size integer := 2000; buf raw(2000); begin p_out('stream'); -- read the blob and put it in small pieces in a varchar while offset < lv_content_length loop dbms_lob.read(pData,buf_size,offset,buf); p_out(utl_raw.cast_to_varchar2(buf), false); offset := offset + buf_size; end loop; -- put a CRLF at te end of the blob p_out(chr(10), false); p_out('endstream'); exception when others then error('p_putstream : '||sqlerrm); end p_putstream; ---------------------------------------------------------------------------------------- procedure p_putxobjectdict is v txt; begin v := images.first; while (v is not null) loop p_out('/I' || images(v).i || ' ' || images(v).n || ' 0 R'); v := images.next(v); end loop; exception when others then error('p_putxobjectdict : '||sqlerrm); end p_putxobjectdict; ---------------------------------------------------------------------------------------- procedure p_putresourcedict is v varchar2(200); begin p_out('/ProcSet [/PDF /Text /ImageB /ImageC /ImageI]'); p_out('/Font <<'); v := fonts.first; while (v is not null) loop p_out('/F' || fonts(v).i || ' ' || fonts(v).n ||' 0 R'); v := fonts.next(v); end loop; p_out('>>'); p_out('/XObject <<'); p_putxobjectdict(); p_out('>>'); exception when others then error('p_putresourcedict : '||sqlerrm); end p_putresourcedict; ---------------------------------------------------------------------------------------- procedure p_putfonts is nf number := n; i pls_integer; k varchar2(200); v varchar2(200); myFont varchar2(2000); mySet charSet; myHeader boolean; myType word; myName word; myFile word; s varchar2(2000); cw charSet; theType word; methode word; -- plsqlmethode word; begin null; i := diffs.first; while (i is not null) loop -- Encodings p_newobj(); p_out('<>'); p_out('endobj'); i:= diffs.next(i); end loop; -- foreach($this->FontFiles as $file=>$info) v := FontFiles.first; while (v is not null) loop null; -- Font file embedding p_newobj(); FontFiles(v).n:= n; myFont := null; mySet := p_getFontMetrics(FontFiles(v).file); for i in mySet.first..mySet.last loop myFont := myFont || mySet(i); end loop; if (mySet.count = 0) then Error('Font file not found'); end if; if(FontFiles(v).length2 is not null) then myHeader := false; if ( ord(myFont) = 128) then myHeader := true; end if; if(myHeader) then -- Strip first binary header myFont := substr(myFont,6); end if; if(myHeader and ord(substr(myFont,(FontFiles(v).length1), 1)) = 128) then -- Strip second binary header myFont := substr(myFont, 1, FontFiles(v).length1) || substr(myFont, FontFiles(v).length1 + 6); end if; end if; p_out('<>'); p_putstream(myFont); p_out('endobj'); v := FontFiles.next(v); end loop; k := fonts.first; while (k is not null) loop --foreach(fonts as $k=>myFont) --{ -- Font objects fonts(k).n := n+1; myType := fonts(k).type; myName := fonts(k).name; if(myType = 'core') then -- Standard font p_newobj(); p_out('<>'); p_out('endobj'); elsif(lower(myType) = 'type1' or lower(myType) = 'truetype') then -- Additional Type1 or TrueType font p_newobj(); p_out('<>'); p_out('endobj'); -- Widths p_newobj(); cw := fonts(k).cw; s := '['; for i in 32..255 loop s := s || cw(chr(i)) || ' '; end loop; p_out(s || ']'); p_out('endobj'); -- Descriptor p_newobj(); s := '<>'); p_out('endobj'); else -- Allow for additional types methode := 'p_put' || strtolower(myType); if(not methode_exists(methode)) then Error('Unsupported font type: ' || myType); -- else -- plsqlmethode := 'begin pl_fpdf.'|| methode ||'(''' || fonts(k) || '''); end'; -- execute immediate plsqlmethode; end if; end if; k := fonts.next(k); end loop; exception when others then error('p_putfonts : '||sqlerrm); end p_putfonts; ---------------------------------------------------------------------------------------- procedure p_putimages is filter word; info recImage; v txt; trns txt; pal txt; begin if (b_compress) then filter := '/Filter /FlateDecode '; else filter := ''; end if; --while(list($file,$info)=each($this->images)) v := images.first; while (v is not null) loop p_newobj(); images(v).n := n; info := images(v); p_out('<>'); p_putstream(info.data); images(v).data := null; p_out('endobj'); --Palette if(info.cs = 'Indexed') then p_newobj(); if (b_compress) then -- gzcompress($info('pal')) null; else pal := info.pal; end if; p_out('<<' || filter || '/Length ' || strlen(pal) || '>>'); p_putstream(pal); p_out('endobj'); end if; v := images.next(v); end loop; exception when others then error('p_putimages : '||sqlerrm); end p_putimages; procedure jsSet(theJs varchar2) is begin jsIncluded := true; jsStr := theJs; end; procedure jsAutoPrint(silent boolean default false, closeWindow boolean default false) is printArgs varchar2(130); begin -- note about silent printing: adobe just changed how silent printing works, -- there is a way to do it...i will code it soon if silent then printArgs := '{bUI: true, bSilent: true}'; end if; -- -- to close window, create closeit.html put in root dir: -- closeit.html: -- if closeWindow then jsSet('this.print('||printArgs||'); this.getURL("/closeit.html", false);'); else jsSet('this.print('||printArgs||');'); end if; end; procedure jsAddTodoc is begin p_newobj(); jsNbr := n; p_out('<<'); p_out('/Names [(EmbeddedJS) '|| to_char(n+1) ||' 0 R]'); p_out('>>'); p_out('endobj'); p_newobj(); p_out('<<'); p_out('/S /JavaScript'); p_out('/JS '||p_textstring(jsStr)); p_out('>>'); p_out('endobj'); end; ---------------------------------------------------------------------------------------- procedure p_putresources is begin p_putfonts(); p_putimages(); if jsIncluded then jsAddTodoc; end if; -- Resource dictionary offsets(2):= getPDFDocLength(); p_out('2 0 obj'); p_out('<<'); p_putresourcedict(); p_out('>>'); p_out('endobj'); exception when others then error('p_putresources : '||sqlerrm); end p_putresources; ---------------------------------------------------------------------------------------- procedure p_putinfo is begin p_out('/Producer ' || p_textstring('PL_FPDF ' || PL_FPDF_VERSION || ' portage pour Laclasse.com par P.G. Levallois de la version '|| FPDF_VERSION ||' de PHP/FPDF d''Olivier Plathey.')); if(not empty(title)) then p_out('/Title ' || p_textstring(title)); end if; if(not empty(subject)) then p_out('/Subject ' || p_textstring(subject)); end if; if(not empty(author)) then p_out('/Author ' || p_textstring(author)); end if; if(not empty(keywords)) then p_out('/Keywords ' || p_textstring(keywords)); end if; if(not empty(creator)) then p_out('/Creator ' || p_textstring(creator)); end if; p_out('/CreationDate ' || p_textstring('D:' || date_YmdHis())); exception when others then error('p_putinfo : '||sqlerrm); end p_putinfo; ---------------------------------------------------------------------------------------- procedure p_putcatalog is begin p_out('/Type /Catalog'); p_out('/Pages 1 0 R'); if(ZoomMode='fullpage') then p_out('/OpenAction [3 0 R /Fit]'); elsif(ZoomMode='fullwidth') then p_out('/OpenAction [3 0 R /FitH null]'); elsif(ZoomMode='real') then p_out('/OpenAction [3 0 R /XYZ null null 1]'); elsif(not is_string(ZoomMode)) then p_out('/OpenAction [3 0 R /XYZ null null ' || (ZoomMode/100) || ']'); end if; if(LayoutMode='single') then p_out('/PageLayout /SinglePage'); elsif(LayoutMode='continuous') then p_out('/PageLayout /OneColumn'); elsif(LayoutMode='two') then p_out('/PageLayout /TwoColumnLeft'); end if; if jsIncluded then p_out('/Names <>'); end if; exception when others then error('p_putcatalog : '||sqlerrm); end p_putcatalog; ---------------------------------------------------------------------------------------- procedure p_putheader is begin p_out('%PDF-' || PDFVersion); end p_putheader; ---------------------------------------------------------------------------------------- procedure p_puttrailer is begin p_out('/Size ' || (n+1)); p_out('/Root ' || n || ' 0 R'); p_out('/Info ' || (n-1) || ' 0 R'); end p_puttrailer; ---------------------------------------------------------------------------------------- procedure p_endpage is begin -- End of page contents state:=1; end p_endpage; ---------------------------------------------------------------------------------------- procedure p_putpages is nb number := page; filter varchar2(200); annots bigtext; rect txt; l number; h number; kids txt; v_0 varchar2(255); v_1 varchar2(255); v_2 varchar2(255); v_3 varchar2(255); v_4 varchar2(255); v_0n number; v_1n number; v_2n number; v_3n number; begin -- Replace number of pages if not empty(AliasNbPages) then for i in 1..nb loop pages(i) := str_replace(AliasNbPages,nb,pages(i)); end loop; end if; if DefOrientation = 'P' then wPt:=fwPt; hPt:=fhPt; else wPt:=fhPt; hPt:=fwPt; end if; if (b_compress) then filter := '/Filter /FlateDecode '; else filter := ''; end if; for i in 1..nb loop -- Page p_newobj(); p_out('< 0 then for j in 1..PageLinks.last loop if(nvl(PageLinks(j).page,0)=i) then v_0 := PageLinks(j).zero; v_0n := tonumber(v_0); v_1 := PageLinks(j).un; v_1n := tonumber(v_1); v_2 := PageLinks(j).deux; v_2n := tonumber(v_2); v_3 := PageLinks(j).trois; v_3n := tonumber(v_3); v_4 := PageLinks(j).quatre; rect := tochar(v_0) || ' ' || tochar(v_1) || ' ' || tochar(v_0n + v_2n) || ' ' || tochar(v_1n - v_3n); annots := annots || '<>>>'; else if (OrientationChanges(PageLinks(j).zero) is not null) then h := wPt; else h := hPt; end if; annots := annots || '/Dest ['||to_char(3+2*(links(PageLinks(j).quatre).zero-1))||' 0 R /XYZ 0 '|| to_char(links(PageLinks(j).quatre).un)||' null]>>'; end if; end if; end loop; --end loop of PageLinks; p_out(annots || ']'); end if; p_out('/Contents ' || to_char(n+1) || ' 0 R>>'); p_out('endobj'); -- Page content -- Pas de compression : oracle ne sait pas faire. p_newobj(); p_out('<<' || filter || '/Length ' || strlen(pages(i)) || '>>'); p_putstream(pages(i)); p_out('endobj'); end loop; -- Pages root offsets(1):=getPDFDocLength(); p_out('1 0 obj'); p_out('<>'); p_out('endobj'); exception when others then error('p_putpages : '||sqlerrm); end p_putpages; ---------------------------------------------------------------------------------------- procedure p_enddoc is o number; begin p_putheader(); p_putpages(); p_putresources(); -- Info p_newobj(); p_out('<<'); p_putinfo(); p_out('>>'); p_out('endobj'); -- Catalog p_newobj(); p_out('<<'); p_putcatalog(); p_out('>>'); p_out('endobj'); -- Cross-ref o := getPDFDocLength(); p_out('xref'); p_out('0 ' || (n+1)); p_out('0000000000 65535 f '); for i in 1..n loop p_out(substr('0000000000', 1, 10 - length(offsets(i)) ) ||offsets(i) || ' 00000 n '); end loop; -- Trailer p_out('trailer'); p_out('<<'); p_puttrailer(); p_out('>>'); p_out('startxref'); p_out(o); p_out('%%EOF'); state := 3; exception when others then error('p_enddoc : '||sqlerrm); end p_enddoc; ---------------------------------------------------------------------------------------- procedure p_beginpage(orientation varchar2) is Myorientation word := orientation; begin page := page + 1; pages(page):=''; state:=2; x:=lMargin; y:=tMargin; FontFamily:=''; -- Page orientation if(empty(Myorientation)) then Myorientation:=DefOrientation; else Myorientation := substr(Myorientation, 1, 1); Myorientation:=strtoupper(Myorientation); if(Myorientation!=DefOrientation) then OrientationChanges(page):=true; end if; end if; if(Myorientation!=CurOrientation) then -- Change orientation if(orientation='P') then wPt:=fwPt; hPt:=fhPt; w:=fw; h:=fh; else wPt:=fhPt; hPt:=fwPt; w:=fh; h:=fw; end if; pageBreakTrigger:=h-bMargin; CurOrientation:=Myorientation; end if; exception when others then error('p_beginpage : '||sqlerrm); end p_beginpage; ---------------------------------------------------------------------------------------- function p_dounderline(px number,py number,ptxt varchar2) return varchar2 is up word := CurrentFont.up; ut word := CurrentFont.ut; w number := 0; begin w:=GetStringWidth(ptxt) + ws * substr_count(ptxt,' '); return tochar(px*k,2)||' '||tochar((h-(py-up/1000*fontsize))*k,2)||' '||tochar(w*k,2)||' '||tochar(-ut/1000*fontsizePt,2)||' re f'; exception when others then error('p_dounderline : '||sqlerrm); end p_dounderline; -------------------------------------------------------------------------------- -- Function to convert a binary unsigned integer -- into a PLSQL number -------------------------------------------------------------------------------- function p_freadint( p_data in varchar2 ) return number is l_number number default 0; l_bytes number default length(p_data); big_endian constant boolean default true; begin if (big_endian) then for i in 1 .. l_bytes loop l_number := l_number + ascii(substr(p_data,i,1)) * power(2,8*(i-1)); end loop; else for i in 1 .. l_bytes loop l_number := l_number + ascii(substr(p_data,l_bytes-i+1,1)) * power(2,8*(i-1)); end loop; end if; return l_number; end p_freadint; /* -------------------------------------------------------------------------------- -- Parse an image -------------------------------------------------------------------------------- function p_parseImage(pFile varchar2) return recImage is myImg ordsys.ordImage := ordsys.ordImage.init(); myImgInfo recImage; myCtFormat word; -- colspace word; myblob blob; png_signature constant varchar2(8) := chr(137) || 'PNG' || chr(13) || chr(10) || chr(26) || chr(10); amount number; f number default 1; buf varchar2(8192); bufRaw raw(32000); amount_rd number; amount_wr number; offset_rd number; offset_wr number; ct word; colors pls_integer; n number; myType word; -- NullTabN tn; imgDataStartsHere number; imgDataStopsHere number; nb_chuncks number; --------------------------------------------------------------------------------------------- function freadb(pBlob in out nocopy blob, pHandle in out number, pLength in out number) return raw is l_data_raw raw(8192); l_hdr_size number default 2000; begin dbms_lob.read(pBlob, pLength, pHandle, l_data_raw); pHandle := pHandle + pLength; return l_data_raw; end freadb; function fread(pBlob in out nocopy blob, pHandle in out number, pLength in out number) return varchar2 is begin return utl_raw.cast_to_varchar2(freadb(pBlob, pHandle, pLength)); end fread; --------------------------------------------------------------------------------------------- begin myImgInfo.data := empty_blob(); myImg := getImageFromUrl(pFile); myCtFormat := myImg.getContentFormat(); myblob := myImg.getContent(); myImgInfo.i := 1; -- reading the blob amount := 8; --Check signature if(fread(myblob, f, amount) != png_signature ) then Error('Not a PNG file: ' || pFile); end if; -- Read header chunk amount := 4; buf := fread(myblob, f, amount); buf := fread(myblob, f, amount); if(buf != 'IHDR') then Error('Incorrect PNG file: ' || pFile); end if; myImgInfo.w := myImg.getWidth(); myImgInfo.h := myImg.getHeight(); -- ^^^ I have already get width and height, so go forward (read 4 Bytes twice) buf := fread(myblob, f, amount); buf := fread(myblob, f, amount); amount := 1; myImgInfo.bpc := ord(fread(myblob, f, amount)); if( myImgInfo.bpc > 8) then Error('16-bit depth not supported: ' || pFile); end if; ct := ord(fread(myblob, f, amount)); if( ct = 0 ) then myImgInfo.cs := 'DeviceGray'; elsif( ct = 2 ) then myImgInfo.cs := 'DeviceRGB'; elsif( ct = 3 ) then myImgInfo.cs := 'Indexed'; else Error('Alpha channel not supported: ' || pFile); end if; if( ord(fread(myblob, f, amount)) != 0 ) then Error('Unknown compression method: ' || pFile); end if; if( ord(fread(myblob, f, amount)) != 0 ) then Error('Unknown filter method: ' || pFile); end if; if( ord(fread(myblob, f, amount)) != 0 ) then Error('Interlacing not supported: ' || pFile); end if; amount := 4; buf := fread(myblob, f, amount); if (ct = 2 ) then colors := 3; else colors := 1; end if; myImgInfo.parms := '/DecodeParms <>'; -- scan chunks looking for palette, transparency and image data loop amount := 4; n := utl_raw.cast_to_binary_integer(freadb(myblob, f, amount)); myType := fread(myblob, f, amount); if(myType = 'PLTE') then -- Read palette amount := n; myImgInfo.pal := fread(myblob, f, amount); amount := 4; buf := fread(myblob, f, amount); elsif(myType = 'tRNS') then -- Read transparency info amount := n; buf := fread(myblob, f, amount); if(ct = 0) then myImgInfo.trns(1) := ord(substr(buf,1,1)); elsif( ct = 2) then myImgInfo.trns(1) := ord(substr(buf,1,1)); myImgInfo.trns(2) := ord(substr(buf,3,1)); myImgInfo.trns(3) := ord(substr(buf,5,1)); else if(instr(buf,chr(0)) > 0) then myImgInfo.trns(1) := instr(buf,chr(0)); end if; end if; amount := 4; buf := fread(myblob, f, amount); elsif(myType = 'IDAT') then -- Read image data block after the loop, just mark the begin of data imgDataStartsHere := f; exit; elsif(myType = 'IEND') then exit; else amount := n + 4; buf := fread(myblob, f, amount); end if; exit when n is null or n = 0; end loop; imgDataStopsHere := dbms_lob.instr(myblob, utl_raw.cast_to_raw('IEND'),1,1); -- copy image in the structure. amount_rd := 8192; amount_wr := 8192; offset_rd := 1; offset_wr := 1; nb_chuncks := ceil(((imgDataStopsHere - imgDataStartsHere)) / amount_rd); dbms_lob.createtemporary(myImgInfo.data, true); for i in 1..nb_chuncks loop offset_rd := imgDataStartsHere + ((i - 1) * amount_rd); dbms_lob.read(myblob, amount_rd, offset_rd, bufRaw); offset_wr := ((i - 1) * amount_wr) + 1; amount_wr := amount_rd; dbms_lob.write(myImgInfo.data, amount_wr, offset_wr, bufRaw); end loop; if( myImgInfo.cs = 'Indexed' and myImgInfo.pal is null) then Error('Missing palette in '|| pFile); end if; myImgInfo.f := 'FlateDecode'; return myImgInfo; exception when others then Error('p_parseImage : '||SQLERRM); return myImgInfo; end p_parseImage; */ -------------------------------------------------------------------------------- -- Parse an image -------------------------------------------------------------------------------- function p_parseImage(pFile varchar2) return recImage is myImg ordsys.ordImage := ordsys.ordImage.init(); myImgInfo recImage; myCtFormat word; colspace word; myblob blob; chunk_content blob; png_signature constant varchar2(8) := chr(137) || 'PNG' || chr(13) || chr(10) || chr(26) || chr(10); signature_len integer := 8; chunklength_len integer := 4; chunktype_len integer := 4; chunkdata_len integer; widthheight_len integer := 8; hdrflag_len integer := 1; crc_len integer := 4; chunk_num integer := 0; --amount number; f number default 1; f_chunk number default 1; buf varchar2(8192); ct word; colors pls_integer; n number; myType word; NullTabN tn; imgDataStartsHere number; imgDataStopsHere number; nb_chuncks number; --------------------------------------------------------------------------------------------- function freadb(pBlob in out nocopy blob, pHandle in out number, pLength in out number) return raw is l_data_raw raw(8192); l_hdr_size number default 2000; begin dbms_lob.read(pBlob, pLength, pHandle, l_data_raw); pHandle := pHandle + pLength; return l_data_raw; end freadb; function fread(pBlob in out nocopy blob, pHandle in out number, pLength in out number) return varchar2 is begin return utl_raw.cast_to_varchar2(freadb(pBlob, pHandle, pLength)); end fread; procedure fread_blob(pBlob in out nocopy blob, pHandle in out number, pLength in out number, pDestBlob in out nocopy blob ) is begin dbms_lob.trim( pDestBlob, 0); dbms_lob.copy( pDestBlob, pBlob, pLength, 1, pHandle ); pHandle := pHandle + pLength; end fread_blob; --------------------------------------------------------------------------------------------- begin dbms_lob.createtemporary(chunk_content, true ); dbms_lob.open(chunk_content,dbms_lob.LOB_READWRITE); --we use the package level imgBlob variable so the temp blob will persist throughout pdf creation. dbms_lob.createtemporary(imgBlob, true ); myImgInfo.data := imgBlob; dbms_lob.open(myImgInfo.data,dbms_lob.LOB_READWRITE); myImg := getImageFromUrl(pFile); myCtFormat := myImg.getContentFormat(); myblob := myImg.getContent(); myImgInfo.i := 1; -- reading the blob --Check signature if(fread(myblob, f, signature_len) != png_signature ) then Error('Not a PNG file: ' || pFile); end if; myImgInfo.w := myImg.getWidth(); myImgInfo.h := myImg.getHeight(); -- scan chunks looking for palette, transparency and image data loop chunkdata_len := utl_raw.cast_to_binary_integer(freadb(myblob, f, chunklength_len)); myType := fread(myblob, f, chunktype_len); --read chunk contents into separate blob if( chunkdata_len > 0 ) then fread_blob(myblob,f,chunkdata_len,chunk_content); f_chunk := 1; end if; chunk_num := chunk_num + 1; --discard the crc buf := fread(myblob, f, crc_len); if( chunk_num = 1 and myType != 'IHDR' ) then Error('Incorrect PNG file: ' || pFile); elsif(myType = 'IHDR') then -- ^^^ I have already get width and height, so go forward (read 4 Bytes twice) buf := fread(chunk_content, f_chunk, widthheight_len); myImgInfo.bpc := ord(fread(chunk_content, f_chunk, hdrflag_len)); if( myImgInfo.bpc > 8) then Error('16-bit depth not supported: ' || pFile); end if; ct := ord(fread(chunk_content, f_chunk, hdrflag_len)); if( ct = 0 ) then myImgInfo.cs := 'DeviceGray'; elsif( ct = 2 ) then myImgInfo.cs := 'DeviceRGB'; elsif( ct = 3 ) then myImgInfo.cs := 'Indexed'; else Error('Alpha channel not supported: ' || pFile); end if; if( ord(fread(chunk_content, f_chunk, hdrflag_len)) != 0 ) then Error('Unknown compression method: ' || pFile); end if; if( ord(fread(chunk_content, f_chunk, hdrflag_len)) != 0 ) then Error('Unknown filter method: ' || pFile); end if; if( ord(fread(chunk_content, f_chunk, hdrflag_len)) != 0 ) then Error('Interlacing not supported: ' || pFile); end if; if (ct = 2 ) then colors := 3; else colors := 1; end if; myImgInfo.parms := '/DecodeParms <>'; elsif(myType = 'PLTE') then -- Read palette myImgInfo.pal := fread(chunk_content, f_chunk, chunkdata_len ) ; elsif(myType = 'tRNS') then -- Read transparency info buf := fread(chunk_content, f_chunk, chunkdata_len ) ; if(ct = 0) then myImgInfo.trns(1) := ord(substr(buf,1,1)); elsif( ct = 2) then myImgInfo.trns(1) := ord(substr(buf,1,1)); myImgInfo.trns(2) := ord(substr(buf,3,1)); myImgInfo.trns(3) := ord(substr(buf,5,1)); else if(instr(buf,chr(0)) > 0) then myImgInfo.trns(1) := instr(buf,chr(0)); end if; end if; elsif(myType = 'IDAT') then -- Read image data block after the loop, just mark the begin of data dbms_lob.append(myImgInfo.data,chunk_content); elsif(myType = 'IEND') then exit; end if; end loop; if( myImgInfo.cs = 'Indexed' and myImgInfo.pal is null) then Error('Missing palette in '|| pFile); end if; myImgInfo.f := 'FlateDecode'; dbms_lob.close(chunk_content); dbms_lob.close(myImgInfo.data); dbms_lob.freetemporary(chunk_content); return myImgInfo; exception when others then Error('p_parseImage : '||SQLERRM); return myImgInfo; end p_parseImage; /******************************************************************************* * * * Public methods * * * ********************************************************************************/ ---------------------------------------------------------------------------------------- -- Methods added to FPDF primary class ---------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------- -- SetDash Ecrire en pointillés ---------------------------------------------------------------------------------------- procedure SetDash(pblack number default 0, pwhite number default 0) is s txt; begin if(pblack != 0 or pwhite != 0) then s := '['||tochar(pblack*k, 3)||' '||tochar( pwhite*k, 3)||'] 0 d'; else s := '[] 0 d'; end if; p_out(s); end SetDash; ---------------------------------------------------------------------------------------- -- Methods from FPDF primary class ---------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------- procedure Error(pmsg varchar2) is begin if gb_mode_debug then print('
');
	  for i in pdfDoc.first..pdfDoc.last loop
	    if i is not null then
	      print(replace(replace(pdfDoc(i),'>','>'),'<','<'));
		end if;
	  end loop;
	  print('
'); end if; -- Fatal error raise_application_error(-20100,'PL_FPDF error: '|| pmsg); end Error; ---------------------------------------------------------------------------------------- function GetCurrentFontSize return number is begin -- Get fontsizePt return fontsizePt; end GetCurrentFontSize; ---------------------------------------------------------------------------------------- function GetCurrentFontStyle return varchar2 is begin -- Get fontStyle return fontStyle; end GetCurrentFontStyle; ---------------------------------------------------------------------------------------- function GetCurrentFontFamily return varchar2 is begin -- Get fontStyle return FontFamily; end GetCurrentFontFamily; ---------------------------------------------------------------------------------------- procedure Ln(h number default null) is begin -- Line feed; default value is last cell height x :=lMargin; if(is_string(h)) then y:= y + lasth; else y:= y + h; end if; end Ln; ---------------------------------------------------------------------------------------- function GetX return number is begin -- Get x position return x; end GetX; ---------------------------------------------------------------------------------------- procedure SetX(px number) is begin -- Set x position if(px>=0) then x:=px; else x:=w+px; end if; end SetX; ---------------------------------------------------------------------------------------- function GetY return number is begin -- Get y position return y; end GetY; ---------------------------------------------------------------------------------------- procedure SetY(py number) is begin -- Set y position and reset x x:=lMargin; if(py>=0) then y:=py; else y:=h+py; end if; end SetY; ---------------------------------------------------------------------------------------- procedure SetXY(x number,y number) is begin -- Set x and y positions SetY(y); SetX(x); end SetXY; ---------------------------------------------------------------------------------------- -- SetHeaderProc : setting header Callback ---------------------------------------------------------------------------------------- procedure SetHeaderProc(headerprocname in varchar2, paramTable tv4000a default noParam) is begin MyHeader_Proc := headerprocname; MyHeader_ProcParam := paramTable; end; ---------------------------------------------------------------------------------------- -- SetFooterProc : setting footer Callback ---------------------------------------------------------------------------------------- procedure SetFooterProc(footerprocname in varchar2, paramTable tv4000a default noParam) is begin MyFooter_Proc := footerprocname; MyFooter_ProcParam := paramTable; end; ---------------------------------------------------------------------------------------- procedure SetMargins(left number,top number ,right number default -1) is myright margin := right; begin -- Set left, top and right margins lMargin:=left; tMargin:=top; if(myright=-1) then myright:=left; end if; rMargin:=myright; end SetMargins; ---------------------------------------------------------------------------------------- procedure SetLeftMargin( pMargin number) is begin -- Set left margin lMargin:=pMargin; if(page > 0 and x < pMargin) then x:= pMargin; end if; end SetLeftMargin; ---------------------------------------------------------------------------------------- procedure SetTopMargin(pMargin number) is begin -- Set top margin tMargin := pMargin; end SetTopMargin; ---------------------------------------------------------------------------------------- procedure SetRightMargin(pMargin number) is begin -- Set right margin rMargin := pMargin; end SetRightMargin; ---------------------------------------------------------------------------------------- procedure SetAutoPageBreak(pauto boolean, pMargin number default 0) is begin -- Set auto page break mode and triggering margin AutoPageBreak := pauto; bMargin := pMargin; pageBreakTrigger:=h-pMargin; end SetAutoPageBreak; ---------------------------------------------------------------------------------------- procedure SetDisplayMode(zoom varchar2,layout varchar2 default 'continuous') is begin -- Set display mode in viewer if(zoom in ('fullpage', 'fullwidth', 'real', 'default') or not is_string(zoom)) then ZoomMode:= zoom; else Error('Incorrect zoom display mode: ' || zoom); end if; if(layout in ('single', 'continuous', 'two', 'default')) then LayoutMode := layout; else Error('Incorrect layout display mode: ' || layout); end if; end SetDisplayMode; ---------------------------------------------------------------------------------------- procedure SetCompression(p_compress boolean default false) is begin -- Set page compression if(function_exists('gzcompress')) then b_compress:=p_compress; else b_compress:=false; end if; end SetCompression; ---------------------------------------------------------------------------------------- procedure SetTitle(ptitle varchar2) is begin -- Title of document title:=ptitle; end SetTitle; ---------------------------------------------------------------------------------------- procedure SetSubject(psubject varchar2) is begin -- Subject of document subject:= psubject; end SetSubject; ---------------------------------------------------------------------------------------- procedure SetAuthor(pauthor varchar2) is begin -- Author of document author:=pauthor; end SetAuthor; ---------------------------------------------------------------------------------------- procedure SetKeywords(pkeywords varchar2) is begin -- Keywords of document keywords:=pkeywords; end SetKeywords; ---------------------------------------------------------------------------------------- procedure SetCreator(pcreator varchar2) is begin -- Creator of document creator:=pcreator; end SetCreator; ---------------------------------------------------------------------------------------- procedure SetAliasNbPages(palias varchar2 default '{nb}') is begin -- Define an alias for total number of pages AliasNbPages:=palias; end SetAliasNbPages; ---------------------------------------------------------------------------------------- -- buildPlsqlStatment : building the pl/lsq stmt for header or Footer hooked custom proc -- Binding parameters and values. ---------------------------------------------------------------------------------------- function buildPlsqlStatment(callbackProc varchar2, tParam tv4000a default noParam) return varchar2 is plsqStmt bigtext; paramName word; begin if (tParam.first is not null) then -- retrieving values of parameters to build plssql statment. plsqStmt := 'Begin '||callbackProc||'('; paramName := tParam.first; while (paramName is not null) loop if (paramName != tParam.first) then plsqStmt := plsqStmt || ', '; end if; plsqStmt := plsqStmt || paramName ||'=>'''|| replace(tParam(paramName), '''', '''''')||''''; paramName := tParam.next(paramName); end loop; plsqStmt := plsqStmt||'); end;'; else plsqStmt := 'Begin '||callbackProc||'; end;'; end if; return plsqStmt; end buildPlsqlStatment; ---------------------------------------------------------------------------------------- -- Header : Procedure that hook the callback procedure for the repetitive header on each page; ---------------------------------------------------------------------------------------- procedure Header is plsqStmt bigtext; begin -- MyHeader_Proc defined in Declaration if (not empty(MyHeader_Proc)) then -- building plsql stmt. plsqStmt := buildPlsqlStatment(MyHeader_Proc, MyHeader_ProcParam); -- Executing callback. execute immediate plsqStmt; end if; exception when others then error('Header : '||sqlerrm||' statement : '||plsqStmt); end Header; ---------------------------------------------------------------------------------------- -- Footer : Procedure that hook the callback procedure for the repetitive footer on each page; ---------------------------------------------------------------------------------------- procedure Footer is plsqStmt bigtext; begin -- MyFooter_Proc defined in Declaration if (not empty(MyFooter_Proc)) then -- building plsql stmt. plsqStmt := buildPlsqlStatment(MyFooter_Proc, MyFooter_ProcParam); -- Executing callback. execute immediate plsqStmt; end if; exception when others then error('Footer : '||sqlerrm||' statement : '||plsqStmt); end Footer; ---------------------------------------------------------------------------------------- function PageNo return number is begin -- Get current page number return page; end PageNo; ---------------------------------------------------------------------------------------- procedure SetDrawColor(r number,g number default -1,b number default -1) is begin -- Set color for all stroking operations if((r=0 and g=0 and b=0) or g=-1) then DrawColor:=tochar(r/255,3)||' G'; else DrawColor:=tochar(r/255,3) || ' ' || tochar(g/255,3) || ' ' || tochar(b/255,3) || ' RG'; end if; if(page>0) then p_out(DrawColor); end if; end SetDrawColor; ---------------------------------------------------------------------------------------- procedure SetFillColor (r number,g number default -1,b number default -1) is begin -- Set color for all filling operations if((r=0 and g=0 and b=0) or g=-1) then FillColor:=tochar(r/255,3) || ' g'; else FillColor:=tochar(r/255,3) ||' '|| tochar(g/255,3) ||' '|| tochar(b/255,3) || ' rg'; end if; if (FillColor!=TextColor) then ColorFlag:=true; else ColorFlag:=false; end if; if(page>0) then p_out(FillColor); end if; end SetFillColor; ---------------------------------------------------------------------------------------- procedure SetTextColor (r number,g number default -1,b number default -1) is begin -- Set color for text if((r=0 and g=0 and b=0) or g=-1) then TextColor:=tochar(r/255,3) || ' g'; else TextColor:=tochar(r/255,3) ||' '|| tochar(g/255,3) ||' '|| tochar(b/255,3) || ' rg'; end if; if (FillColor!=TextColor) then ColorFlag:=true; else ColorFlag:=false; end if; end SetTextColor; ---------------------------------------------------------------------------------------- procedure SetLineWidth(width number) is begin -- Set line width LineWidth:=width; if(page>0) then p_out(tochar(width*k,2) ||' w'); end if; end SetLineWidth; ---------------------------------------------------------------------------------------- procedure Line(x1 number,y1 number,x2 number,y2 number) is begin -- Draw a line p_out( tochar(x1*k,2) || ' ' || tochar((h-y1)*k,2) || ' m ' || tochar(x2*k,2) || ' ' || tochar((h-y2)*k,2) || ' l S'); end Line; ---------------------------------------------------------------------------------------- procedure Rect(px number,py number,pw number,ph number,pstyle varchar2 default '') is op word; begin -- Draw a rectangle if(pstyle='F') then op:='f'; elsif(pstyle='FD' or pstyle='DF') then op:='B'; else op:='S'; end if; p_out(tochar(px*k,2) || ' ' || tochar((h-py)*k,2) || ' ' || tochar(pw*k,2) || ' ' || tochar(-ph*k,2) || ' re ' || op); end Rect; ---------------------------------------------------------------------------------------- function AddLink return number is nb_link number; --:= links.count + 1; begin nb_link := nvl(links.last+1,1); links.extend(1); -- Create a new internal link links(nb_link).zero := 0; links(nb_link).un := 0; return nb_link; end AddLink; ---------------------------------------------------------------------------------------- procedure SetLink(plink number,py number default 0,ppage number default -1) is mypy number := py; myppage number := ppage; begin -- Set destination of internal link if(mypy=-1) then mypy:=y; end if; if(myppage=-1) then myppage:=page; end if; links(plink).zero:=myppage; links(plink).un:=mypy; end SetLink; ---------------------------------------------------------------------------------------- procedure Link(px number,py number,pw number,ph number,plink varchar2) is v_last_plink integer; v_ntoextend integer; v_rec rec5; begin -- Put a link on the page v_last_plink := nvl(PageLinks.last,0); v_ntoextend := v_last_plink+1; PageLinks.extend(1); -- set values PageLinks(v_ntoextend).page:=page; PageLinks(v_ntoextend).zero:=px*k; PageLinks(v_ntoextend).un:=hPt-py*k; PageLinks(v_ntoextend).deux:=pw*k; PageLinks(v_ntoextend).trois:=ph*k; PageLinks(v_ntoextend).quatre:=plink; end Link; ---------------------------------------------------------------------------------------- procedure Text(px number,py number,ptxt varchar2) is s varchar2(2000); begin -- Output a string s:='BT '|| tochar(px*k,2) ||' '|| tochar((h-py)*k,2) ||' Td ('||p_escape(ptxt)||') Tj ET'; if(underline and ptxt is not null) then s := s || ' ' || p_dounderline(px,py,ptxt); end if; if(ColorFlag) then s := 'q '|| TextColor ||' ' || s || ' Q'; end if; p_out(s); end Text; ---------------------------------------------------------------------------------------- function AcceptPageBreak return boolean is begin -- Accept automatic page break or not return AutoPageBreak; end AcceptPageBreak; ---------------------------------------------------------------------------------------- procedure OpenPDF is begin -- Begin document state:=1; end OpenPDF; ---------------------------------------------------------------------------------------- procedure ClosePDF is begin -- Terminate document if(state=3) then return; end if; if(page=0) then AddPage(); end if; -- Page footer InFooter:=true; Footer(); InFooter:=false; -- Close page p_endpage(); -- Close document p_enddoc(); end ClosePDF; ---------------------------------------------------------------------------------------- procedure AddPage(orientation varchar2 default '') is myFamily txt; myStyle txt; mySize number := fontsizePt; lw phrase := LineWidth; dc phrase := DrawColor; fc phrase := FillColor; tc phrase := TextColor; cf flag := ColorFlag; begin -- Start a new page if(state=0) then OpenPDF(); end if; myFamily:= FontFamily; if (underline) then myStyle := FontStyle || 'U'; end if; if(page>0) then -- Page footer InFooter:=true; Footer(); InFooter:=false; -- Close page p_endpage(); end if; -- Start new page p_beginpage(orientation); -- Set line cap style to square p_out('2 J'); -- Set line width LineWidth:=lw; p_out(tochar(lw*k)||' w'); -- Set font if(myFamily is not null) then SetFont(myFamily,myStyle,mySize); end if; -- Set colors DrawColor:=dc; if(dc!='0 G') then p_out(dc); end if; FillColor:=fc; if(fc!='0 g') then p_out(fc); end if; TextColor:= tc; ColorFlag:= cf; -- Page header header(); -- Restore line width if(LineWidth!=lw) then LineWidth:=lw; p_out(tochar(lw*k)||' w'); end if; -- Restore font if myFamily is null then SetFont(myFamily,myStyle,mySize); end if; -- Restore colors if(DrawColor!=dc) then DrawColor:=dc; p_out(dc); end if; if(FillColor!=fc) then FillColor:=fc; p_out(fc); end if; TextColor:=tc; ColorFlag:=cf; end AddPage; ---------------------------------------------------------------------------------------- procedure fpdf (orientation varchar2 default 'P', unit varchar2 default 'mm', format varchar2 default 'A4') is myorientation word := orientation; myformat word := format; mymargin margin; begin -- Some checks p_dochecks(); -- Initialization of properties page:=0; n:=2; -- Open the final structure for the PDF document. pdfDoc(1) := null; state:=0; InFooter:=false; lasth:=0; --FontFamily:=''; FontFamily:='helvetica'; fontstyle:=''; fontsizePt:=12; underline:=false; DrawColor:='0 G'; FillColor:='0 g'; TextColor:='0 g'; ColorFlag:=false; ws:=0; -- Standard fonts CoreFonts('courier') := 'Courier'; CoreFonts('courierB') := 'Courier-Bold'; CoreFonts('courierI') := 'Courier-Oblique'; CoreFonts('courierBI') := 'Courier-BoldOblique'; CoreFonts('helvetica') := 'Helvetica'; CoreFonts('helveticaB') := 'Helvetica-Bold'; CoreFonts('helveticaI') := 'Helvetica-Oblique'; CoreFonts('helveticaBI') := 'Helvetica-BoldOblique'; CoreFonts('times') := 'Times-Roman'; CoreFonts('timesB') := 'Times-Bold'; CoreFonts('timesI') := 'Times-Italic'; CoreFonts('timesBI') := 'Times-BoldItalic'; CoreFonts('symbol') := 'Symbol'; CoreFonts('zapfdingbats') := 'ZapfDingbats'; -- Scale factor if(unit='pt') then k:=1; elsif(unit='mm') then k:=72/25.4; elsif(unit='cm') then k:=72/2.54; elsif(unit='in') then k:=72; else Error('Incorrect unit: ' || unit); end if; -- Others added properties Linespacing := fontsizePt / k; -- minimum line spacing in multicell -- Page format if(is_string(myformat)) then myformat:=strtolower(myformat); if(myformat='a3') then formatArray.largeur := 841.89; formatArray.hauteur := 1190.55; elsif(myformat='a4') then formatArray.largeur := 595.28; formatArray.hauteur := 841.89; elsif(myformat='a5') then formatArray.largeur := 420.94; formatArray.hauteur := 595.28; elsif(myformat='letter') then formatArray.largeur := 612; formatArray.hauteur := 792; elsif(myformat='legal') then formatArray.largeur := 612; formatArray.hauteur := 1008; else Error('Unknown page format: '|| myformat); end if; fwPt:=formatArray.largeur; fhPt:=formatArray.hauteur; else fwPt:=formatArray.largeur*k; fhPt:=formatArray.hauteur*k; end if; fw:=fwPt/k; fh:=fhPt/k; -- Page orientation myorientation:=strtolower(myorientation); if(myorientation='p' or myorientation='portrait') then DefOrientation:='P'; wPt:=fwPt; hPt:=fhPt; elsif(myorientation='l' or myorientation='landscape') then DefOrientation:='L'; wPt:=fhPt; hPt:=fwPt; else Error('Incorrect orientation: ' || myorientation); end if; CurOrientation:=DefOrientation; w:=wPt/k; h:=hPt/k; -- Page margins (1 cm) mymargin:=28.35/k; SetMargins(mymargin,mymargin); -- Interior cell margin (1 mm) cMargin:=mymargin/10; -- Line width (0.2 mm) LineWidth:=.567/k; -- Automatic page break SetAutoPageBreak(true,2*mymargin); -- Full width display mode SetDisplayMode('fullwidth'); -- Disable compression SetCompression(false); -- Set default PDF version number PDFVersion:='1.3'; -- MBR 03.03.2010: re-initialize images collection images.delete; end fpdf; ---------------------------------------------------------------------------------------- procedure AddFont (family varchar2, style varchar2 default '',filename varchar2 default '') is myfamily word := family; mystyle word := style; myfile word := filename; fontkey word; fontCount number; i pls_integer; d pls_integer; nb pls_integer; myDiff varchar2(2000); myType varchar2(256); -- ????????? Cette variable est peut-être globale ???????????? -- tabNull tv4000; begin -- Add a TrueType or Type1 font myfamily:=strtolower(myfamily); if myfile is null then myfile:=str_replace(' ','',myfamily) || strtolower(mystyle) || '.php'; end if; if(myfamily='arial') then myfamily:='helvetica'; end if; mystyle:=strtoupper(mystyle); if(mystyle='IB') then mystyle:='BI'; end if; fontkey:=myfamily || mystyle; if(fonts.exists(fontkey)) then Error('Font already added: ' || myfamily || ' ' || mystyle); end if; p_includeFont(fontkey); fontCount:=nvl(fonts.count, 0) + 1; fonts(fontkey).i := fontCount; fonts(fontkey).type := 'core'; fonts(fontkey).name := coreFonts(fontkey); fonts(fontkey).up := -100; fonts(fontkey).ut := 50; fonts(fontkey).cw := fpdf_charWidths(fontkey); fonts(fontkey).file := myfile; if(myDiff is not null) then -- Search existing encodings d:=0; nb:=diffs.count; for i in 1..nb loop if(diffs(i) = myDiff) then d:=i; exit; end if; end loop; if(d=0) then d:=nb+1; diffs(d):=myDiff; end if; fonts(fontkey).diff:=d; end if; if(myfile is not null) then if(myType = 'TrueType') then FontFiles(myfile).length1 := originalsize; else FontFiles(myfile).length1 := size1; FontFiles(myfile).length2 := size2; end if; end if; end AddFont; ---------------------------------------------------------------------------------------- procedure SetFont(pfamily varchar2,pstyle varchar2 default '',psize number default 0) is myfamily word := pfamily; mystyle word := pstyle; mysize number := psize; FontCount number := 0; myFontFile word; fontkey word; -- tabnull tv4000; begin -- Select a font; size given in points myfamily:=strtolower(myfamily); if myfamily is null then myfamily:=FontFamily; end if; if(myfamily='arial') then myfamily:='helvetica'; elsif(myfamily='symbol' or myfamily='zapfdingbats') then mystyle:=''; end if; mystyle:=strtoupper(mystyle); if(instr(mystyle,'U') > 0) then underline:=true; mystyle:=str_replace('U','',mystyle); else underline:=false; end if; if(mystyle='IB') then mystyle:='BI'; end if; if(mysize=0) then mysize:=fontsizePt; end if; -- Test if font is already selected if(FontFamily=myfamily and fontstyle=mystyle and fontsizePt=mysize) then return; end if; -- Test if used for the first time fontkey:=nvl(myfamily || mystyle, ''); --if(not fontsExists(fontkey)) then if(not fonts.exists(fontkey)) then -- Check if one of the standard fonts if(CoreFonts.exists(fontkey)) then --if(not fpdf_charwidthsExists(fontkey)) then if(not fpdf_charwidths.exists(fontkey)) then -- Load metric file myFontFile:=myfamily; if(myfamily='times' or myfamily='helvetica') then myFontFile:=myFontFile || strtolower(mystyle); end if; -- p_includeFont(fontkey); -- if(not fpdf_charwidthsExists(fontkey)) then Error('Could not include font metric file'); end if; end if; FontCount:=nvl(fonts.count,0) + 1; fonts(fontkey).i := FontCount; fonts(fontkey).type := 'core'; fonts(fontkey).name := CoreFonts(fontkey); fonts(fontkey).up := -100; fonts(fontkey).ut := 50; fonts(fontkey).cw := fpdf_charwidths(fontkey); else Error('Undefined font: ' || myfamily || ' ' || mystyle); end if; end if; -- Select it FontFamily:=myfamily; fontstyle:=mystyle; fontsizePt:=mysize; fontsize:=mysize/k; -- if(fontsExists(fontkey)) then CurrentFont:= fonts(fontkey); -- end if; if(page>0) then p_out('BT /F'||CurrentFont.i||' '||tochar(fontsizePt,2)||' Tf ET'); end if; end SetFont; ---------------------------------------------------------------------------------------- function GetStringWidth(pstr varchar2) return number is charSetWidth CharSet; w number; lg number; wdth number; c car; begin -- Get width of a string in the current font charSetWidth := CurrentFont.cw; w:=0; lg := strlen(pstr); for i in 1..lg loop wdth := 0; c := substr(pstr,i,1); --if (charSetWidth.exists(c)) then wdth := charSetWidth(c); --end if; w:= w + wdth; end loop; return w * fontsize/1000; end GetStringWidth; ---------------------------------------------------------------------------------------- procedure SetFontSize(psize number) is begin -- Set font size in points if(fontsizePt=psize) then return; end if; fontsizePt:=psize; fontsize:=psize/k; if(page>0) then p_out('BT /F'||CurrentFont.i||' '||tochar(fontsizePt,2)||' Tf ET'); end if; end SetFontSize; ---------------------------------------------------------------------------------------- procedure Cell (pw number, ph number default 0, ptxt varchar2 default '', pborder varchar2 default '0', pln number default 0, palign varchar2 default '', pfill number default 0, plink varchar2 default '') is myPW number := pw; myK k%type := k; myX x%type := x; myY y%type := y; myWS ws%type := ws; myS bigtext; -- was: txt myOP bigtext; -- was: txt myDX number; myTXT2 bigtext; -- was: txt begin null; -- Output a cell if( ( y + ph > pageBreakTrigger) and not InFooter and AcceptPageBreak()) then -- Automatic page break if(myWS > 0) then ws:=0; p_out('0 Tw'); end if; AddPage(CurOrientation); x:=myX; if(myWS > 0) then ws := myWS; p_out(tochar(myWS * myK,3) ||' Tw'); end if; end if; if(myPW = 0) then myPW := w - rMargin - x; end if; myS := ''; if(pfill = 1 or pborder = '1') then if(pfill = 1) then if (pborder = '1') then myOP := 'B'; else myOP := 'f'; end if; else myOP := 'S'; end if; myS := tochar(x*myK,2)||' '||tochar((h-y)*myK,2)||' '||tochar(myPW*myK,2)||' '||tochar(-ph*myK,2)||' re '||myOP||' '; end if; if(is_string(pborder)) then myX := x; myY := y; if(instr(pborder,'L') > 0) then myS := myS || tochar(myX*myK,2) ||' '||tochar((h-myY)*myK,2)||' m '||tochar(myX*myK,2)||' '||tochar((h-(myY+ph))*myK,2)||' l S '; end if; if(instr(pborder,'T') > 0) then myS := myS || tochar(myX*myK,2)||' '||tochar((h-myY)*myK,2)||' m '||tochar((myX+myPW)*myK,2)||' '||tochar((h-myY)*myK,2)||' l S '; end if; if(instr(pborder,'R') > 0) then myS := myS || tochar((myX+myPW)*myK,2)||' '||tochar((h-myY)*myK,2)||' m '||tochar((myX+myPW)*myK,2)||' '||tochar((h-(myY+ph))*myK,2)||' l S '; end if; if(instr(pborder,'B') > 0) then myS := myS || tochar(myX*myK,2)||' '||tochar((h-(myY+ph))*myK,2)||' m '||tochar((myX+myPW)*myK,2)||' '||tochar((h-(myY+ph))*myK,2)||' l S '; end if; end if; if ptxt is not null then if(palign='R') then myDX := myPW - cMargin - GetStringWidth(ptxt); elsif(palign='C') then myDX := (myPW - GetStringWidth(ptxt))/2; else myDX := cMargin; end if; if(ColorFlag) then myS := myS || 'q ' || TextColor || ' '; end if; -- myTXT2 := str_replace(')','\\)',str_replace('(','\\(',str_replace('\\','\\\\',ptxt))); myTXT2 := str_replace('\\','\\\\',ptxt); -- FDL 20.06.2011: Need to espace paranthesis in the text myTXT2 := p_escape (myTXT2); myS := myS || 'BT '||tochar((x+myDX)*myK,2)||' '||tochar((h-(y+.5*ph+.3*fontsize))*myK,2)||' Td ('||myTXT2||') Tj ET'; if(underline) then myS := myS || ' ' || p_dounderline(x+myDX,y+.5*ph+.3*fontsize,ptxt); end if; if(ColorFlag) then myS := myS || ' Q'; end if; if(not empty(plink)) then Link(x + myDX,y + .5*ph - .5*fontsize, GetStringWidth(ptxt), fontsize, plink); end if; end if; if(not empty(myS)) then p_out(myS); end if; lasth := ph; if( pln>0 ) then -- Go to next line y := y + ph; if(pln=1) then x := lMargin; end if; else x := x + myPW; end if; exception when others then error('Cell : '||sqlerrm); end Cell; ---------------------------------------------------------------------------------------- -- MultiCell : Output text with automatic or explicit line breaks -- param phMax : give the max height for the multicell. (0 if non applicable) -- if ph is null : the minimum height is the value of the property LineSpacing ---------------------------------------------------------------------------------------- procedure MultiCell ( pw number, ph number default 0, ptxt varchar2, pborder varchar2 default '0', palign varchar2 default 'J', pfill number default 0, phMax number default 0) is charSetWidth CharSet; myPW number := pw; myBorder word := pborder; myS bigtext; -- was: txt myNB number; wmax number; myB bigtext; -- was: txt myB2 bigtext; -- was: txt sep number := -1; -- i number := 0; -- j number := 0; i number := 1; j number := 1; l number := 0; ns number := 0; nl number := 1; carac word; lb_skip boolean := false; ls number; cumulativeHeight number := 0; myH number := pH; begin -- Output text with automatic or explicit line breaks -- see if we need to set Height to the minimum linespace if (myH = 0) then myH := getLineSpacing; end if; charSetWidth := CurrentFont.cw; if(myPW = 0) then myPW:=w - rMargin - x; end if; wmax := (myPW - 2 * cMargin) * 1000 / fontsize; myS := str_replace(CHR(13),'',ptxt); myNB := strlen(myS); if(myNB > 0 and substr(myS,-1) = CHR(10) ) then myNB := myNB - 1; end if; myB := 0; if (myBorder is not null) then if(myBorder = '1') then myBorder :='LTRB'; myB := 'LRT'; myB2 := 'LR'; else myB2 := ''; if(instr(myBorder,'L') > 0) then myB2 := myB2 || 'L'; end if; if(instr(myBorder,'R') > 0) then myB2 := myB2 || 'R'; end if; if (instr(myBorder,'T') > 0) then myB := myB2 || 'T'; else myB := myB2; end if; end if; end if; while(i <= myNB) loop lb_skip := false; -- Get next character carac := substr(myS,i,1); if(carac = CHR(10)) then -- Explicit line break if(ws > 0) then ws := 0; p_out('0 Tw'); end if; Cell(myPW,myH,substr(myS,j,i-j),myB,2,palign,pfill); cumulativeHeight := cumulativeHeight + myH; i := i + 1; sep := -1; j := i; l := 0; ns := 0; nl := nl + 1; if(myBorder is not null and nl = 2) then myB := myB2; end if; -- si on passe là on continue à la prochaine itération de la boucle -- en PHP il y avait l'instruction "continue" . lb_skip := true; end if; if (not lb_skip) then if(carac =' ') then sep := i; ls := l; ns := ns + 1; end if; l := l + charSetWidth (carac); if( l > wmax) then -- Automatic line break if(sep=-1) then if(i=j) then i := i + 1; end if; if(ws > 0) then ws := 0; p_out('0 Tw'); end if; Cell(myPW,myH,substr(myS,j,i-j),myB,2,palign,pfill); else if(palign = 'J') then if (ns > 1) then ws := (wmax - ls)/1000*fontsize/(ns-1); else ws := 0; end if; p_out(''|| tochar(ws*k,3) ||' Tw'); end if; Cell(myPW,myH,substr(myS,j,sep-j),myB,2,palign,pfill); i := sep + 1; end if; cumulativeHeight := cumulativeHeight + myH; sep := -1; j := i; l := 0; ns := 0; nl := nl + 1; if(myBorder is not null and nl = 2) then myB := myB2; end if; else i := i + 1; end if; end if; end loop; -- Last chunk if(ws > 0) then ws := 0; p_out('0 Tw'); end if; if(myBorder is not null and instr(myBorder,'B') > 0) then if (phMax > 0) then if (cumulativeHeight >= phMax) then myB := myB || 'B'; end if; else myB := myB || 'B'; end if; end if; Cell(myPW,myH,substr(myS,j,i-j),myB,2,palign,pfill); cumulativeHeight := cumulativeHeight + myH; -- add an empty cell if phMax is not reached. if (phMax > 0) then if ( cumulativeHeight < phMax ) then -- dealing with the bottom border. if(myBorder is not null and instr(myBorder,'B') > 0) then myB := myB || 'B'; end if; Cell(myPW,phMax-cumulativeHeight,null,myB,2,palign,pfill); end if; end if; x := lMargin; exception when others then error('MultiCell : '||sqlerrm); end MultiCell; ---------------------------------------------------------------------------------------- procedure image ( pFile varchar2, pX number, pY number, pWidth number default 0, pHeight number default 0, pType varchar2 default null, pLink varchar2 default null) is myFile varchar2(2000) := pFile; -- myType varchar2(256) := pType; myW number := pWidth; myH number := pHeight; -- pos number; info recImage; begin --Put an image on the page if ( not imageExists(myFile) ) then --First use of image, get info info := p_parseImage(myFile); info.i := nvl(images.count, 0) + 1; images(lower(myFile)) := info; else info := images(lower(myFile)); end if; --Automatic width and height calculation if needed if(myW = 0 and myH = 0) then --Put image at 72 dpi myW := info.w / k; myH := info.h / k; end if; if (myW = 0) then myW := myH * info.w / info.h; end if; if (myH = 0) then myH := myW * info.h / info.w; end if; p_out('q '||tochar(myW * k, 2)||' 0 0 '||tochar(myH * k, 2)||' '||tochar(pX * k, 2)||' '||tochar((h - ( pY + myH)) * k, 2)||' cm /I'||to_char(info.i)||' Do Q'); if(pLink is not null) then Link(pX,pY,myW,myH,pLink); end if; exception when others then error('image : '||sqlerrm); end image; /* THIS PROCEDURE HANGS UP ........... */ ---------------------------------------------------------------------------------------- procedure Write(pH varchar2,ptxt varchar2,plink varchar2 default null) is charSetWidth CharSet; myW number; -- remaining width from actual position in user units myWmax number; -- remaining cellspace s bigtext; c word; nb pls_integer; sep pls_integer; i pls_integer; j pls_integer; l pls_integer; lsep pls_integer; lastl pls_integer; begin -- Output text in flowing mode charSetWidth := CurrentFont.cw; myW := w - rMargin - x; myWmax := (myW - 2 * cMargin) * 1000 / FontSize; s := str_replace(chr(13),'',ptxt); nb := strlen(s); sep := -1; -- no blank space encountered, position of last blank i := 1; -- running position j := 1; -- last remembered position , start for next output l := 0; -- string length since last written lsep := 0; -- position of last blank lastl := 0; -- length till that blank -- Loop over all characters while i <= nb loop -- Get next character c := substr(s, i, 1); -- Explicit line break if(c = chr(10)) then Cell(myW, pH, substr(s,j,i-j), 0, 1, '', 0, plink); -- positioned at beginning of new line i := i + 1; sep := -1; j := i; l := 0; myW := w - rMargin - x; myWmax := (myW - 2 * cMargin) * 1000 / FontSize; -- whole line else if c = ' ' then sep := i; lsep := 0; lastl := l; else lsep := lsep + charSetWidth(c); end if; l := l + charSetWidth(c); if l > myWmax then -- Automatic line break if sep = -1 then -- forced Cell(myW, pH, substr(s,j,i-j+1), 0, 1, '', 0, plink); i := i + 1; j := i; l := 0; else -- wrap at last blank Cell(myW, pH, substr(s,j,sep-j), 0, 1, '', 0, plink); i := sep + 1; j := i; sep := -1; l := lsep-(myWmax-lastl); -- rest remaining space from previous line -- WHY ???? end if; myW := w - rMargin - x; myWmax := (myW - 2 * cMargin) * 1000 / FontSize; else i := i + 1; end if; end if; end loop; -- Last chunk if( i != j ) then Cell((l+2*cMargin) / 1000 * FontSize, pH, substr(s,j), 0, 0, '', 0, plink); end if; exception when others then error('write : '||sqlerrm); end write; procedure htp_print_clob (p_clob in clob) as l_buffer varchar2(32767); c_max_size constant integer := 8000; -- 32767 l_start integer := 1; l_cloblen integer; begin if p_clob is not null then l_cloblen := dbms_lob.getlength (p_clob ); loop l_buffer := dbms_lob.substr (p_clob, c_max_size, l_start); htp.prn (l_buffer); l_start := l_start + c_max_size; exit when l_start > l_cloblen; end loop ; end if; end htp_print_clob; ---------------------------------------------------------------------------------------- procedure Output(pname varchar2 default null,pdest varchar2 default null) is myName word := pname; myDest word := pdest; v_doc blob; -- finally complete document v_blob blob; v_clob clob; v_in pls_integer; v_out pls_integer; v_lang pls_integer; v_warning pls_integer; v_len pls_integer; begin dbms_lob.createtemporary(v_blob, false, dbms_lob.session); dbms_lob.createtemporary(v_doc, false, dbms_lob.session); -- Output PDF to some destination -- Finish document if necessary if state < 3 then ClosePDF(); end if; myDest := strtoupper(myDest); if(myDest is null) then if(myName is null) then myName := 'doc.pdf'; myDest := 'I'; else myDest := 'D'; end if; end if; if (myDest = 'I') then -- Send as pdf to a browser OWA_UTIL.MIME_HEADER('application/pdf',false); htp.print('Content-Length: ' || getPDFDocLength()); htp.print('Content-disposition: inline; filename="' || myName || '"'); owa_util.http_header_close; -- restitution du contenu... v_len := 1; for i in pdfDoc.first..pdfDoc.last loop v_clob := pdfDoc(i); if v_clob is not null then v_in := 1; v_out := 1; v_lang := 0; v_warning := 0; v_len := dbms_lob.getlength(v_clob); -- empty the blob (otherwise it will keep growing because the converttoblob parameter is in/out) dbms_lob.trim(v_blob,0); dbms_lob.convertToBlob(v_blob, v_clob, v_len, v_in, v_out, dbms_lob.default_csid, v_lang, v_warning); --dbms_lob.convertToBlob(v_blob, v_clob, v_len, v_in, v_out, nls_charset_id('AL32UTF8'), v_lang, v_warning); dbms_lob.append(v_doc, dbms_lob.substr(v_blob, v_len)); end if; end loop; wpg_docload.download_file(v_doc); elsif (myDest = 'D') then -- Download file if(not empty(owa_util.get_cgi_env('HTTP_USER_AGENT')) and instr(owa_util.get_cgi_env('HTTP_USER_AGENT'),'MSIE') > 0) then OWA_UTIL.MIME_HEADER('application/force-download',false); else OWA_UTIL.MIME_HEADER('application/octet-stream',false); end if; htp.print('Content-Length: ' || getPDFDocLength()); htp.print('Content-disposition: attachment; filename="' || myName || '"'); owa_util.http_header_close; -- restitution du contenu... for i in pdfDoc.first..pdfDoc.last loop --htp.prn(pdfDoc(i)); htp_print_clob (pdfDoc(i)); end loop; elsif (myDest = 'S') then --OWA_UTIL.MIME_HEADER('application/pdf'); OWA_UTIL.MIME_HEADER('text/html'); -- Return as a string for i in pdfDoc.first..pdfDoc.last loop htp.prn(replace(replace(replace(pdfDoc(i),'<', '<'),'>','>'),chr(10),'
')); end loop; else error('Incorrect output destination: ' || myDest); end if; exception when others then error('Output : '||sqlerrm); end Output; function get_output return blob as l_returnvalue blob; l_blob blob; l_clob clob; l_in pls_integer; l_out pls_integer; l_lang pls_integer; l_warning pls_integer; c_max_size constant pls_integer := 8000; -- 32767 l_start pls_integer := 1; l_cloblen pls_integer; begin /* Purpose: Return PDF file as BLOB Remarks: Who Date Description ------ ---------- ------------------------------------- MBR 08.01.2010 Created */ dbms_lob.createtemporary(l_blob, true, dbms_lob.session); dbms_lob.createtemporary(l_returnvalue, true, dbms_lob.session); -- Finish document if necessary if state < 3 then ClosePDF(); end if; for i in pdfDoc.first .. pdfDoc.last loop --debug_pkg.printf('i = %1', i); l_clob := pdfDoc(i); if l_clob is not null then l_cloblen := dbms_lob.getlength (l_clob); l_in := 1; l_out := 1; l_lang := 0; l_warning := 0; --debug_pkg.printf('clob length = %1', l_cloblen); -- empty the blob (otherwise it will keep growing because the converttoblob parameter is in/out) dbms_lob.trim(l_blob,0); dbms_lob.converttoblob(l_blob, l_clob, l_cloblen, l_in, l_out, dbms_lob.default_csid, l_lang, l_warning); --debug_pkg.printf('blob length = %1', dbms_lob.getlength(v_blob)); l_start := 1; loop --debug_pkg.printf('... appending from position %1', l_start); dbms_lob.append(l_returnvalue, dbms_lob.substr (l_blob, c_max_size, l_start)); l_start := l_start + c_max_size; exit when l_start > l_cloblen; end loop ; end if; end loop; return l_returnvalue; end get_output; procedure test(pdest varchar2 default 'D') is begin null; end test; END pdfgen_pkg; /