* 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
138 lines
4.3 KiB
Plaintext
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
|