criar rtf harbour

Avatar do usuário
jairpinho
Mensagens: 116
Registrado em: 05 Nov 2008, 22:55
Localização: Rio Grande do Sul - Brasil
Contato:

criar rtf harbour

Mensagem por jairpinho » 20 Mar 2017, 14:21

segue o código que montei com informações da internet

Código: Selecionar todos

#include "MiniGui.ch"

Procedure CRIA_RTF()

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

//---------------------------------------------------------- 
// 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 
//---------------------------------------------------------- 

*****************************************************************************************************************
PROCEDURE IMPRIME(nTipo)
*****************************************************************************************************************
DECLARE WINDOW Busca_OS
#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 

#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 

	Local cPesq_Item	:= "" 
	Local oWord
	Local nLinha := 6						&& primeira linha a ser preencher com o while ou for
	Local nReg   := 6						&& inicio e acumulador do while
	Local i :=  0
	Local cLetra := ""
	Local xBase     :=BaseDeDados("DIR16")
	Local xlPortrait := 1
	Local xlLandscape := 2
	Local xlPaperA4 := 9
	Local xlPaperA4Small := 10
    Local xlPaperLetter := 1
    Local xlAutomatic := -4105
    Local xlDownThenOver := 1
    Local nQuantItems := 0
	Local nTotal	:= 0
    Local ArqOrc :=DiskName()+":\"+CurDir()+"\OS\" //LOCAL DOS PedidosS
	Private nFont := 11


If nTipo == 1
	cCodigo			:= Form_OS.Text_1.value
	cData_entrada 	:= DTOC(Form_OS.DatePicker_1.value)
	cCliente      	:= Form_OS.Text_2.value
	cFone_contato 	:= Form_OS.Text_3.value
	cAparelho		:= Form_OS.Combo_1.DisplayValue
	cSerial 		    := Form_OS.Text_4.value
	cDefeito 		:= Alltrim(Form_OS.Edit_1.value)
	cData_Retirada	:= DTOC(Form_OS.DatePicker_2.value)
	cDocumento 	:= Form_OS.Text_9.value
	cEndereco 		:= Form_OS.Text_6.value
	cCidade 		:= Form_OS.Text_8.value
	cBairro 		    := Form_OS.Text_7.value
	
	

Elseif nTipo == 2

	cCodigo			:= Busca_OS.Text_1.value
	cData_entrada 	:= DTOC(Busca_OS.DatePicker_1.value)
	cCliente      	:= Busca_OS.Text_2.value
	cFone_contato 	:= Busca_OS.Text_3.value
	cCliente      	:= Busca_OS.Text_2.value
	cDocumento 	:= Busca_OS.Text_13.value
	cEndereco 		:= Busca_OS.Text_10.value
	cCidade 		:= Busca_OS.Text_12.value
	cBairro 		    := Busca_OS.Text_11.value
	cAparelho		:= Busca_OS.Combo_1.DisplayValue
	cSerial 		    := Busca_OS.Text_4.value
	cDefeito 		:= Alltrim(Busca_OS.Edit_1.value)
	cData_Retirada	:= DTOC(Busca_OS.DatePicker_2.value)

EndIF
	
//cabecalhos e rodape
// deixar um espaco antes do texto e todas linhas para cenralizar cabecalhos

nRTF := rtfOpen( ArqOrc + "Relatorio.RTF","","") //, ;

/* tipos de fontes
[ {\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)+;
[ {\f7\fnil Times New Roman;}]+Chr(13)+Chr(10)+; 
*/ 

//rtfWriteLn( nHandle, nFontNumber, nFontSyze, nFontColor, cStyle, cString )
//preencher documento

//rtfWriteLn( nHandle, nFontNumber, nFontSyze, nFontColor, cStyle, cString )
//preencher documento

rtfWriteLn( nRTF,7,12,0,RTF_QC+BOLD_ON , "GORDO CONSERTO DE CELULARES" )
rtfWriteLn( nRTF,7,10,0,RTF_QC, "ASSISTENCIA TÉCNICA ESPECIALIZADA TODAS AS MARCAS" )
rtfWriteLn( nRTF,7,10,0,RTF_QC," Rua Anápio Gomes, 1668 loja 14 - Galeria Santa Catarina")
rtfWriteLn( nRTF,7,10,0,RTF_QC,"(Em frente a Praça do Quiosque) Gravataí- RS")
rtfWriteLn( nRTF,7,10,0,RTF_QC," Tel: (51) 30437971 / 9201-4567 / 84049089 / 99321881 / 81628999")

rtfWrite( nRTF,1,10,0,RTF_PAR+RTF_QL+BOLD_ON , +replic(" ",50))

rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Data Entrada    : " + cData_entrada )
rtfWriteLn( nRTF,7,12,0,RTF_QL+BOLD_ON , "Ordem de Serviço  N: "  +ALLTRIM(cCodigo) )
rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Cliente  : " + cCliente + "     Documento RG/CNH : " + cDocumento )
rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Fone para contato : " + cFone_contato )
rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Endereço : " + cEndereco)   
rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Bairro : "  + cBairro + "     Cidade : " + cCidade )  
rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Aparelho para conserto  : "+AllTrim(cAparelho)  )
rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Serial do aparelho : " + AllTrim(cSerial ) )
rtfWriteLn( nRTF,7,12,0,RTF_QL+BOLD_ON ,"Defeito alegado pelo cliente: " )
rtfWriteLn( nRTF,7,10,0,RTF_QL , AllTrim( cDefeito ) )
rtfWriteLn( nRTF,7,12,0,RTF_QL+BOLD_ON ,"Serviço executado ")
// rtfWriteLn( nRTF,1,10,0,RTF_QL , AllTrim( cDefeito ) )

rtfWriteLn( nRTF,7,10,0,RTF_QL+BOLD_ON , replic(" ",50) )
rtfWriteLn( nRTF,7,10,0,RTF_QL+BOLD_ON , replic("_",80) )
rtfWriteLn( nRTF,7,10,0,RTF_QL+BOLD_ON , replic(" ",50) )
rtfWriteLn( nRTF,7,10,0,RTF_QL+BOLD_ON , replic("_",80) )

rtfWriteLn( nRTF,7,10,0,RTF_QC+BOLD_ON , replic(" ",50) )


rtfWriteLn( nRTF,7,12,0,RTF_QL,"Total de serviços e peças R$ "+replic("_",15)  +  "    Data de entrega do aparelho : ____/____/____")

rtfWriteLn( nRTF,7,10,0,RTF_QC+BOLD_ON , replic(" ",50) )

rtfWriteLn( nRTF,7,12,0,RTF_QL,"Assinatura do cliente: "+replic("_",45))

rtfWriteLn( nRTF,7,10,0,RTF_QC+BOLD_ON , replic(" ",50) )


rtfWriteLn( nRTF,7,07,0,RTF_QL ,"DECLARO TER RECEBIDO O APARELHO ACIMA DESCRITO EM PERFEITO ESTADO DE FUNCIONAMENTO, E ESTOU CIENTE")
rtfWriteLn( nRTF,7,07,0,RTF_QL ,"DA PERDA DA GARANTIA NO CASO DE APARELHO QUE ESTEJA AINDA NA GARANTIA DO FABRICANTE" )

rtfWriteLn( nRTF,7,10,0,RTF_QC+BOLD_ON , replic(" ",50) )

rtfWriteLn( nRTF,7,10,0,RTF_QL+BOLD_ON ,"PREVISÃO DE ORÇAMENTO : " + cData_Retirada )


rtfWriteLn( nRTF,7,12,0,RTF_QC+BOLD_ON , replic(" ",50) )
rtfWriteLn( nRTF,7,12,0,RTF_QC+BOLD_ON , replic(" ",50) )
rtfWriteLn( nRTF,7,12,0,RTF_QC+BOLD_ON , replic(" ",50) )
rtfWriteLn( nRTF,7,12,0,RTF_QC+BOLD_ON , replic(" ",50) )
rtfWriteLn( nRTF,7,12,0,RTF_QC+BOLD_ON , replic(" ",50) )
rtfWriteLn( nRTF,7,12,0,RTF_QC+BOLD_ON , replic(" ",50) )






rtfWriteLn( nRTF,7,12,0,RTF_PAR+RTF_QC+BOLD_ON , "GORDO CONSERTO DE CELULARES" )
rtfWriteLn( nRTF,7,10,0,RTF_QC, "ASSISTENCIA TÉCNICA ESPECIALIZADA TODAS AS MARCAS" )
rtfWriteLn( nRTF,7,10,0,RTF_QC," Rua Anápio Gomes, 1668 loja 14 - Galeria Santa Catarina")
rtfWriteLn( nRTF,7,10,0,RTF_QC,"(Em frente a Praça do Quiosque) Gravataí- RS")
rtfWriteLn( nRTF,7,10,0,RTF_QC," Tel: (51) 30437971 / 9201-4567 / 84049089 / 99321881 / 81628999")

rtfWrite( nRTF,1,10,0,RTF_PAR+RTF_QL+BOLD_ON , +replic(" ",50))

rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Data Entrada    : " + cData_entrada )
rtfWriteLn( nRTF,7,12,0,RTF_QL+BOLD_ON , "Ordem de Serviço  N: "  +ALLTRIM(cCodigo) )
rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Cliente  : " + cCliente + "     Documento RG/CNH : " + cDocumento )
rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Fone para contato : " + cFone_contato )
rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Endereço : " + cEndereco )   
rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Bairro : "  + cBairro + "     Cidade : " + cCidade )  
rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Aparelho para conserto  : "+AllTrim(cAparelho)  )
rtfWriteLn( nRTF,7,10,0,RTF_QL ,"Serial do aparelho : " + AllTrim(cSerial ) )
rtfWriteLn( nRTF,7,12,0,RTF_QL+BOLD_ON ,"Defeito alegado pelo cliente: ")
rtfWriteLn( nRTF,7,10,0,RTF_QL , AllTrim( cDefeito ) )
rtfWriteLn( nRTF,7,12,0,RTF_QL+BOLD_ON ,"Serviço executado ")
// rtfWriteLn( nRTF,1,10,0,RTF_QL , AllTrim( cDefeito ) )


