Criar classe nativa em clipper 5.2e

[dbsh]

cuidado que se tiver erro dentro da classe nao vai gerar erro m tempo de execução, pode sair sem avisar.
recomendo fazer funçao e testar fora da classe.
qualquer duvida e so postar.

Código: Selecionar todos

#DEFINE TESTE

#command DEFAULT <var> TO <def> [, <varn> TO <defn>]     =>  ;
         <var> := if(<var> = nil,<def>,<var>) [; <varn> := if(<varn> = nil,<defn>,<varn>)]

************ INICIO DO ARQUIVO CLSCLIPP.CH ********************
//#include "clsclipp.ch"
#COMMAND CLASS <c>([<list,...>]) => ;
      FUNCTION <c>([<list>]);
    ; static Handle;
    ; local oSelf, aVar := {}, aMet := {}, sFunc, cbInit;
    [; cbInit := {|| oSelf:Init(<list>) }];
    ; IF Handle = NIL;
    ;     sFunc := <(c)>;
    ;

//inicializa somente uma vez
#COMMAND ENDCLASS INIT UNIQ => ;
         Handle := ClsClipper( sFunc, aVar, aMet);
    ;    oSelf := __ClassIns( handle );
    ;    Eval( cbInit );
    ; else;
    ;     oSelf := __ClassIns( handle );
    ; end;
    ; RETURN ( oSelf )

//inicializa toda vez que instancia a classe
#COMMAND ENDCLASS INIT => ;
         Handle := ClsClipper( sFunc, aVar, aMet);
    ; end;
    ; oSelf := __ClassIns( handle );
    ; Eval(cbInit);
    ; RETURN ( oSelf )

#COMMAND ENDCLASS => ;
          Handle := ClsClipper( sFunc, aVar, aMet);
    ; end ;
    ; oSelf := __ClassIns( handle );
    ; RETURN (oSelf)

//declara :: como chamada a QSelf()
#xtranslate ::[<v>] => QSelf()[:<v>]

//declara variaveis da class
#COMMAND DATA <v> => aadd(aVar, {<(v)>, <(v)>}) //chama uma funcao com o mesmo nome da variavel
#COMMAND DATA <v>, <func> => aadd(aVar, {<(v)>, <(func)>}) ////define o nome da funcao diferente do nome da variavel
#COMMAND VAR <list,...> => DATA <list>

//declara method da class
#COMMAND METHOD <m> => aadd(aMet, {<(m)>, <(m)>}) //chama uma funcao com o mesmo nome do method
#COMMAND METHOD <m>, <func> => aadd(aMet, {<(m)>, <(func)>}) ////define o nome da funcao diferente do nome do method

//declara funcao chamada pelo method da class
#COMMAND METHOD <m>([<list,...>]) => FUNCTION <m>([<list>])

//declara funcao chamada pela variavel da class
#COMMAND ACCESS <v>[()] => FUNCTION <v>[()]
#COMMAND ASSIGN <v>([<list,...>]) => FUNCTION <v>([<list>])
#COMMAND DATA <v>([<list,...>]) => FUNCTION <v>([<list>])
************ FIM DO ARQUIVO CLSCLIPP.CH ********************

************ INICIO DO ARQUIVO EXEMPLO ********************
#ifdef TESTE

//usar define em funcao de variavel para nao fazer chamada recursiva
#DEFINE _DATA_MENSAGEM_  QSelf()[1]
#DEFINE _DATA_OPCAO_     QSelf()[2]
#DEFINE _DATA_COR_       QSelf()[3]
#DEFINE _DATA_OPCAO_SEL_ QSelf()[4]

FUNCTION Test()
LOCAL oCls1, oCls2

wait

oCls1 := ClsAlerta("<ENTER> para proxima tela")
oCls1:Show()
? oCls1:OpcaoSelecionada

oCls2 := ClsAlerta()
oCls2:New("confirma?", { "Sim", "Nao" })
oCls2:Show()
? oCls2:OpcaoSelecionada

RETURN NIL

CLASS ClsAlerta(v1, v2, v3)

DATA Mensagem
DATA Opcao
DATA Cor
DATA OpcaoSelecionada
DATA nada

METHOD Init
METHOD New
METHOD Show

//ENDCLASS //fecha classe
ENDCLASS INIT //executa Init() toda vez que se cria uma estancia da classe
//ENDCLASS INIT UNIQ //executa init() somente quando e instanciada pela primeira vez

PROCEDURE Init(sMsg) //pode ser inicializa pela classe ou chamada manual

DEFAULT sMsg TO "Pressione <ENTER> ou <ESC> para continuar"
::Mensagem := sMsg

RETURN

METHOD New( sMensagem, aOp, sCor )

IF sMensagem <> NIL
    ::Mensagem := sMensagem
ENDIF
::Opcao := aOp
::Cor := sCor

RETURN ::


METHOD Show( sMensagem )

IF sMensagem == NIL //muda a mensagem sem alterar a variavel de classe
    sMensagem := ::Mensagem
ENDIF

//como e variavel so de leitura, gravo direto no vetor
_DATA_OPCAO_SEL_ := Alert( sMensagem, ::Opcao, ::Cor )

//RETURN ::OpcaoSelecionada
RETURN _DATA_OPCAO_SEL_

FUNCTION Mensagem( uSet )
IF !uSet = NIL
    _DATA_MENSAGEM_ := _EINSTVAR(QSelf(), "MENSAGEM", uSet, "C", 1001)
ENDIF
RETURN _DATA_MENSAGEM_

FUNCTION Opcao( uSet )
IF !uSet = NIL
    _DATA_OPCAO_ := _EINSTVAR(QSelf(), "OPCAO", uSet, "A", 1001)
ENDIF
RETURN _DATA_OPCAO_

FUNCTION Cor( uSet )
IF !uSet = NIL
    _DATA_COR_ := _EINSTVAR(QSelf(), "COR", uSet, "C", 1001)
ENDIF
RETURN _DATA_COR_

FUNCTION OpcaoSelecionada
RETURN _DATA_OPCAO_SEL_

#endif
************   FIM DO ARQUIVO EXEMPLO ******************

************   INICIO DO ARQUIVO CLSCLIPP.PRG ******************
//#include "clsclipp.ch"
FUNCTION ClsClipper( sClasse, aVar, aMet )
LOCAL Handle, xx

DEFA aVar TO {}
DEFA aMet TO {}

handle := __ClassNew( sClasse, Len(aVar) + Len( aMet ) )

/*
a diferenca da variavel para method e que a variavel tem _
na frente da segunda declaracao, senao funciona apenas
como variavel de acesso, nao atribui valor
*/

//variaveis
FOR xx := 1 TO Len( aVar )
    __ClassAdd( handle, aVar[xx, 1],  aVar[xx, 2])
    __ClassAdd( handle, "_" + aVar[xx, 1], aVar[xx, 2])
NEXT

//method
FOR xx := 1 TO Len( aMet )
    __ClassAdd( handle, aMet[xx, 1], aMet[xx, 2])
NEXT

RETURN Handle
************   FIM DO ARQUIVO CLSCLIPP.PRG ******************