CREATE OR REPLACE package as_pdf_mini is -- type tp_settings is record( page_width number , page_height number , margin_left number , margin_right number , margin_top number , margin_bottom number , encoding varchar2( 100 ) , current_font pls_integer , current_fontsizept pls_integer , x number , y number , page_nr pls_integer ); -- procedure init; -- function get_pdf return blob; -- procedure save_pdf( p_dir in varchar2 := 'MY_DIR' , p_filename in varchar2 := 'my.pdf' ); -- procedure show_pdf; -- function conv2user_units( p_value in number , p_unit in varchar2 ) return number; -- procedure set_format( p_format in varchar2 := 'A4' , p_orientation in varchar2 := 'PORTRAIT' ); -- procedure set_pagesize( p_width in number , p_height in number , p_unit in varchar2 := 'cm' ); -- procedure set_margins( p_top in number := 3 , p_left in number := 1 , p_bottom in number := 4 , p_right in number := 1 , p_unit in varchar2 := 'cm' ); -- function get_settings return tp_settings; -- procedure new_page; -- procedure set_font( p_family in varchar2 , p_style in varchar2 := 'N' , p_fontsizept in pls_integer := null , p_encoding in varchar2 := 'WINDOWS-1252' ); -- procedure add2page( p_txt in nclob ); -- procedure put_txt( p_x in number , p_y in number , p_txt in nclob ); -- function string_width( p_txt in nclob ) return number; -- procedure write( p_txt in nclob , p_x in number := null , p_y in number := null , p_line_height in number := null , p_start in number := null -- left side of the available text box , p_width in number := null -- width of the available text box , p_alignment in varchar2 := null ); -- procedure set_color( p_rgb in varchar2 := '000000' ); -- procedure set_color( p_red in number := 0 , p_green in number := 0 , p_blue in number := 0 ); -- procedure set_bk_color( p_rgb in varchar2 := 'ffffff' ); -- procedure set_bk_color( p_red in number := 255 , p_green in number := 255 , p_blue in number := 255 ); -- procedure horizontal_line( p_x in number , p_y in number , p_width in number , p_line_width in number := 0.5 , p_line_color in varchar2 := '000000' ); -- procedure vertical_line( p_x in number , p_y in number , p_height in number , p_line_width in number := 0.5 , p_line_color in varchar2 := '000000' ); -- procedure rect( p_x in number , p_y in number , p_width in number , p_height in number , p_line_color in varchar2 := null , p_fill_color in varchar2 := null , p_line_width in number := 0.5 ); -- procedure put_image( p_dir in varchar2 , p_file_name in varchar2 , p_x in number , p_y in number , p_width in number := null , p_height in number := null ); -- procedure put_image( p_url in varchar2 , p_x in number , p_y in number , p_width in number := null , p_height in number := null ); -- procedure put_image( p_img in blob , p_x in number , p_y in number , p_width in number := null , p_height in number := null ); -- end; / CREATE OR REPLACE package body as_pdf_mini is -- type tp_objects_tab is table of number( 10 ) index by pls_integer; type tp_pages_tab is table of blob index by pls_integer; type tp_char_width_tab is table of pls_integer index by pls_integer; type tp_font is record( char_width_tab tp_char_width_tab , standard boolean , family varchar2( 100 ) , style varchar2( 2 ) -- N Normal -- I Italic -- B Bold -- BI Bold Italic , subtype varchar2( 15 ) := 'Type1' , name varchar2( 100 ) , encoding varchar2( 100 ) := 'WINDOWS-1252' ); type tp_font_tab is table of tp_font index by pls_integer; type tp_pls_tab is table of pls_integer index by pls_integer; type tp_img is record( adler32 varchar2( 8 ) , width pls_integer , height pls_integer , color_res pls_integer , color_tab raw( 768 ) , greyscale boolean , pixels blob , type varchar2( 5 ) , nr_colors pls_integer ); type tp_img_tab is table of tp_img index by pls_integer; -- -- pacakges globals pdf_doc blob; -- the blob containing the build PDF document objects_tab tp_objects_tab; pages_tab tp_pages_tab; settings tp_settings; fonts tp_font_tab; used_fonts tp_pls_tab; images tp_img_tab; t_ncharset varchar2( 1000 ); t_lan_ter varchar2( 1000 ); -- procedure init_core_fonts is function init_standard_withs( p_compressed_tab in varchar2 ) return tp_char_width_tab is t_rv tp_char_width_tab; t_tmp raw( 32767 ); begin t_tmp := utl_compress.lz_uncompress ( utl_encode.base64_decode( utl_raw.cast_to_raw( p_compressed_tab ) ) ); for i in 0 .. 255 loop t_rv( i ) := utl_raw.cast_to_binary_integer( utl_raw.substr( t_tmp , i * 4 + 1 , 4 ) ); end loop; return t_rv; end; begin fonts( 1 ).family := 'helvetica'; fonts( 1 ).style := 'N'; -- Normal fonts( 1 ).name := 'Helvetica'; fonts( 1 ).standard := true; fonts( 1 ).char_width_tab := init_standard_withs ( 'H4sIAAAAAAAAC81Tuw3CMBC94FQMgMQOLAGVGzNCGtc0dAxAT+8lsgE7RKJFomOA' || 'SLT4frHjBEFJ8XSX87372C8A1Qr+Ax5gsWGYU7QBAK4x7gTnGLOS6xJPOd8w5NsM' || '2OvFvQidAP04j1nyN3F7iSNny3E6DylPeeqbNqvti31vMpfLZuzH86oPdwaeo6X+' || '5X6Oz5VHtTqJKfYRNVu6y0ZyG66rdcxzXJe+Q/KJ59kql+bTt5K6lKucXvxWeHKf' || '+p6Tfersfh7RHuXMZjHsdUkxBeWtM60gDjLTLoHeKsyDdu6m8VK3qhnUQAmca9BG' || 'Dq3nP+sV/4FcD6WOf9K/ne+hdav+DTuNLeYABAAA' ); -- fonts( 2 ).family := 'helvetica'; fonts( 2 ).style := 'I'; -- Italic fonts( 2 ).name := 'Helvetica-Oblique'; fonts( 2 ).standard := true; fonts( 2 ).char_width_tab := init_standard_withs ( 'H4sIAAAAAAAAC81Tuw3CMBC94FQMgMQOLAGVGzNCGtc0dAxAT+8lsgE7RKJFomOA' || 'SLT4frHjBEFJ8XSX87372C8A1Qr+Ax5gsWGYU7QBAK4x7gTnGLOS6xJPOd8w5NsM' || '2OvFvQidAP04j1nyN3F7iSNny3E6DylPeeqbNqvti31vMpfLZuzH86oPdwaeo6X+' || '5X6Oz5VHtTqJKfYRNVu6y0ZyG66rdcxzXJe+Q/KJ59kql+bTt5K6lKucXvxWeHKf' || '+p6Tfersfh7RHuXMZjHsdUkxBeWtM60gDjLTLoHeKsyDdu6m8VK3qhnUQAmca9BG' || 'Dq3nP+sV/4FcD6WOf9K/ne+hdav+DTuNLeYABAAA' ); -- fonts( 3 ).family := 'helvetica'; fonts( 3 ).style := 'B'; -- Bold fonts( 3 ).name := 'Helvetica-Bold'; fonts( 3 ).standard := true; fonts( 3 ).char_width_tab := init_standard_withs ( 'H4sIAAAAAAAAC8VSsRHCMAx0SJcBcgyRJaBKkxXSqKahYwB6+iyRTbhLSUdHRZUB' || 'sOWXLF8SKCn+ZL/0kizZuaJ2/0fn8XBu10SUF28n59wbvoCr51oTD61ofkHyhBwK' || '8rXusVaGAb4q3rXOBP4Qz+wfUpzo5FyO4MBr39IH+uLclFvmCTrz1mB5PpSD52N1' || 'DfqS988xptibWfbw9Sa/jytf+dz4PqQz6wi63uxxBpCXY7uUj88jNDNy1mYGdl97' || '856nt2f4WsOFed4SpzumNCvlT+jpmKC7WgH3PJn9DaZfA42vlgh96d+wkHy0/V95' || 'xyv8oj59QbvBN2I/iAuqEAAEAAA=' ); -- fonts( 4 ).family := 'helvetica'; fonts( 4 ).style := 'BI'; -- Bold Italic fonts( 4 ).name := 'Helvetica-BoldOblique'; fonts( 4 ).standard := true; fonts( 4 ).char_width_tab := init_standard_withs ( 'H4sIAAAAAAAAC8VSsRHCMAx0SJcBcgyRJaBKkxXSqKahYwB6+iyRTbhLSUdHRZUB' || 'sOWXLF8SKCn+ZL/0kizZuaJ2/0fn8XBu10SUF28n59wbvoCr51oTD61ofkHyhBwK' || '8rXusVaGAb4q3rXOBP4Qz+wfUpzo5FyO4MBr39IH+uLclFvmCTrz1mB5PpSD52N1' || 'DfqS988xptibWfbw9Sa/jytf+dz4PqQz6wi63uxxBpCXY7uUj88jNDNy1mYGdl97' || '856nt2f4WsOFed4SpzumNCvlT+jpmKC7WgH3PJn9DaZfA42vlgh96d+wkHy0/V95' || 'xyv8oj59QbvBN2I/iAuqEAAEAAA=' ); -- fonts( 5 ).family := 'times'; fonts( 5 ).style := 'N'; -- Normal fonts( 5 ).name := 'Times-Roman'; fonts( 5 ).standard := true; fonts( 5 ).char_width_tab := init_standard_withs ( 'H4sIAAAAAAAAC8WSKxLCQAyG+3Bopo4bVHbwHGCvUNNT9AB4JEwvgUBimUF3wCNR' || 'qAoGRZL9twlQikR8kzTvZBtF0SP6O7Ej1kTnSRfEhHw7+Jy3J4XGi8w05yeZh2sE' || '4j312ZDeEg1gvSJy6C36L9WX1urr4xrolfrSrYmrUCeDPGMu5+cQ3Ur3OXvQ+TYf' || '+2FGexOZvTM1L3S3o5fJjGQJX2n68U2ur3X5m3cTvfbxsk9pcsMee60rdTjnhNkc' || 'Zip9HOv9+7/tI3Oif3InOdV/oLdx3gq2HIRaB1Ob7XPk35QwwxDyxg3e09Dv6nSf' || 'rxQjvty8ywDce9CXvdF9R+4y4o+7J1P/I9sABAAA' ); -- fonts( 6 ).family := 'times'; fonts( 6 ).style := 'I'; -- Italic fonts( 6 ).name := 'Times-Italic'; fonts( 6 ).standard := true; fonts( 6 ).char_width_tab := init_standard_withs ( 'H4sIAAAAAAAAC8WSPQ6CQBCFF+i01NB5g63tPcBegYZTeAB6SxNLjLUH4BTEeAYr' || 'Kwpj5ezsW2YgoKXFl2Hnb9+wY4x5m7+TOOJMdIFsRywodkfMBX9aSz7bXGp+gj6+' || 'R4TvOtJ3CU5Eq85tgGsbxG3QN8iFZY1WzpxXwkckFTR7e1G6osZGWT1bDuBnTeP5' || 'KtW/E71c0yB2IFbBphuyBXIL9Y/9fPvhf8se6vsa8nmeQtU6NSf6ch9fc8P9DpqK' || 'cPa5/I7VxDwruTN9kV3LDvQ+h1m8z4I4x9LIbnn/Fv6nwOdyGq+d33jk7/cxztyq' || 'XRhTz/it7Mscg7fT5CO+9ahnYk20Hww5IrwABAAA' ); -- fonts( 7 ).family := 'times'; fonts( 7 ).style := 'B'; -- Bold fonts( 7 ).name := 'Times-Bold'; fonts( 7 ).standard := true; fonts( 7 ).char_width_tab := init_standard_withs ( 'H4sIAAAAAAAAC8VSuw3CQAy9XBqUAVKxAZkgHQUNEiukySxpqOjTMQEDZIrUDICE' || 'RHUVVfy9c0IQJcWTfbafv+ece7u/Izs553cgAyN/APagl+wjgN3XKZ5kmTg/IXkw' || 'h4JqXUEfAb1I1VvwFYysk9iCffmN4+gtccSr5nlwDpuTepCZ/MH0FZibDUnO7MoR' || 'HXdDuvgjpzNxgevG+dF/hr3dWfoNyEZ8Taqn+7d7ozmqpGM8zdMYruFrXopVjvY2' || 'in9gXe+5vBf1KfX9E6TOVBsb8i5iqwQyv9+a3Gg/Cv+VoDtaQ7xdPwfNYRDji09g' || 'X/FvLNGmO62B9jSsoFwgfM+jf1z/SPwrkTMBOkCTBQAEAAA=' ); -- fonts( 8 ).family := 'times'; fonts( 8 ).style := 'BI'; -- Bold Italic fonts( 8 ).name := 'Times-BoldItalic'; fonts( 8 ).standard := true; fonts( 8 ).char_width_tab := init_standard_withs ( 'H4sIAAAAAAAAC8WSuw2DMBCGHegYwEuECajIAGwQ0TBFBnCfPktkAKagzgCRIqWi' || 'oso9fr+Qo5RB+nT2ve+wMWYzf+fgjKmOJFelPhENnS0xANJXHfwHSBtjfoI8nMMj' || 'tXo63xKW/Cx9ONRn3US6C/wWvYeYNr+LH2IY6cHGPkJfvsc5kX7mFjF+Vqs9iT6d' || 'zwEL26y1Qz62nWlvD5VSf4R9zPuon/ne+C45+XxXf5lnTGLTOZCXPx8v9Qfdjdid' || '5vD/f/+/pE/Ur14kG+xjTHRc84pZWsC2Hjk2+Hgbx78j4Z8W4DlL+rBnEN5Bie6L' || 'fsL+1u/InuYCdsdaeAs+RxftKfGdfQDlDF/kAAQAAA==' ); -- fonts( 9 ).family := 'courier'; fonts( 9 ).style := 'N'; -- Normal fonts( 9 ).name := 'Courier'; fonts( 9 ).standard := true; for i in 0 .. 255 loop fonts( 9 ).char_width_tab( i ) := 600; end loop; -- fonts( 10 ).family := 'courier'; fonts( 10 ).style := 'I'; -- Italic fonts( 10 ).name := 'Courier-Oblique'; fonts( 10 ).standard := true; fonts( 10 ).char_width_tab := fonts( 9 ).char_width_tab; -- fonts( 11 ).family := 'courier'; fonts( 11 ).style := 'BI'; -- Bold fonts( 11 ).name := 'Courier-Bold'; fonts( 11 ).standard := true; fonts( 11 ).char_width_tab := fonts( 9 ).char_width_tab; -- fonts( 12 ).family := 'courier'; fonts( 12 ).style := 'BI'; -- Bold Italic fonts( 12 ).name := 'Courier-BoldOblique'; fonts( 12 ).standard := true; fonts( 12 ).char_width_tab := fonts( 9 ).char_width_tab; -- fonts( 13 ).family := 'symbol'; fonts( 13 ).style := 'N'; -- Normal fonts( 13 ).name := 'Symbol'; fonts( 13 ).standard := true; fonts( 13 ).char_width_tab := init_standard_withs ( 'H4sIAAAAAAAAC82SIU8DQRCFZ28xIE+cqcbha4tENKk/gQCJJ6AweIK9H1CHqKnp' || 'D2gTFBaDIcFwCQkJSTG83fem7SU0qYNLvry5nZ25t7NnZkv7c8LQrFhAP6GHZvEY' || 'HOB9ylxGubTfNVRc34mKpFonzBQ/gUZ6Ds7AN6i5lv1dKv8Ab1eKQYSV4hUcgZFq' || 'J/Sec7fQHtdTn3iqfvdrb7m3e2pZW+xDG3oIJ/Li3gfMr949rlU74DyT1/AuTX1f' || 'YGhOzTP8B0/RggsEX/I03vgXPrrslZjfM8/pGu40t2ZjHgud97F7337mXP/GO4h9' || '3WmPPaOJ/jrOs9yC52MlrtUzfWupfTX51X/L+13Vl/J/s4W2S3pSfSh5DmeXerMf' || '+LXhWQAEAAA=' ); -- fonts( 14 ).family := 'zapfdingbats'; fonts( 14 ).style := 'N'; -- Normal fonts( 14 ).name := 'ZapfDingbats'; fonts( 14 ).standard := true; fonts( 14 ).char_width_tab := init_standard_withs ( 'H4sIAAAAAAAAC83ROy9EQRjG8TkzjdJl163SSHR0EpdsVkSi2UahFhUljUKUIgoq' || 'CrvJCtFQyG6EbSSERGxhC0ofQAQFxbIi8T/7PoUPIOEkvzxzzsycdy7O/fUTtToX' || 'bnCuvHPOV8gk4r423ovkGQ5od5OTWMeesmBz/RuZIWv4wCAY4z/xjipeqflC9qAD' || 'aRwxrxkJievSFzrRh36tZ1zttL6nkGX+A27xrLnttE/IBji9x7UvcIl9nPJ9AL36' || 'd1L9hyihoDW10L62cwhNyhntryZVExYl3kMj+zym+CrJv6M8VozPmfr5L8uwJORL' || 'tox7NFHG/Obj79FlwhqZ1X292xn6CbAXP/fjjv6rJYyBtUdl1vxEO6fcRB7bMmJ3' || 'GYZsTN0GdrDL/Ao5j1GZNr5kwqydX5z1syoiYEq5gCtlSrXi+mVbi3PfVAuhoQAE' || 'AAA=' ); -- end; -- function pdf_string( p_txt in blob ) return blob is t_rv blob; t_ind integer; type tp_tab_raw is table of raw( 1 ); tab_raw tp_tab_raw := tp_tab_raw( utl_raw.cast_to_raw( '\' ) , utl_raw.cast_to_raw( '(' ) , utl_raw.cast_to_raw( ')' ) ); begin t_rv := p_txt; for i in tab_raw.first .. tab_raw.last loop t_ind := -1; loop t_ind := dbms_lob.instr( t_rv , tab_raw( i ) , t_ind + 2 ); exit when t_ind <= 0; dbms_lob.copy( t_rv , t_rv , dbms_lob.lobmaxsize , t_ind + 1 , t_ind ); dbms_lob.copy( t_rv , tab_raw( 1 ) , 1 , t_ind , 1 ); end loop; end loop; return t_rv; end; -- function raw2num( p_value in raw ) return number is begin -- note: FFFFFFFF => -1 return utl_raw.cast_to_binary_integer( p_value ); end; -- function to_char_round( p_value in number , p_precision in pls_integer := 2 ) return varchar2 is begin return rtrim( rtrim( to_char( p_value , rpad( '9999999990D' , 11 + p_precision , '0' ) , 'NLS_NUMERIC_CHARACTERS = ''.,''' ) , '0' ) , '.' ); end; -- function file2blob( p_dir in varchar2 , p_file_name in varchar2 ) return blob is file_lob bfile; file_blob blob; begin file_lob := bfilename( p_dir , p_file_name ); dbms_lob.open( file_lob , dbms_lob.file_readonly ); dbms_lob.createtemporary( file_blob , true ); dbms_lob.loadfromfile( file_blob , file_lob , dbms_lob.lobmaxsize ); dbms_lob.close( file_lob ); return file_blob; exception when others then if dbms_lob.isopen( file_lob ) = 1 then dbms_lob.close( file_lob ); end if; if dbms_lob.istemporary( file_blob ) = 1 then dbms_lob.freetemporary( file_blob ); end if; raise; end; -- procedure raw2pdfdoc( p_txt in blob ) is begin dbms_lob.append( pdf_doc , p_txt ); end; -- procedure add2pdfdoc( p_txt in varchar2 ) is begin raw2pdfdoc( utl_raw.concat( utl_raw.cast_to_raw( p_txt ) , hextoraw( '0D0A' ) ) ); end; -- function add_object2pdfdoc( p_txt in varchar2 := null ) return number is t_self number( 10 ); begin t_self := objects_tab.count( ); objects_tab( t_self ) := dbms_lob.getlength( pdf_doc ); add2pdfdoc( t_self || ' 0 obj' ); if p_txt is not null then add2pdfdoc( '<<' || p_txt || '>>' || chr( 13 ) || chr( 10 ) || 'endobj' ); end if; return t_self; end; -- procedure add_object2pdfdoc( p_txt in varchar2 := null ) is t_self number( 10 ); begin t_self := add_object2pdfdoc( p_txt ); end; -- function adler32( p_src in blob ) return varchar2 is s1 pls_integer := 1; s2 pls_integer := 0; begin for i in 1 .. dbms_lob.getlength( p_src ) loop s1 := mod( s1 + utl_raw.cast_to_binary_integer( dbms_lob.substr( p_src , 1 , i ) ) , 65521 ); s2 := mod( s2 + s1 , 65521 ); end loop; return to_char( s2 , 'fm0XXX' ) || to_char( s1 , 'fm0XXX' ); end; -- function flate_encode( p_val in blob ) return blob is t_cpr blob; t_blob blob; -- begin t_cpr := utl_compress.lz_compress( p_val ); t_blob := hextoraw( '789C' ); dbms_lob.copy( t_blob , t_cpr , dbms_lob.getlength( t_cpr ) - 10 - 8 , 3 , 11 ); dbms_lob.append( t_blob , hextoraw( adler32( p_val ) ) ); dbms_lob.freetemporary( t_cpr ); return t_blob; end; -- procedure put_stream( p_stream in blob , p_compress in boolean := true , p_extra in varchar2 := '' ) is t_blob blob; begin if p_compress then t_blob := flate_encode( p_stream ); put_stream( t_blob , false , '/Filter /FlateDecode ' || p_extra ); dbms_lob.freetemporary( t_blob ); else add2pdfdoc( '/Length ' || dbms_lob.getlength( p_stream ) || p_extra || ' >>' ); add2pdfdoc( 'stream' ); raw2pdfdoc( p_stream ); add2pdfdoc( 'endstream' ); end if; end; -- function add_stream( p_stream in blob , p_extra in varchar2 := '' , p_compress in boolean := true ) return number is t_self number( 10 ); begin t_self := add_object2pdfdoc; add2pdfdoc( '<<' ); put_stream( p_stream , p_compress , p_extra ); add2pdfdoc( 'endobj' ); return t_self; end; -- function add_info return number is t_banner varchar2( 1000 ); begin begin select 'running on ' || replace( replace( replace( substr( banner , 1 , 950 ) , '\' , '\\' ) , '(' , '\(' ) , ')' , '\)' ) into t_banner from v$version where instr( upper( banner ) , 'DATABASE' ) > 0; -- t_banner := '/Producer (' || t_banner || ')'; exception when others then null; end; -- return add_object2pdfdoc ( '/CreationDate (D:' || to_char( sysdate , 'YYYYMMDDhh24miss' ) || ')' || '/Creator (AS-PDF mini 0.2.0 by Anton Scheffer)' || t_banner ); end; -- function add_font( p_index in pls_integer ) return number is begin return add_object2pdfdoc( '/Type/Font' || '/Subtype/' || fonts( p_index ).subtype || '/BaseFont/' || fonts( p_index ).name || '/Encoding/WinAnsiEncoding' -- code page 1252 ); end; -- procedure add_image( p_img in tp_img ) is t_self number( 10 ); t_pallet number( 10 ); begin if p_img.color_tab is not null then t_pallet := add_stream( p_img.color_tab ); else t_pallet := add_object2pdfdoc; -- add an empty object add2pdfdoc( 'endobj' ); end if; t_self := add_object2pdfdoc; add2pdfdoc( '<>' ); else put_stream( p_img.pixels ); end if; add2pdfdoc( 'endobj' ); end; -- function add_resources return number is t_ind pls_integer; t_self number( 10 ); t_fonts tp_objects_tab; begin -- t_ind := used_fonts.first; while t_ind is not null loop t_fonts( t_ind ) := add_font( t_ind ); t_ind := used_fonts.next( t_ind ); end loop; -- t_self := add_object2pdfdoc; add2pdfdoc( '<>' ); if images.count( ) > 0 then add2pdfdoc( '/XObject <<' ); for i in images.first .. images.last loop add2pdfdoc( ' /I' || to_char( i ) || ' ' || to_char( t_self + 2 * i ) || ' 0 R' ); end loop; add2pdfdoc( '>>' ); end if; add2pdfdoc( '>>' ); add2pdfdoc( 'endobj' ); -- if images.count( ) > 0 then for i in images.first .. images.last loop add_image( images( i ) ); end loop; end if; -- return t_self; end; -- procedure add_page( p_page_nr in pls_integer , p_parent in number , p_resources in number ) is t_content number( 10 ); begin t_content := add_stream( pages_tab( p_page_nr ) ); add_object2pdfdoc; add2pdfdoc( '<< /Type /Page' ); add2pdfdoc( '/Parent ' || to_char( p_parent ) || ' 0 R' ); add2pdfdoc( '/Contents ' || to_char( t_content ) || ' 0 R' ); add2pdfdoc( '/Resources ' || to_char( p_resources ) || ' 0 R' ); add2pdfdoc( '>>' ); add2pdfdoc( 'endobj' ); end; -- function add_pages return number is t_self number( 10 ); t_resources number( 10 ); begin t_resources := add_resources; t_self := add_object2pdfdoc; add2pdfdoc( '<>' ); add2pdfdoc( 'endobj' ); -- for i in pages_tab.first .. pages_tab.last loop add_page( i , t_self , t_resources ); end loop; -- return t_self; end; -- function add_catalogue return number is begin return add_object2pdfdoc( '/Type/Catalog' || '/Pages ' || to_char( add_pages ) || ' 0 R' || '/OpenAction [0 /XYZ null null 1]' ); end; -- procedure finish_pdf is t_xref number( 10 ); t_info number( 10 ); t_catalogue number( 10 ); begin add2pdfdoc( '%PDF-1.3' ); raw2pdfdoc( hextoraw( '25E2E3CFD30D0A' ) ); -- add a hex comment t_info := add_info; t_catalogue := add_catalogue; t_xref := dbms_lob.getlength( pdf_doc ); add2pdfdoc( 'xref' ); add2pdfdoc( '0 ' || to_char( objects_tab.count( ) ) ); add2pdfdoc( '0000000000 65535 f ' ); for i in 1 .. objects_tab.count( ) - 1 loop add2pdfdoc( to_char( objects_tab( i ) , 'fm0000000000' ) || ' 00000 n' ); -- this line should be exactly 20 bytes, including EOL end loop; add2pdfdoc( 'trailer' ); add2pdfdoc( '<< /Root ' || to_char( t_catalogue ) || ' 0 R' ); add2pdfdoc( '/Info ' || to_char( t_info ) || ' 0 R' ); add2pdfdoc( '/Size ' || to_char( objects_tab.count( ) ) ); add2pdfdoc( '>>' ); add2pdfdoc( 'startxref' ); add2pdfdoc( to_char( t_xref ) ); add2pdfdoc( '%%EOF' ); -- objects_tab.delete; for i in pages_tab.first .. pages_tab.last loop dbms_lob.freetemporary( pages_tab( i ) ); end loop; pages_tab.delete; fonts.delete; used_fonts.delete; if images.count( ) > 0 then for i in images.first .. images.last loop if dbms_lob.istemporary( images( i ).pixels ) = 1 then dbms_lob.freetemporary( images( i ).pixels ); end if; end loop; end if; images.delete; settings := null; end; -- function get_settings return tp_settings is begin return settings; end; -- procedure new_page is begin pages_tab( pages_tab.count( ) ) := null; dbms_lob.createtemporary( pages_tab( pages_tab.count( ) - 1 ) , true ); -- settings.x := settings.margin_left; settings.y := settings.page_height - settings.margin_top - nvl( settings.current_fontsizept , 12 ); settings.page_nr := pages_tab.count( ); -- if settings.current_font is not null then add2page( 'BT /F' || settings.current_font || ' ' || to_char_round( settings.current_fontsizept ) || ' Tf ET' ); end if; end; -- function parse_png( p_img_blob in blob ) return tp_img is t_img tp_img; buf raw( 32767 ); len integer; ind integer; color_type pls_integer; begin if rawtohex( dbms_lob.substr( p_img_blob , 8 , 1 ) ) != '89504E470D0A1A0A' then -- not the right signature return null; end if; dbms_lob.createtemporary( t_img.pixels , true ); ind := 9; loop len := raw2num( dbms_lob.substr( p_img_blob , 4 , ind ) ); -- length exit when len is null or ind > dbms_lob.getlength( p_img_blob ); case utl_raw.cast_to_varchar2 ( dbms_lob.substr( p_img_blob , 4 , ind + 4 ) ) -- Chunk type when 'IHDR' then t_img.width := raw2num( dbms_lob.substr( p_img_blob , 4 , ind + 8 ) ); t_img.height := raw2num( dbms_lob.substr( p_img_blob , 4 , ind + 12 ) ); t_img.color_res := raw2num( dbms_lob.substr( p_img_blob , 1 , ind + 16 ) ); color_type := raw2num( dbms_lob.substr( p_img_blob , 1 , ind + 17 ) ); t_img.greyscale := color_type in( 0, 4 ); when 'PLTE' then t_img.color_tab := dbms_lob.substr( p_img_blob , len , ind + 8 ); when 'IDAT' then dbms_lob.append( t_img.pixels , dbms_lob.substr( p_img_blob , len , ind + 8 ) ); when 'IEND' then exit; else null; end case; ind := ind + 4 + 4 + len + 4; -- Length + Chunk type + Chunk data + CRC end loop; -- t_img.type := 'png'; t_img.nr_colors := case color_type when 0 then 1 when 2 then 3 when 3 then 1 when 4 then 2 else 4 end; -- return t_img; end; -- function parse_jpg( p_img_blob in blob ) return tp_img is buf raw( 4 ); t_img tp_img; t_ind integer; begin if ( dbms_lob.substr( p_img_blob , 2 , 1 ) != hextoraw( 'FFD8' ) -- SOI Start of Image or dbms_lob.substr( p_img_blob , 2 , dbms_lob.getlength( p_img_blob ) - 1 ) != hextoraw( 'FFD9' ) -- EOI End of Image ) then -- this is not a jpg I can handle return null; end if; -- t_img.pixels := p_img_blob; t_img.type := 'jpg'; if dbms_lob.substr( t_img.pixels , 2 , 3 ) in ( hextoraw( 'FFE0' ) -- a APP0 jpg , hextoraw( 'FFE1' ) -- a APP1 jpg ) then t_img.color_res := 8; t_img.height := 1; t_img.width := 1; -- t_ind := 3; t_ind := t_ind + 2 + raw2num( dbms_lob.substr( t_img.pixels , 2 , t_ind + 2 ) ); loop buf := dbms_lob.substr( t_img.pixels , 2 , t_ind ); exit when buf = hextoraw( 'FFDA' ); -- SOS Start of Scan exit when buf = hextoraw( 'FFD9' ); -- EOI End Of Image exit when substr( rawtohex( buf ) , 1 , 2 ) != 'FF'; if rawtohex( buf ) in ( 'FFD0' -- RSTn , 'FFD1', 'FFD2', 'FFD3', 'FFD4', 'FFD5', 'FFD6', 'FFD7' , 'FF01' -- TEM ) then t_ind := t_ind + 2; else if buf = hextoraw( 'FFC0' ) -- SOF0 (Start Of Frame 0) marker then t_img.color_res := raw2num( dbms_lob.substr( t_img.pixels , 1 , t_ind + 4 ) ); t_img.height := raw2num( dbms_lob.substr( t_img.pixels , 2 , t_ind + 5 ) ); t_img.width := raw2num( dbms_lob.substr( t_img.pixels , 2 , t_ind + 7 ) ); end if; t_ind := t_ind + 2 + raw2num( dbms_lob.substr( t_img.pixels , 2 , t_ind + 2 ) ); end if; end loop; end if; -- return t_img; end; -- function parse_img( p_blob in blob , p_type in varchar2 := null , p_adler32 in varchar2 := null ) return tp_img is img tp_img; t_type varchar2( 5 ) := p_type; begin if t_type is null then if rawtohex( dbms_lob.substr( p_blob , 8 , 1 ) ) = '89504E470D0A1A0A' then t_type := 'png'; else t_type := 'jpg'; end if; end if; -- img := case lower( t_type ) when 'png' then parse_png( p_blob ) when 'jpg' then parse_jpg( p_blob ) end; -- if img.width is not null then img.adler32 := nvl( p_adler32 , adler32( p_blob ) ); end if; -- return img; end; -- procedure init is begin t_ncharset := nls_charset_name( nls_charset_id( 'NCHAR_CS' ) ); t_lan_ter := substr( sys_context( 'userenv' , 'LANGUAGE' ) , 1 , instr( sys_context( 'userenv' , 'LANGUAGE' ) , '.' ) ); dbms_lob.createtemporary( pdf_doc , true ); settings := null; objects_tab.delete; pages_tab.delete; fonts.delete; used_fonts.delete; images.delete; objects_tab( 0 ) := 0; init_core_fonts; set_format; set_margins; new_page; set_font( 'helvetica' ); end; -- function get_pdf return blob is begin finish_pdf; return pdf_doc; end; -- procedure save_pdf( p_dir in varchar2 := 'MY_DIR' , p_filename in varchar2 := 'my.pdf' ) is t_fh utl_file.file_type; t_len pls_integer := 32767; begin t_fh := utl_file.fopen( p_dir , p_filename , 'wb' ); finish_pdf; for i in 0 .. trunc( ( dbms_lob.getlength( pdf_doc ) - 1 ) / t_len ) loop utl_file.put_raw( t_fh , dbms_lob.substr( pdf_doc , t_len , i * t_len + 1 ) ); end loop; utl_file.fclose( t_fh ); dbms_lob.freetemporary( pdf_doc ); end; -- procedure show_pdf is begin finish_pdf; owa_util.mime_header( 'application/pdf' , false ); htp.print( 'Content-Length: ' || dbms_lob.getlength( pdf_doc ) ); htp.print( 'Content-disposition: inline' ); htp.print( 'Content-Description: Generated by as_xslfo2pdf' ); owa_util.http_header_close; wpg_docload.download_file( pdf_doc ); dbms_lob.freetemporary( pdf_doc ); end; -- function conv2user_units( p_value in number , p_unit in varchar2 ) return number is begin return case lower( p_unit ) when 'mm' then p_value * 72 / 25.4 when 'cm' then p_value * 72 / 2.54 when 'pt' then p_value -- also point when 'point' then p_value when 'inch' then p_value * 72 when 'in' then p_value * 72 -- also inch when 'pica' then p_value * 12 when 'p' then p_value * 12 -- also pica when 'pc' then p_value * 12 -- also pica when 'em' then p_value * 12 -- also pica when 'px' then p_value -- pixel voorlopig op point zetten when 'px' then p_value * 0.8 -- pixel else null end; end; -- procedure set_format( p_format in varchar2 := 'A4' , p_orientation in varchar2 := 'PORTRAIT' ) is t_tmp number; begin case upper( p_format ) when 'A3' then settings.page_height := conv2user_units( 420 , 'mm' ); settings.page_width := conv2user_units( 297 , 'mm' ); when 'A4' then settings.page_height := conv2user_units( 297 , 'mm' ); settings.page_width := conv2user_units( 210 , 'mm' ); when 'A5' then settings.page_height := conv2user_units( 210 , 'mm' ); settings.page_width := conv2user_units( 148 , 'mm' ); when 'A6' then settings.page_height := conv2user_units( 148 , 'mm' ); settings.page_width := conv2user_units( 105 , 'mm' ); when 'LEGAL' then settings.page_height := conv2user_units( 356 , 'mm' ); settings.page_width := conv2user_units( 216 , 'mm' ); when 'LETTER' then settings.page_height := conv2user_units( 279 , 'mm' ); settings.page_width := conv2user_units( 216 , 'mm' ); else null; end case; -- case when upper( p_orientation ) in( 'L', 'LANDSCAPE' ) then if settings.page_height > settings.page_width then t_tmp := settings.page_height; settings.page_height := settings.page_width; settings.page_width := t_tmp; end if; when upper( p_orientation ) in( 'P', 'PORTRAIT' ) then if settings.page_height < settings.page_width then t_tmp := settings.page_height; settings.page_height := settings.page_width; settings.page_width := t_tmp; end if; else null; end case; end; -- procedure set_pagesize( p_width in number , p_height in number , p_unit in varchar2 := 'cm' ) is begin settings.page_width := conv2user_units( p_width , p_unit ); settings.page_height := conv2user_units( p_height , p_unit ); end; -- procedure set_margins( p_top in number := 3 , p_left in number := 1 , p_bottom in number := 4 , p_right in number := 1 , p_unit in varchar2 := 'cm' ) is begin settings.margin_left := conv2user_units( p_left , p_unit ); settings.margin_right := conv2user_units( p_right , p_unit ); settings.margin_top := conv2user_units( p_top , p_unit ); settings.margin_bottom := conv2user_units( p_bottom , p_unit ); end; -- procedure set_font( p_family in varchar2 , p_style in varchar2 := 'N' , p_fontsizept in pls_integer := null , p_encoding in varchar2 := 'WINDOWS-1252' ) is t_style varchar2( 100 ); t_family varchar2( 100 ); begin if ( p_family is null and p_style is null and p_fontsizept is null ) then return; end if; t_style := replace( replace( replace( replace( replace( upper( p_style ) , 'NORMAL' , 'N' ) , 'REGULAR' , 'N' ) , 'BOLD' , 'B' ) , 'ITALIC' , 'I' ) , 'OBLIQUE' , 'I' ); t_style := nvl( t_style , case when settings.current_font is null then 'N' else fonts( settings.current_font ).style end ); t_family := nvl( lower( p_family ) , case when settings.current_font is null then 'helvetica' else fonts( settings.current_font ).family end ); for i in fonts.first .. fonts.last loop if ( fonts( i ).family = t_family and fonts( i ).style = t_style and lower( fonts( i ).encoding ) = lower( p_encoding ) ) then settings.current_font := i; settings.current_fontsizept := coalesce( p_fontsizept , settings.current_fontsizept , 12 ); settings.encoding := nvl( utl_i18n.map_charset( p_encoding , utl_i18n.generic_context , utl_i18n.iana_to_oracle ) , settings.encoding ); used_fonts( i ) := 0; if pages_tab.count( ) > 0 then add2page( 'BT /F' || i || ' ' || to_char_round( settings.current_fontsizept ) || ' Tf ET' ); end if; exit; end if; end loop; end; -- function nclob2blob( p_txt in nclob ) return blob is begin if p_txt is null or p_txt = '' then return null; end if; return utl_raw.convert( utl_raw.cast_to_raw( p_txt ) , t_lan_ter || settings.encoding , t_lan_ter || t_ncharset ); end; -- procedure add2page( p_txt in blob ) is begin dbms_lob.append( pages_tab( pages_tab.count( ) - 1 ) , p_txt ); dbms_lob.append( pages_tab( pages_tab.count( ) - 1 ) , hextoraw( '0D0A' ) ); end; -- procedure add2page( p_txt in nclob ) is begin add2page( nclob2blob( p_txt ) ); end; -- procedure put_txt( p_x in number , p_y in number , p_txt in blob ) is begin add2page( utl_raw.concat( utl_raw.cast_to_raw( 'BT ' ) , utl_raw.cast_to_raw( to_char_round( p_x ) || ' ' || to_char_round( p_y ) ) , utl_raw.cast_to_raw( ' Td (' ) , pdf_string( p_txt ) , utl_raw.cast_to_raw( ') Tj ET' ) ) ); end; -- procedure put_txt( p_x in number , p_y in number , p_txt in nclob ) is begin if p_txt is not null then put_txt( p_x , p_y , nclob2blob( p_txt ) ); end if; end; -- function string_width( p_txt in nclob ) return number is t_tmp blob; t_width number; t_char pls_integer; begin if p_txt is null then return 0; end if; -- t_width := 0; t_tmp := nclob2blob( p_txt ); for i in 1 .. dbms_lob.getlength( t_tmp ) loop t_char := utl_raw.cast_to_binary_integer( dbms_lob.substr( t_tmp , 1 , i ) ); t_width := t_width + fonts( settings.current_font ).char_width_tab( t_char ) * ( settings.current_fontsizept / 1000 ); end loop; return t_width; end; -- procedure write( p_txt in nclob , p_x in number := null , p_y in number := null , p_line_height in number := null , p_start in number := null -- left side of the available text box , p_width in number := null -- width of the available text box , p_alignment in varchar2 := null ) is t_x number := nvl( p_x , settings.x ); t_y number := nvl( p_y , settings.y ); t_line_height number := nvl( p_line_height , settings.current_fontsizept ); t_start number := nvl( p_start , settings.margin_right ); t_width number := nvl( p_width , settings.page_width - settings.margin_right - settings.margin_left ); t_len number; t_cnt pls_integer; t_ind pls_integer; begin if p_txt is null then return; end if; -- t_ind := instrc( p_txt , chr( 10 ) ); if t_ind > 0 then write( rtrim( substrc( p_txt , 1 , t_ind - 1 ) , chr( 13 ) ) , t_x , t_y , t_line_height , t_start , t_width , p_alignment ); write( substrc( p_txt , t_ind + 1 ) , t_start , t_y - t_line_height , t_line_height , t_start , t_width , p_alignment ); return; end if; t_x := case when t_x < 0 then t_start else t_x end; t_y := case when t_y < 0 then settings.y - t_line_height else t_y end; t_len := string_width( p_txt ); if t_len > t_width - t_x + t_start then t_cnt := 0; while( instrc( p_txt , ' ' , 1 , t_cnt + 1 ) > 0 and string_width( substrc( p_txt , 1 , instrc( p_txt , ' ' , 1 , t_cnt + 1 ) - 1 ) ) <= t_width - t_x + t_start ) loop t_cnt := t_cnt + 1; end loop; if t_cnt > 0 then write( substrc( p_txt , 1 , instrc( p_txt , ' ' , 1 , t_cnt ) - 1 ) , t_x , t_y , t_line_height , t_start , t_width , p_alignment ); write( substrc( p_txt , instrc( p_txt , ' ' , 1 , t_cnt ) + 1 ) , null , null , t_line_height , t_start , t_width , p_alignment ); else if t_x > t_start then write( p_txt , t_start , t_y - t_line_height , t_line_height , t_start , t_width , p_alignment ); else t_ind := trunc( length( p_txt ) / 2 ); write( substrc( p_txt , 1 , t_ind ) , t_x , t_y , t_line_height , t_start , t_width , p_alignment ); write( substrc( p_txt , t_ind + 1 ) , null , null , t_line_height , t_start , t_width , p_alignment ); end if; end if; else if instr( p_alignment , 'right' ) > 0 or instr( p_alignment , 'end' ) > 0 then t_x := t_start + t_width - t_len; elsif instr( p_alignment , 'center' ) > 0 then t_x := ( t_width + t_x + t_start - string_width( p_txt ) ) / 2; end if; put_txt( t_x , t_y , p_txt ); settings.x := t_x + t_len + string_width( ' ' ); settings.y := t_y; end if; end; -- function rgb( p_hex_rgb in varchar2 ) return varchar2 is begin return to_char_round ( nvl( to_number( substr( ltrim( p_hex_rgb , '#' ) , 1 , 2 ) , 'xx' ) / 255 , 0 ) , 5 ) || ' ' || to_char_round ( nvl( to_number( substr( ltrim( p_hex_rgb , '#' ) , 3 , 2 ) , 'xx' ) / 255 , 0 ) , 5 ) || ' ' || to_char_round ( nvl( to_number( substr( ltrim( p_hex_rgb , '#' ) , 5 , 2 ) , 'xx' ) / 255 , 0 ) , 5 ) || ' '; end; -- procedure set_color( p_rgb in varchar2 := '000000' , p_backgr in boolean ) is begin add2page( rgb( p_rgb ) || case when p_backgr then 'RG' else 'rg' end ); end; -- procedure set_color( p_rgb in varchar2 := '000000' ) is begin set_color( p_rgb , false ); end; -- procedure set_color( p_red in number := 0 , p_green in number := 0 , p_blue in number := 0 ) is begin if ( p_red between 0 and 255 and p_blue between 0 and 255 and p_green between 0 and 255 ) then set_color( to_char( p_red , 'fm0x' ) || to_char( p_green , 'fm0x' ) || to_char( p_blue , 'fm0x' ) , false ); end if; end; -- procedure set_bk_color( p_rgb in varchar2 := 'ffffff' ) is begin set_color( p_rgb , true ); end; -- procedure set_bk_color( p_red in number := 255 , p_green in number := 255 , p_blue in number := 255 ) is begin if ( p_red between 0 and 255 and p_blue between 0 and 255 and p_green between 0 and 255 ) then set_color( to_char( p_red , 'fm0x' ) || to_char( p_green , 'fm0x' ) || to_char( p_blue , 'fm0x' ) , true ); end if; end; -- procedure horizontal_line( p_x in number , p_y in number , p_width in number , p_line_width in number := 0.5 , p_line_color in varchar2 := '000000' ) is t_use_color boolean; begin add2page( 'q ' || to_char_round( p_line_width, 5 ) || ' w' ); t_use_color := substr( p_line_color , -6 ) != '000000'; if t_use_color then set_color( p_line_color ); set_bk_color( p_line_color ); else add2page( '0 g' ); end if; add2page( to_char_round( p_x, 5 ) || ' ' || to_char_round( p_y, 5 ) || ' m ' || to_char_round( p_x + p_width, 5 ) || ' ' || to_char_round( p_y, 5 ) || ' l b' ); add2page( 'Q' ); end; -- procedure vertical_line( p_x in number , p_y in number , p_height in number , p_line_width in number := 0.5 , p_line_color in varchar2 := '000000' ) is begin horizontal_line( p_x , p_y , p_line_width , p_height , p_line_color ); end; -- procedure rect( p_x in number , p_y in number , p_width in number , p_height in number , p_line_color in varchar2 := null , p_fill_color in varchar2 := null , p_line_width in number := 0.5 ) is begin add2page( 'q' ); if substr( p_line_color , -6 ) != substr( p_fill_color , -6 ) then add2page( to_char_round( p_line_width , 5 ) || ' w' ); end if; if substr( p_line_color , -6 ) != '000000' then set_bk_color( p_line_color ); else add2page( '0 g' ); end if; if p_fill_color is not null then set_color( p_fill_color ); end if; add2page( to_char_round( p_x , 5 ) || ' ' || to_char_round( p_y , 5 ) || ' ' || to_char_round( p_width , 5 ) || ' ' || to_char_round( p_height , 5 ) || ' re ' || case when p_fill_color is null then 'S' else 'b' end ); add2page( 'Q' ); end; -- procedure put_image( p_dir in varchar2 , p_file_name in varchar2 , p_x in number , p_y in number , p_width in number := null , p_height in number := null ) is t_blob blob; begin t_blob := file2blob( p_dir , p_file_name ); put_image( t_blob , p_x , p_y , p_width , p_height ); dbms_lob.freetemporary( t_blob ); end; -- procedure put_image( p_url in varchar2 , p_x in number , p_y in number , p_width in number := null , p_height in number := null ) is t_blob blob; begin t_blob := httpuritype( p_url ).getblob( ); put_image( t_blob , p_x , p_y , p_width , p_height ); dbms_lob.freetemporary( t_blob ); end; -- procedure put_image( p_img in blob , p_x in number , p_y in number , p_width in number := null , p_height in number := null ) is t_ind pls_integer; t_adler32 varchar2( 8 ); begin if p_img is null then return; end if; t_adler32 := adler32( p_img ); t_ind := images.first; while t_ind is not null loop exit when images( t_ind ).adler32 = t_adler32; t_ind := images.next( t_ind ); end loop; -- if t_ind is null then t_ind := images.count( ) + 1; images( t_ind ) := parse_img( p_img , p_adler32 => t_adler32 ); end if; -- if images( t_ind ).adler32 is null then images.delete( t_ind ); else add2page( 'q ' || to_char_round( nvl( p_width , images( t_ind ).width ) ) || ' 0 0 ' || to_char_round( nvl( p_height , images( t_ind ).height ) ) || ' ' || to_char_round( case when p_x > 0 then p_x else -p_x - images( t_ind ).width / 2 end ) || ' ' || to_char_round( case when p_y > 0 then p_y else -p_y + images( t_ind ).height / 2 end ) || ' ' || ' cm /I' || to_char( t_ind ) || ' Do Q' ); end if; end; -- end; /