# include "FiveWin.ch"
#ifdef __xHARBOUR__
# xtranslate BYNAME <V> [, <VN> ] => ::<V> := <V> [; ::<VN> := <VN> ]
# xtranslate BYNAME <V> DEFAULT <Val> => ::<V> := BYDEFAULT <V>, <Val>
# xtranslate BYNAME <V> IFNONIL => if <V> != NIL ; ::<V> := <V> ; endif
# xtranslate BYDEFAULT <V>, <Val> => if( <V> == NIL, <Val>, <V> )
#endif
CLASS TPublic
DATA automata AS LOGICAL INIT .T.
DATA aVars AS ARRAY INIT NIL
DATA nPos AS NUMERIC INIT 0 READONLY
DATA cName AS CHARACTER INIT "" READONLY
METHOD New( automata )
METHOD End() INLINE ::Release()
METHOD Add( cName, xValue )
METHOD Del( cName )
METHOD Get( cName )
METHOD Set( cName, xValue )
METHOD GetPos( cName )
METHOD Release()
METHOD IsDef( cName )
METHOD Clone() INLINE aClone( ::aClone )
METHOD nCount() INLINE Len( ::aVars )
METHOD Save() INLINE aClone( ::aVars )
METHOD Restore( aVars ) INLINE ::aVars := aClone( aVars )
#ifdef __HARBOUR__
ERROR HANDLER OnError( uParam1 )
#else
ERROR HANDLER OnError( cMsg, nError )
#endif
ENDCLASS
METHOD New( automata ) CLASS TPublic
::aVars := {}
RETURN Self
METHOD Add( cName, xValue ) CLASS TPublic
if cName != NIL
if (::nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )) != 0
::aVars[::nPos,2] := xValue
#ifndef __HARBOUR__
elseif Len(::aVars) < 4000
aAdd( ::aVars, { AllTrim(Upper(cName)), xValue } )
::nPos := Len(::aVars)
else
MsgAlert("Demasiadas variables definidas para la Clase TPublic()")
#else
else
aAdd( ::aVars, { AllTrim(Upper(cName)), xValue } )
::nPos := Len(::aVars)
#endif
endif
::cName := cName
endif
RETURN Self
METHOD Del( cName ) CLASS TPublic
local nPos
if cName != NIL
if (nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )) != 0
aDel( ::aVars, nPos )
::aVars := aSize( ::aVars, Len(::aVars) - 1 )
::nPos := 0
::cName := ""
endif
endif
RETURN Self
METHOD Get( cName ) CLASS TPublic
if cName != ::cName
::nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )
::cName := cName
endif
RETURN ::aVars[::nPos,2]
METHOD Set( cName, xValue ) CLASS TPublic
if cName != ::cName
::nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )
::cName := cName
endif
::aVars[::nPos,2] := xValue
RETURN Self
METHOD GetPos( cName ) CLASS TPublic
::cName := cName
RETURN ::nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )
METHOD Release() CLASS TPublic
ASIZE(::aVars,0)
::cName := ""
::nPos := 0
RETURN Self
METHOD IsDef( cName ) CLASS TPublic
local lOk := .F.
if cName != NIL
if (::nPos := aScan( ::aVars, { |e,n| e[1] == AllTrim(Upper(cName)) } )) != 0
::cName := cName
lOk := .T.
endif
endif
RETURN lOk
#ifdef __HARBOUR__
METHOD OnError( uParam1 ) CLASS TPublic
local cMsg := __GetMessage()
local nError := If( SubStr( cMsg, 1, 1 ) == "_", 1005, 1004 )
#else
METHOD OnError( cMsg, nError ) CLASS TPublic
local uParam1 := GetParam( 1, 1 )
#endif
cMsg := Upper( AllTrim( cMsg ))
if SubStr( cMsg, 1, 1 ) == "_"
cMsg := SubStr( cMsg, 2 )
if cMsg == Upper(::cName)
::aVars[::nPos,2] := uParam1
elseif ( ::nPos := aScan( ::aVars, { |e,n| e[1] == cMsg } ) ) != 0
::cName := cMsg
::aVars[::nPos,2] := uParam1
else
if !::automata
_ClsSetError( _GenError( nError, ::ClassName(), cMsg ) )
::cName := ""
::nPos := 0
else
::add(cmsg)
::aVars[::nPos,2] := uParam1
endif
endif
else
if cMsg == Upper(::cName)
RETURN ::aVars[::nPos,2]
elseif ( ::nPos := aScan( ::aVars, { |e,n| e[1] == cMsg } ) ) != 0
::cName := cMsg
RETURN ::aVars[::nPos,2]
else
_ClsSetError( _GenError( nError, ::ClassName(), cMsg ) )
::cName := ""
::nPos := 0
endif
endif
RETURN NIL
c:\temp>c:\harbour\bin\harbour /n /ic:\fwh\include /ic:\harbour\include tpublic.prg
Harbour 3.2.0dev (r1603082110)
Copyright (c) 1999-2016, http://harbour-project.org/
Compiling 'tpublic.prg'...
Lines 4748, Functions/Procedures 10
Generating C source output to 'tpublic.c'... Done.
c:\temp>c:\xharbour\bin\harbour /n /ic:\fwh\include /ic:\xharbour\include tpublic.prg
xHarbour 1.2.3 Intl. (SimpLex) (Build 20151110)
Copyright 1999-2015, http://www.xharbour.org http://www.harbour-project.org/
Compiling 'tpublic.prg'...
Generating C source output to 'tpublic.c'...
Done.
Lines 198, Functions/Procedures 10, pCodes 798
Harbour 3.2.0dev (r1601050904)
Copyright (c) 1999-2015, http://harbour-project.org/
Compiling 'Noname.prg'...
Lines 4788, Functions/Procedures 10
Generating C source output to 'Noname.c'... Done.
Turbo Incremental Link 6.70 Copyright (c) 1997-2014 Embarcadero Technologies, Inc.
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: No registered users and 58 guests