PC Toledo

Código: Selecionar todos

********************************
*
*
* Arquivo...: nfrtf.prg
* Autor.....: Desconhecido
* Adaptacao.: Jose Carlos da Rocha
* E-mail....: softclever@softclever.com
* Site......: http://www.softclever.com/
* Versao....: 1.0, 05/Ago/2003
* Objetivo..: Criar arquivos RTF para serem lidos pelo Word
*
*/

// Label Header
#define CR 					Chr(13)
#define LF 					Chr(10)
#define CRLF 				CR+LF

#define BOLD_ON 			"\b"
#define ITALIC_ON 		"\i"
#define UNDERLINE_ON 	"\ul"
#define CAPS_ON 			"\caps"

#define STYLE_OFF 		"0"
#define BOLD_OFF 			BOLD_ON+STYLE_OFF
#define ITALIC_OFF 		ITALIC_ON+STYLE_OFF
#define UNDERLINE_OFF 	UNDERLINE_ON+STYLE_OFF
#define CAPS_OFF 			CAPS_ON+STYLE_OFF

#define RTF_QC 			"\qc" 		// Centralizado
#define RTF_QJ 			"\qj" 		// Justificado
#define RTF_QL 			"\ql" 		// Esquerda
#define RTF_QR 			"\qr" 		// Direita

#define RTF_PAR 			"\par" 		// Paragrafo normal
#define RTF_PARD 			"\pard" 		// Paragrafo distanciado
#define RTF_PLAIN 		"\plain" 	// Paragrafo plaino

#define RTF_CF 			"\cf" 		// Cor da fonte

#define RTF_BULLET 		"\bullet" 		// Bullet SY
#define RTF_SECT 			"\sect\sectd" 	// Forca pagina
#define RTF_COLS 			"\cols" 			// Colunas na pagina
#define RTF_F 				"\f" 				// Numero da fonte
#define RTF_FS 			"\fs" 			// Tamanho da fonte

#define RTF_DEFAULT 		"\plain\f2\fs10\cf0" // Texto normalizado

RTFTESTE()    // gera teste.rtf

//RUN ( "START /max \WORDVIEW\WORDVIEW.EXE "+"TESTE.RTF" )
//RUN ( "START C:\Arquivos de programas\Windows NT\Acessórios\wordpad.exe "+(wTemp_a))
//RUN ( "START wordpad.exe "+(wTemp_a) )
QUIT
/*
*
*
*
*
*/
function rtfTeste
nRTF := rtfOpen( "TESTE.RTF", ;
RTF_QC+" Sistema de Faturamento Total"+;
RTF_PAR+RTF_QC+" Novembro de 2001", ;
"(r) Direitos Reservados SoftClever Informatica, 1995" )

...................................
...................................
...................................

	rtfEject( nRTF )

	rtfClose( nRTF )

//----------------------------------------------------------
// Proposito :
// Abrir arquivo RTF e escrever cabecalhos
// Parametros:
// cFile - Nome do arquivo
// cHeader - Cabecalho do arquivo
// cFooter - Rodape do arquivo
// Retorna :
// nHandle - Handle do arquivo RTF
//----------------------------------------------------------
function rtfOpen( cFile, cHeader, cFooter )
	local nHandle
	local cBof := [{\rtf1\ansi\deff0\deftab720]+Chr(13)+Chr(10)+;
	[ {\fonttbl]+Chr(13)+Chr(10)+;
	[ {\f0\fnil Times New Roman;}]+Chr(13)+Chr(10)+;
 	[ {\f1\fnil Arial;}]+Chr(13)+Chr(10)+;
	[ {\f2\fnil Courier New;}]+Chr(13)+Chr(10)+;
	[ {\f3\fnil MS Sans Serif;}]+Chr(13)+Chr(10)+;
	[ {\f4\fnil\fcharset2 Symbol;}]+Chr(13)+Chr(10)+;
	[ {\f5\fnil\fprq2 System;}]+Chr(13)+Chr(10)+;
	[ {\f6\fnil Verdana;}]+Chr(13)+Chr(10)+;
	[ }]+Chr(13)+Chr(10)+;
	[ {\colortbl\red0\green0\blue0;\red0\green0\blue254;}]+Chr(13)+Chr(10)+;
	[ {\header \pard\par\f2\fs20]+cHeader+[ \par}]+Chr(13)+Chr(10)+;
	[ {\footer \pard\par\f2\fs10]+cFooter+[ \par}]+Chr(13)+Chr(10)
// [ \margl2520\margr2520\margt1440\margb1440]+Chr(13)+Chr(10)
// [ \deftab720\vertalc\fs24]+Chr(13)+Chr(10)+;
	nHandle := fCreate( cFile )
	fWrite( nHandle, cBof, Len( cBof ))
	return nHandle

//----------------------------------------------------------
// Proposito :
// Fecha arquivo RTF e escreve marcador final
// Parametros:
// Nada
// Retorna :
// nil
//----------------------------------------------------------
function rtfClose( nHandle )
	local cEof := "}"
	fWrite( nHandle, cEof, Len( cEof ))
	fClose( nHandle )
	return nil

//----------------------------------------------------------
// Proposito :
// Escreve uma string ou paragrafo
// Parametros:
// nHandle - Handle do archivo rtf
// nRow - Fila
// nCol - Columna
// cString - String a escribir
// Retorna :
// nil
//----------------------------------------------------------
function rtfWrite( nHandle, nFontNumber, nFontSyze, nFontColor, cStyle, cString )
	cFontNumber := iif(nFontNumber=nil, "\f2" , "\f" +str(nFontNumber,1))
	cFontSyze 	:= iif(nFontSyze=nil , "\fs20", "\fs" +str(nFontSyze*2,2))
	cFontColor 	:= iif(nFontColor=nil , "\cf0" , "\cf" +str(nFontColor,1))
	cString 		:= cStyle+cFontNumber+cFontSyze+cFontColor+cString+"\plain\f2\fs10\cf0"
	fWrite( nHandle, cString )
	return nil

function rtfWriteLn( nHandle, nFontNumber, nFontSyze, nFontColor, cStyle, cString )
	cFontNumber := iif(nFontNumber=nil, "\f2" , "\f" +str(nFontNumber,1))
	cFontSyze 	:= iif(nFontSyze=nil , "\fs20", "\fs" +str(nFontSyze*2,2))
	cFontColor 	:= iif(nFontColor=nil , "\cf0" , "\cf" +str(nFontColor,1))
//	cStyle 		:= iif("JUST"$upper(cStyle), "\qj" , "\qc" )
//	cStyle 		:= iif("JUST"$upper(cStyle), "\ql" , "\ql" )
	cString 		:= " \par\plain"+cStyle+cFontNumber+cFontSyze+cFontColor+cString+"\plain\f2\fs10\cf0"
	fWrite( nHandle, cString+Chr(13)+Chr(10) )
	return nil

function rtfBullet( nHandle )
	fWrite( nHandle, " \bullet" )
	return nil

function rtfEject( nHandle )
	fWrite( nHandle, " \sect\sectd" )
	return nil

function rtfCols( nHandle, nCols )
	fWrite( nHandle, " \cols"+str(nCols,1) )
	return nil

// FIM ...