Protheus :: Herança de Classe em Advpl ( Derivando fTdb à partir da classe fT )
Aproveitando a deixa do exemplo de classe criado para resolver uma limitação nas funções do tipo FT_F*, vamos criar uma nova classe derivada fTdb que herda as características da classe fT.
A nova classe, fTdb, fará exatamente a mesmo coisa que a classe anterior, com a diferença que a classe fT manipulava um array com as informações do arquivo texto lido e a nova classe, fTdb irá manipular uma tabela. Ela será útil caso número de registros do arquivo texto a ser lido supere o limite do Array.
#INCLUDE "PROTHEUS.CH" #INCLUDE "TRYEXCEPTION.CH" #INCLUDE "FILEIO.CH" #INCLUDE "DBSTRUCT.CH" /*/ CLASS: fTdb Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Alternativa aas funcoes tipo FT_F* devido as limitacoes apontadas em (http://tdn.totvs.com.br/kbm#9734) Sintaxe: ftdb():New() : Objeto do Tipo fT /*/ CLASS fTdb FROM fT DATA cDbFile DATA cDbAlias DATA cRDDName METHOD New() CONSTRUCTOR METHOD ClassName() METHOD ft_fUse( cFile ) METHOD ft_fOpen( cFile ) METHOD ft_fClose() METHOD ft_fAlias() METHOD ft_fExists( cFile ) METHOD ft_fRecno() METHOD ft_fSkip( nSkipper ) METHOD ft_fGoTo( nGoTo ) METHOD ft_fGoTop() METHOD ft_fGoBottom() METHOD ft_fLastRec() METHOD ft_fRecCount() METHOD ft_fEof() METHOD ft_fBof() METHOD ft_fReadLn() METHOD ft_fReadLine() METHOD ft_fError( cError ) METHOD ft_fSetCRLF( cCRLF ) METHOD ft_fSetRddName( cRddName ) METHOD ft_fSetBufferSize( nBufferSize ) END CLASS User Function ftdb() Return( NIL ) /*/ METHOD: New Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: CONSTRUCTOR Sintaxe: ftdb():New() : Object do Tipo fT /*/ METHOD New() CLASS fTdb _Super:New() Self:cDbFile := "" Self:cDbAlias := "" Self:cClassName := "FTDB" Self:ft_fSetRddName() Return( Self ) /*/ METHOD: ClassName Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Retornar o Nome da Classe Sintaxe: ftdb():ClassName() : Retorna o Nome da Classe /*/ METHOD ClassName() CLASS fTdb Return( Self:cClassName ) /*/ METHOD: ft_fUse Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Abrir o Arquivo Passado como Parametro Sintaxe: ftdb():ft_fUse( cFile ) : nfHandle ( nfHandle > 0 True, False) /*/ METHOD ft_fUse( cFile ) CLASS fTdb TRYEXCEPTION IF !( Self:ft_fExists( cFile ) ) BREAK EndIF Self:ft_fOpen( cFile ) CATCHEXCEPTION Self:ft_fClose() ENDEXCEPTION Return( Self:nfHandle ) /*/ METHOD: ft_fOpen Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Abrir o Arquivo Passado como Parametro Sintaxe: ftdb():ft_fOpen( cFile ) : nfHandle ( nfHandle > 0 True, False) /*/ METHOD ft_fOpen( cFile ) CLASS fTdb Local adbStruct := { { "LINE" , "M" , 80 , 0 } } Local lNewArea := .T. Local lShared := .T. Local lReadOnly := .F. Local lHelp := .F. Local lQuit := .F. TRYEXCEPTION IF !( Self:ft_fExists( cFile ) ) BREAK EndIF Self:cFile := cFile Self:nfHandle := fOpen( Self:cFile , FO_READ ) IF ( Self:nfHandle <= 0 ) BREAK EndIF Self:cDbFile := CriaTrab( NIL , .F. ) While MsFile( Self:cDbFile , NIL , Self:cRddName ) Self:cDbFile := CriaTrab( NIL , .F. ) End While Self:cDbFile += IF( ( Self:cRddName == "TOPCONN" ) , "" , GetDbExtension() ) IF !( MsCreate( Self:cDbFile , adbStruct , Self:cRddName ) ) BREAK EndIF Self:cDbAlias := GetNextAlias() IF !( MsOpEndbf( @lNewArea , Self:cRddName , Self:cDbFile , Self:cDbAlias , @lShared , @lReadOnly , @lHelp , @lQuit ) ) BREAK EndIF Self:nFileSize := fSeek( Self:nfHandle , 0 , FS_END ) fSeek( Self:nfHandle , 0 , FS_SET ) Self:nFileSize := ReadFile( Self:cDbAlias , @Self:nfHandle , @Self:nBufferSize , @Self:nFileSize , @Self:cCRLF ) Self:ft_fGoTop() CATCHEXCEPTION Self:ft_fClose() ENDEXCEPTION Return( Self:nfHandle ) /*/ Funcao: ReadFile Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Percorre o Arquivo a ser lido e alimento o Array aLines Sintaxe: ReadFile( cAlias , nfHandle , nBufferSize , nFileSize , cCRLF ) : nLines Read /*/ Static Function ReadFile( cAlias , nfHandle , nBufferSize , nFileSize , cCRLF ) Local cLine := "" Local cBuffer := "" Local nLines := 0 Local nAtPlus := ( Len( cCRLF ) -1 ) Local nBytesRead := 0 While ( nBytesRead <= nFileSize ) cBuffer += fReadStr( @nfHandle , @nBufferSize ) nBytesRead += nBufferSize While ( cCRLF $ cBuffer ) ++nLines cLine := SubStr( cBuffer , 1 , ( AT( cCRLF , cBuffer ) + nAtPlus ) ) cBuffer := SubStr( cBuffer , Len( cLine ) + 1 ) cLine := StrTran( cLine , cCRLF , "" ) ( cAlias )->( dbAppend( .T. ) ) ( cAlias )->( FieldPut( 1 , cLine ) ) cLine := "" End While End While IF !Empty( cBuffer ) ++nLines ( cAlias )->( dbAppend( .T. ) ) ( cAlias )->( FieldPut( 1 , cBuffer ) ) cBuffer := "" EndIF Return( nLines ) /*/ METHOD: ft_fClose Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Fechar o Arquivo aberto pela ft_fOpen ou ft_fUse Sintaxe: ftdb():ft_fClose() : NIL /*/ METHOD ft_fClose() CLASS fTdb Local cMemoFile _Super:ft_fClose() IF ( Select( Self:cDbAlias ) > 0 ) ( Self:cDbAlias )->( dbCloseArea() ) EndIF IF MsFile( Self:cDbFile , NIL , Self:cRddName ) MsErase( Self:cDbFile , NIL , Self:cRddName ) EndIF cMemoFile := ( FileNoExt( Self:cDbFile ) + ".fpt" ) IF File( cMemoFile ) fErase( cMemoFile ) EndIF Self:cDbFile := "" Self:cDbAlias := "" Return( NIL ) /*/ METHOD: ft_fAlias Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Retornar o Nome do Arquivo Atualmente Aberto Sintaxe: ftdb():ft_fAlias() : cFile /*/ METHOD ft_fAlias() CLASS fTdb Return( Self:cDbAlias ) /*/ METHOD: ft_fExists Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Verifica se o Arquivo Existe Sintaxe: ftdb():ft_fExists( cFile ) : lExists /*/ METHOD ft_fExists( cFile ) CLASS fTdb Return( _Super:ft_fExists( cFile ) ) /*/ METHOD: ft_fRecno Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Retorna o Recno Atual Sintaxe: ftdb():ft_fRecno() : nRecno /*/ METHOD ft_fRecno() CLASS fTdb Self:nRecno := ( Self:cDbAlias )->( Recno() ) Return( Self:nRecno ) /*/ METHOD: ft_fSkip Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Salta n Posicoes Sintaxe: ftdb():ft_fSkip( nSkipper ) : nRecno /*/ METHOD ft_fSkip( nSkipper ) CLASS fTdb DEFAULT nSkipper := 1 ( Self:cDbAlias )->( dbSkip( nSkipper ) ) Self:nRecno := Self:ft_fRecno() Return( Self:nRecno ) /*/ METHOD: ft_fGoTo Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Salta para o Registro informando em nGoto Sintaxe: ftdb():ft_fGoTo( nGoTo ) : nRecno /*/ METHOD ft_fGoTo( nGoTo ) CLASS fTdb ( Self:cDbAlias )->( dbGoto( nGoTo ) ) Self:nRecno := Self:ft_fRecno() Return( Self:nRecno ) /*/ METHOD: ft_fGoTop Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Salta para o Inicio do Arquivo Sintaxe: ftdb():ft_fGoTo( nGoTo ) : nRecno /*/ METHOD ft_fGoTop() CLASS fTdb ( Self:cDbAlias )->( dbGoTop() ) Self:nRecno := Self:ft_fRecno() Return( Self:nRecno ) /*/ METHOD: ft_fGoBottom Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Salta para o Final do Arquivo Sintaxe: ftdb():ft_fGoBottom() : nRecno /*/ METHOD ft_fGoBottom() CLASS fTdb ( Self:cDbAlias )->( dbGoBottom() ) Self:nRecno := Self:ft_fRecno() Return( Self:nRecno ) /*/ METHOD: ft_fLastRec Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Retorna o Numero de Registro do Arquivo Sintaxe: ftdb():ft_fLastRec() : nRecCount /*/ METHOD ft_fLastRec() CLASS fTdb Return( ( Self:cDbAlias )->( LastRec() ) ) /*/ METHOD: ft_fRecCount Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Retorna o Numero de Registro do Arquivo Sintaxe: ftdb():ft_fRecCount() : nRecCount /*/ METHOD ft_fRecCount() CLASS fTdb Return( ( Self:cDbAlias )->( RecCount() ) ) /*/ METHOD: ft_fEof Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Verifica se Atingiu o Final do Arquivo Sintaxe: ftdb():ft_fEof() : lEof /*/ METHOD ft_fEof() CLASS fTdb Return( ( Self:cDbAlias )->( Eof() ) ) /*/ METHOD: ft_fBof Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Verifica se Atingiu o Inicio do Arquivo Sintaxe: ftdb():ft_fBof() : lBof /*/ METHOD ft_fBof() CLASS fTdb Return( ( Self:cDbAlias )->( Bof() ) ) /*/ METHOD: ft_fReadLine Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Le a Linha do Registro Atualmente Posicionado Sintaxe: ftdb():ft_fReadLine() : cLine /*/ METHOD ft_fReadLine() CLASS fTdb TRYEXCEPTION Self:nLastRecno := Self:nRecno Self:cLine := ( Self:cDbAlias )->( FieldGet( 1 ) ) CATCHEXCEPTION Self:cLine := "" ENDEXCEPTION Return( Self:cLine ) /*/ METHOD: ft_fReadLn Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Le a Linha do Registro Atualmente Posicionado Sintaxe: ftdb():ft_fReadLn() : cLine /*/ METHOD ft_fReadLn() CLASS fTdb Return( Self:ft_fReadLine() ) /*/ METHOD: ft_fError Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Retorna o Ultimo erro ocorrido Sintaxe: ftdb():ft_fError( @cError ) : nDosError /*/ METHOD ft_fError( cError ) CLASS fTdb cError := CaptureError() Return( fError() ) /*/ METHOD: ft_fSetBufferSize Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Redefine nBufferSize Sintaxe: ftdb():ft_fSetBufferSize( nBufferSize ) : nLastBufferSize /*/ METHOD ft_fSetBufferSize( nBufferSize ) CLASS fTdb Return( _Super:ft_fSetBufferSize( @nBufferSize ) ) /*/ METHOD: ft_fSetCRLF Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Redefine cCRLF Sintaxe: ftdb():ft_fSetCRLF( cCRLF ) : nLastCRLF /*/ METHOD ft_fSetCRLF( cCRLF ) CLASS fTdb Return( _Super:ft_fSetCRLF( @cCRLF ) ) /*/ METHOD: ft_fSetRddName Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Redefine cRddName Sintaxe: ftdb():ft_fSetRddName( cRddName ) : cLastRddName /*/ METHOD ft_fSetRddName( cRddName ) CLASS fTdb Local cLastRddName := Self:cRddName DEFAULT cRddName := "DBFCDXADS" Self:cRddName := Upper( cRddName ) Return( cLastRddName )
Abaixo um Exemplo de uso da nova classe.
#INCLUDE "PROTHEUS.CH" #INCLUDE "TBICONN.CH" /*/ Funcao: FTFdbSample Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Exemplo de Uso da Classe fTdb /*/ User Function FTFdbSample() Local aCab Local aDet Local cFile := "FTFSample.csv" //Deve estar em \system\ aFile := FileToArr( @cFile ) aCab := aFile[1] aDet := aFile[2] Return( { aCab , aDet } ) /*/ Funcao: FileToArr Autor: Marinaldo de Jesus Data: 01/05/2011 Descricao: Exemplo de Uso da Classe fT /*/ Static Function FileToArr( cFile ) Local aCab := {} Local aDet := {} Local cLine := "" Local cToken := Chr(255) Local cRddName := "DBFCDXADS" //"TOPCONN" Local lPrepEnv := ( !( cRddName == "DBFCDXADS" ) .and. ( Select( "SM0" ) == "0" ) ) Local ofTdb := fTdb():New() IF ( lPrepEnv ) PREPARE ENVIRONMENT EMPRESA "01" FILIAL "01" EndIF BEGIN SEQUENCE ofTdb:ft_fSetRddName( cRddName ) IF ( ofTdb:ft_fUse( cFile ) <= 0 ) ofTdb:ft_fUse() BREAK EndIF While !( ofTdb:ft_fEof() ) IncProc() cLine := ofTdb:ft_fReadLn() ConOut( cLine ) cLine := StrTran( cLine , '""' , '" "' ) //Carrego um espaço em branco cLine := StrTran( cLine , '","' , cToken ) //Defino o Separador cLine := StrTran( cLine , '"' , "" ) //Retiro as Aspas IF ( ofTdb:ft_fRecno() == 1 ) aCab := StrTokArr( cLine , cToken ) //A primeira Linha contem o Cabeçalho dos campos Else aAdd( aDet , StrTokArr( cLine , cToken ) ) //As demais linhas sao os Detalhes EndIF cLine := "" ofTdb:ft_fSkip() End While ofTdb:ft_fUse() END SEQUENCE IF ( lPrepEnv ) RESET ENVIRONMENT EndIF Return( { aCab , aDet } )
Para baixar os arquivos utilizanos neste "post", clique aqui, e, para maiores referências sobre Herança em Advpl consulte: Como criar uma classe ADVPL com herança (http://tdn.totvs.com.br/kbm#9392)
Para maior ditática e aprendizado, recomendo que os exemplos sejam executados através do IDE (totvsDevStudio) digitando-se u_FTFdbSample ou u_FTFSample e depurando-se o código.
Para comparar se o retorno das duas classes são exatamente iguais, poderiamos testar com:
ArrayCompare( u_FTFdbSample() , u_FTFSample() ) : Se .T. (True) o conteúdo retornado é exatamente igual. Ambas as classes estão fazendo o que se propõe, caso contrário.... "Tem alguma coisa errada que não está certa."
E.T.: ArrayCompare é uma função em Advpl que compara o conteúdo de 2 Arrays e verifica se são exatamente iguais. Se for, retorna .T. (True/Verdadeiro), caso contrário retornára (.F./False/Falso). ArrayCompare é uma das preciosidades criada por esse que vos escreve enquanto ainda na equipe IP da Totvs. Sua Sintaxe é: ArrayCompare( aArray1 , aArray2 ) ? .T. : .F.
Tenho dito: "Simples Assim".
[]s
иαldσ dj
Sempre Tio Marinaldo,
ResponderExcluirExcelente dica de um excelente profissional!
Marinaldo,
ResponderExcluirTentei usar o mesmo conceito criando uma classe TEMAIL que estende a TMailMessage
Class TEmail From TMailMessage
Data cError as String init ""
Data lRelauth as Boolean init .f.
Data cServer as String init ""
Data cConta as String init ""
Data cSenha as String init ""
Data cArqHtml as String init ""
Data aVariaveis as Array init {}
Data oServer as Object
METHOD New() CONSTRUCTOR
Method inicializa()
Method EnviaEMail()
Method aaddVariavel()
Method setHtml()
Method converteMensagem()
EndClass
//ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
//³ new ³
//ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
Method new() Class TEmail
_Super:New()
Return(Self)
Porem ao compilar tenho a seguinte mensagem
TEMAIL.PRW(45) C2021 Constructor of class TEMAIL must initialize the parent class TMAILMESSAGE
O que pode ser?
Ismael, faça a seguinte alteração.
ResponderExcluirDe:
Method new() Class TEmail
_Super:New()
Return(Self)
Para:
Method new() Class TEmail
:New() //<-Este é um caso especial em que o Construtor da Classe "Pai" deve ser executado logo após a declaração do método.
/*
Inclua seu código customizado para NEW aqui
*/
Return(Self)
Nao querendo ser chato... mas esse é um nivel de programacao somente para o SUPER NALDO.
ResponderExcluirAgora o sistema da a seguinte mensagem e chega a derrubar o server
Exception code: C0000005 ACCESS_VIOLATION
Fault address: 01EF6352 770ADFA5:00000000
Call stack:
Address Frame
01EF6352 0356FE20
1021CAC9 0356FE3C
apMain+1FE659
Unable to locate source line number
1021DE68 0356FE44
apMain+1FF9F8
Unable to locate source line number
10077C9E 0356FE58
apMain+5982E
Unable to locate source line number
10217BFB 0356FE70
apMain+1F978B
Unable to locate source line number
Call stack:
Address Frame Logical addr Module
apMain+1F6C77
102150E7 00000000 0001:002140E7 E:\MICROSIGA_11\INPLAC\bin\appserverIsmael\apwinnt.dll
Meu fonte esta assim
Class TEmail From TMailMessage
Data cError as String init ""
Data lRelauth as Boolean init .f.
Data cServer as String init ""
Data cConta as String init ""
Data cSenha as String init ""
Data cArqHtml as String init ""
Data aVariaveis as Array init {}
Data oServer as Object
METHOD New() CONSTRUCTOR
Method inicializa()
EndClass
//ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
//³ new ³
//ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
Method New() Class TEmail
:New()
conout("teste")
Return(Self)
//ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
//³ init ³
//ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
Method inicializa(/*xFrom,xEmailTo,xEmailCC,xEmailBCC,xTitulo*/) Class TEmail
/*::cFrom := "nfe2@inplac.com.br" //If(Empty(xFrom),GetMV("MV_RELACNT"),xFrom)
::cTo := If(xEmailTo != Nil,Rtrim(xEmailTo) ,"email@email.com.br")
::cCC := If(xEmailCC != Nil,Rtrim(xEmailCC) ,"")
::cBCC := If(xEmailBCC != Nil,Rtrim(xEmailBCC) ,"")
::cDate := dtoc(dDataBase)
::cBody := ""
::cSubject := If(xTitulo != Nil,Rtrim(xTitulo) ,"Sem Titulo")*/
Return
Ismael,
ExcluirInfelizmente trabalhar com OOP no ADVPL nos traz algumas surpresas. Diferente de Linguagens como [x]Harbour, C++, Java, Delphi, etc, em que os conceitos OOP como Herança, Herança Múltipla, Polimorfismo dentre outros são bem implementados. ADVPL possui uma "pseudo" programação OOP. Então, para evitar maiores surpresas, altere seu código para:
#INCLUDE "PROTHEUS.CH"
Class TEmail
Data cError as String init ""
Data lRelauth as Boolean init .f.
Data cServer as String init ""
Data cConta as String init ""
Data cSenha as String init ""
Data cArqHtml as String init ""
Data aVariaveis as Array init {}
Data oMessage as Object
Data oServer as Object
METHOD New() CONSTRUCTOR
Method inicializa()
EndClass
Method New() Class TEmail
::oMessage := TMailMessage():New()
::oServer := TMailManager():New()
Return(Self)
Method inicializa(/*xFrom,xEmailTo,xEmailCC,xEmailBCC,xTitulo*/) Class TEmail
/*::cFrom := "nfe2@inplac.com.br" //If(Empty(xFrom),GetMV("MV_RELACNT"),xFrom)
::oMessage:cTo := If(xEmailTo != Nil,Rtrim(xEmailTo) ,"email@email.com.br")
::oMessage:cCC := If(xEmailCC != Nil,Rtrim(xEmailCC) ,"")
::oMessage:cBCC := If(xEmailBCC != Nil,Rtrim(xEmailBCC) ,"")
::oMessage:cDate := dtoc(dDataBase)
::oMessage:cBody := ""
::oMessage:cSubject := If(xTitulo != Nil,Rtrim(xTitulo) ,"Sem Titulo")*/
Return
User Function TEmail()
Return( TEmail():New() )
User Function TEmailEx()
Local oTEmail := U_TEmail()
Return( NIL )
"Object Oriented syntax in Harbour is compatible with CA-CLIPPER. But Clipper only allowed creation of objects from a few standard classes, and did not let the programmer create new classes. In Harbour, you can create your own classes--complete with Methods, Instance Variables, Class Variables and Inheritance. Entire applications can be designed and coded in Object Oriented style"
ExcluirJá em ADVPL.... (sem comentários)
No Harbour:
ExcluirCLASS
Define a Class for Object Oriented Programming
Syntax
[CREATE] CLASS [ [,] ]
[STATIC]
Arguments
Name of the class to define. By tradition, Harbour classes start with "T" to avoid collisions with user- created classes.
The Parent class(es) to use for inheritance. Harbour supports Multiple Inheritance.
function. It will therefore not be available outside the current module.
Description
CLASS creates a class from which you can create objects. The CLASS command begins the class specification, in which the DATA elements (also known as instance variables) and METHODS of the class are named. The following scoping commands may also appear. They control the default scope of DATA and METHOD commands that follow them.
EXPORTED:
VISIBLE:
HIDDEN:
PROTECTED:
The class specification ends with the END CLASS command.
Classes can inherit from multiple , and the chain of inheritance can extend to many levels.
A program uses a Class by calling the Class Constructor, usually the New() method, to create an object. That object is usually assigned to a variable, which is used to access the DATA elements and methods.
Harbour's OOP syntax and implementation supports Scoping (Protect, Hidden and Readonly) and Delegating, and is largely compatible with Class(y)(tm),TopClass(tm) and Visual Objects(tm).
Certo
ResponderExcluirJá tinha pensado tb nesta solução.
Ficaria mais feliz se o ADVPL atendesse a esses conceitos e evoluísse em conceitos como limite de 1Mb para uma string, ou mesmo limites de array.
De qualquer forma muito obrigado pela força.
Como te questionar sob assuntos que não possuem tópicos?
Sempre acompanho seu blog e já aprendi muito com ele... parabens pelo empenho em ajudar a nós.
Naldo, boa tarde! Estou tentando compilar uma classe tAutoGet porém está dando o mesmo erro mencionado pelo Ismael:
ResponderExcluirTAUTOGET.PRG(67) C2021 Constructor of class TAUTOGET must initialize the parent class TGET
Conforme sugerido, fiz o uso de :New() no programa, parou de dar o erro, porém quando vou executar está dando isso aqui:
THREAD ERROR (Marcio, MARCIO-PC) 03/09/2014 16:22:25
invalid property _SUPCLS_ on TAUTOGET:NEW(TAUTOGET.PRG) 03/09/2014 16:21:41 line : 76
Alguma idéia do que possa ser?!
Caso alguém passe pelo problema do Anônimo, recebi o mesmo erro ao instanciar uma classe pai desta forma: Super:New()
ResponderExcluirTroquei para _Super:New() e resolveu.
Class Composicao FROM EnterpriseStruct
[...]
End Class
Method New(cCompositionCode,nMode,_cBranch,_cEnterprise,_cActivity,_cSubActivity,_cReview,_nSocial,_nAddTool ) Class Composicao
_Super:New({__CUserId,cEmpAnt,cFilAnt,'001','0001','000000'}) // corrigir na proxima versão
self:cBranch := _cBranch
self:cEnterprise := _cEnterprise
self:cActivity := _cActivity
self:cSubActivity := _cSubActivity
self:cReview := _cReview
self:cComposition := cCompositionCode
self:aComposition := aClone(::GetComposition(nMode))
self:nSocial := _nSocial
self:nAddTool := _nAddTool
Return