rtfWriteLn( nRTF,7,10,0,RTF_QL+BOLD_ON , replic("_",80) )
rtfWriteLn( nRTF,7,10,0,RTF_QL+BOLD_ON , replic(" ",50) )
rtfWriteLn( nRTF,7,10,0,RTF_QL+BOLD_ON , replic("_",80) )

rtfWriteLn( nRTF,7,10,0,RTF_QC+BOLD_ON , replic(" ",50) )


rtfWriteLn( nRTF,7,12,0,RTF_QL,"Total de serviços e peças R$ "+replic("_",15)  +  "    Data de entrega do aparelho : ____/____/____")

rtfWriteLn( nRTF,7,10,0,RTF_QC+BOLD_ON , replic(" ",50) )


rtfWriteLn( nRTF,7,10,0,RTF_QC+BOLD_ON , replic(" ",45) )


rtfWriteLn( nRTF,7,12,0,RTF_QL,"Assinatura do cliente: "+replic("_",45))

rtfWriteLn( nRTF,7,10,0,RTF_QC+BOLD_ON , replic(" ",50) )


rtfWriteLn( nRTF,7,07,0,RTF_QL ,"DECLARO TER RECEBIDO O APARELHO ACIMA DESCRITO EM PERFEITO ESTADO DE FUNCIONAMENTO, E ESTOU CIENTE")
rtfWriteLn( nRTF,7,07,0,RTF_QL ,"DA PERDA DA GARANTIA NO CASO DE APARELHO QUE ESTEJA AINDA NA GARANTIA DO FABRICANTE" )

rtfWriteLn( nRTF,7,10,0,RTF_QC+BOLD_ON , replic(" ",50) )

rtfWriteLn( nRTF,7,10,0,RTF_QL+BOLD_ON ,"PREVISÃO DE ORÇAMENTO : "+ cData_Retirada )


/*
rtfEject( nRTF ) 
rtfWriteLn( nRTF,0,10,1,"" , "Dados em colunas") 
rtfCols( nRTF, 2 ) 
rtfWriteLn( nRTF,,,,"" , "") 
rtfWriteLn( nRTF,,,,RTF_QJ , "Para possibilitar o trabalho com os vários módulos do sistema o FatAll é dividido em menus e submenus que levam oo usuário aos módulos internos e possibilitam a interação com as rotinas. Os principais módulos do FatAll estão distribuídos em:") 
rtfWriteLn( nRTF,,,,"" , " ") 
rtfWriteLn( nRTF,,,,RTF_QJ+BOLD_ON,"Administrativo") 
rtfWriteLn( nRTF,,,,"" , "") 
rtfEject( nRTF ) 
*/

rtfClose( nRTF ) 

If MsgYesNo('Abrir OS',"Sistema")
        //ShellExecute (GetActiveWindow(),'Open','WINWORD', ArqOrc + "Relatorio.RTF",nil,1 )
        //seta o aplicativo word para variavel oWord ser aberta
		oWord  := CreateObject( "Word.Application" )
        // Abertura do arquivo do word
        //oDoc:= oWord:Documents:Add()
        //oWord:ActiveDocument:Select()

        oWord :Documents:open(ArqOrc + "Relatorio.RTF")
        oWord :ActiveDocument:PageSetup():PaperSize    = 7       &&& A4
        oWord :ActiveDocument:PageSetup():LeftMargin   = 57      &&& 2 cm
        oWord :ActiveDocument:PageSetup():RightMargin  = 43      &&& 1cm
        oWord :ActiveDocument:PageSetup():TopMargin    = 20      &&& 1cm
        oWord :ActiveDocument:PageSetup():BottomMargin = 10.5      &&& 1cm
        //oTexto := oWord:Selection(ArqOrc + "Relatorio.RTF")
        oWord :visible := .T.
        //oWord:WindowState:=1       // Maximizado
		//oWord:Documents:Open( cDoc )
		//oWord:Visible := .T.
		//oWord:Set( "WindowState", 1 ) 
EndIf

RETURN NIL




Function rtfOpen( cFile, cHeader, cFooter )
local nHandle
local cBof := [{\rtf1\ansi\deff0\deftab720]+Chr(13)+Chr(10)+; 
[ {\fonttbl]+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)+; 
[ {\f7\fnil Times New Roman;}]+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) 
*** Para imprimir Normal [Retrato] *

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" ) 
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




Você não está autorizado a ver ou baixar esse anexo.
Jair Pinho
HMG ALTA REVOLUÇÃO xBASE
HMG xBASE REVOLUTION HIGH
http://www.hmgforum.com.br

Responder

Quem está online

Usuários navegando neste fórum: Nenhum usuário registrado e 1 visitante