harbour-core/harbour/contrib/hbmisc/tests/rtfclass.prg

/*
 * $Id$
 */

/*
 * harbour rtfclass demo
 * notes : - raw enough but it works
           - using hb_f*() - some compilers are not friendly with this :(
           - rtf is assumed to have association
 * initial release : 23 June 1999 Andi Jahja
 * tested under Windows 98 only with RTF associated to Winword
 * works with printable ascii only
 * placed in the public domain
*/

#define CRLF CHR(13) + CHR(10)

PROCEDURE Main()

   LOCAL ortf  := trtf():new( "test.rtf" )
   LOCAL htest := FCreate( "rtf_test.txt" )
   LOCAL ctest := ""

   // create a plain text file
   ctest += "This is +bHarbour (C) RTF Class-b" + CRLF
   ctest += "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG" + CRLF
   ctest += "+bTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-b" + CRLF
   ctest += "+iTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-i" + CRLF
   ctest += "+buTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-bu" + CRLF
   ctest += "+buiTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-bui" + CRLF
   ctest += "THE +bQUICK-b +buBROWN-bu +buiFOX-bui +iJUMPS-i +uOVER-u +ilTHE-il +uLAZY-u +buDOG-bu" + CRLF

   FWrite( htest, ctest )
   FClose( htest )

   // convert text file to rtf
   ortf:write( "rtf_test.txt" )
   ortf:close()

   // execute file association ( windows only )
   #if defined( __PLATFORM__WINDOWS )
      // assuming start.exe is exist
      __Run( "start test.rtf" )
   #endif

   RETURN

FUNCTION trtf()

   STATIC oclass

   IF oclass == nil
      oclass := HBClass():new( "trtf" )
      oclass:adddata( "nhandle" )
      oclass:addmethod( "new",  @new() )
      oclass:addmethod( "write", @write() )
      oclass:addmethod( "close", @close() )
      oclass:create()
   ENDIF

   RETURN oclass:instance()

STATIC FUNCTION new( cfilename )

   LOCAL self := qself()

   ::nhandle   := FCreate( cfilename )
   FWrite( ::nhandle, ;
      "{\rtf1\ansi\deff0{\fonttbl {\f0\fnil\fcharset0 Courier New;}{\f1\fnil\fcharset0 Arial;}}" + ;
      "\uc1\pard\lang1033\ulnone\f0\fs20" + CRLF )

   RETURN self

STATIC FUNCTION write( csource )

   LOCAL self := qself()
   LOCAL cchar, cline, xatt, i
   LOCAL nchar, y

   // These are character attributes, self-defined
   // + means a turn-on
   // - means a turn-off
   LOCAL attrib := { ;
      { "+b"  , "\b "            } /* turn bold on*/ , ;
      { "+bu" , "\ul\b "         } /* turn bold_underline on */, ;
      { "+bi" , "\b\i "          } /* turn bold_italic on */, ;
      { "+bui", "\ul\b\i "       } /* turn bold_underline_italic on */, ;
      { "+i"  , "\i "            } /* turn italic on */, ;
      { "+il" , "\ul\i "         } /* turn italic_underline on */, ;
      { "+u"  , "\ul "           } /* turn underline on */, ;
      { "-b"  , "\b0 "           } /* turn bold off */, ;
      { "-bu" , "\b0\ulnone "    } /* turn bold_underline off */, ;
      { "-bi" , "\b0\i0 "        } /* turn bold_italic off */, ;
      { "-bui", "\b0\i0\ulnone " } /* turn bold_underline_italic off */, ;
      { "-i"  , "\i0 "           } /* turn italic off */, ;
      { "-il" , "\ulnone\i0 "    } /* turn italic_underline off */, ;
      { "-u"  , "\ulnone "       } /* turn underline off */;
   }

   hb_fuse( csource )  // open source file
   WHILE ! hb_FEof()   // read the file line by line
      cline := hb_freadln() + "\par"
      y     := Len( cline )
      for nchar := 1 TO y
         cchar := SubStr( cline, nchar, 1 )

         // todo : i need function dec2hex()
         // to convert ascii to 2-characters hex
         // ie   : dec2hex( "H" ) -> 48
         IF cchar == "+" .OR. cchar == "-"
            xatt := cchar                         + ;
               SubStr( cline, nchar + 1, 1 ) + ;
               SubStr( cline, nchar + 2, 1 ) + ;
               SubStr( cline, nchar + 3, 1 )
            IF ( i := AScan( attrib, {| e | e[ 1 ] == xatt } ) ) > 0
               FWrite( ::nhandle, attrib[ i ][ 2 ] )
               nchar := nchar + Len( xatt ) - 1
            ELSE
               // 3 attributes
               xatt := Left( xatt, 3 )
               IF ( i := AScan( attrib, {| e | e[ 1 ] == xatt } ) ) > 0
                  FWrite( ::nhandle, attrib[ i ][ 2 ] )
                  nchar := nchar + Len( xatt ) - 1
               ELSE
                  // 2 attributes
                  xatt := Left( xatt, 2 )
                  IF ( i := AScan( attrib, {| e | e[ 1 ] == xatt } ) ) > 0
                     FWrite( ::nhandle, attrib[ i ][ 2 ] )
                     nchar := nchar + Len( xatt ) - 1
                  ELSE
                     FWrite( ::nhandle, cchar )
                  ENDIF
               ENDIF
            ENDIF
         ELSE
            FWrite( ::nhandle, cchar )
         ENDIF
      next
      FWrite( ::nhandle, CRLF )
      hb_fskip() // read next line
   ENDDO
   hb_fuse()

   RETURN self

STATIC FUNCTION CLOSE()

   LOCAL self := qself()

   FWrite( ::nhandle, "\f1\fs16\par" + CRLF + "}" )
   FClose( ::nhandle )

   RETURN self