Files
harbour-core/harbour/contrib/hbmisc/tests/rtfclass.prg
Viktor Szakats 4716fa0b4b 2012-11-07 00:36 UTC+0100 Viktor Szakats (harbour syenar.net)
* contrib/hbct/hbct.hbx
  * contrib/hbfbird/hbfbird.hbx
  * contrib/hbgd/hbgd.hbx
    * minor fixes

  * contrib/hbamf/hbamfobj.prg
  * contrib/hbamf/tests/tstendin.prg
  * contrib/hbblat/blatcls.prg
  * contrib/hbblat/tests/blatcmd.prg
  * contrib/hbbz2/tests/test.prg
  * contrib/hbct/tests/*.prg
  * contrib/hbfbird/tfirebrd.prg
  * contrib/hbfimage/tests/fitest.prg
  * contrib/hbgd/*.prg
  * contrib/hbgd/tests/*.prg
  * contrib/hbmisc/*.prg
  * contrib/hbmisc/tests/*.prg
    * reformatted
    ! commented code deleted or converted to #if 0/#endif block
2012-11-06 23:42:40 +00:00

138 lines
4.3 KiB
Plaintext

/*
* $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
* works with printable ascii only
* placed in the public domain
*/
#require "hbmisc"
#include "hbclass.ch"
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" + hb_eol()
ctest += "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG" + hb_eol()
ctest += "+bTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-b" + hb_eol()
ctest += "+iTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-i" + hb_eol()
ctest += "+buTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-bu" + hb_eol()
ctest += "+buiTHE QUICK BROWN FOX JUMPS OVER THE LAZY DOG-bui" + hb_eol()
ctest += "THE +bQUICK-b +buBROWN-bu +buiFOX-bui +iJUMPS-i +uOVER-u +ilTHE-il +uLAZY-u +buDOG-bu" + hb_eol()
FWrite( htest, ctest )
FClose( htest )
// convert text file to rtf
ortf:write( "rtf_test.txt" )
ortf:close()
RETURN
CREATE CLASS TRtf
VAR nHandle
METHOD new( cfilename )
METHOD write( csource )
METHOD CLOSE()
END CLASS
METHOD new( cfilename ) CLASS TRtf
::nhandle := FCreate( cfilename )
FWrite( ::nhandle, ;
"{\rtf1\ansi\deff0{\fonttbl {\f0\fnil\fcharset0 Courier New;}{\f1\fnil\fcharset0 Arial;}}" + ;
"\uc1\pard\lang1033\ulnone\f0\fs20" + hb_eol() )
RETURN self
METHOD write( csource ) CLASS TRtf
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, hb_eol() )
hb_FSkip() // read next line
ENDDO
hb_FUse()
RETURN self
METHOD CLOSE() CLASS TRtf
FWrite( ::nhandle, "\f1\fs16\par" + hb_eol() + "}" )
FClose( ::nhandle )
RETURN self