FUNCTION Open_Dbf( cArchivo, aIdx )
LOCAL cAlias
LOCAL oDbf
LOCAL i
STATIC _Select_
DEFAULT _Select_ := 0
cAlias := "TB" + PADL( ++_Select_, 3, "0" )
DbUseArea( .T. ,, cArchivo, cAlias, .T. )
IF VALTYPE( aIdx ) == "A"
FOR i := 1 TO LEN( aIdx )
DBSETINDEX( aIdx[ i ] )
NEXT
ENDIF
oDbf := TDb():New( cAlias )
RETURN oDbf
#INCLUDE "FIVEWIN.CH"
#define _DbSkipper DbSkipper
//----------------------------------------------------------------------------//
CLASS TDb
DATA nArea AS NUMERIC INIT 0
DATA lBuffer
DATA lShared AS LOGICAL INIT .t.
DATA aBuffer
DATA bBoF, bEoF, bNetError AS CODEBLOCK
DATA cAlias, cFile, cDriver AS String INIT ""
DATA lReadOnly AS LOGICAL INIT .f.
DATA lOemAnsi
DATA lTenChars AS LOGICAL INIT .t.
DATA aFldNames AS Array
DATA oBookMark AS OBJECT
DATA lBlank AS LOGICAL INIT .f.
METHOD New( cAlias ) CONSTRUCTOR
METHOD Activate()
METHOD AddIndex( cFile, cTag ) INLINE ( ::nArea )->( OrdListAdd( cFile, cTag ) )
MESSAGE AnsiToOem METHOD _AnsiToOem()
METHOD Append() INLINE ( ::nArea )->( DbAppend() )
METHOD Blank( nRecNo ) INLINE ( ::nArea )->( nRecNo := RecNo(),;
DBGoBottom(), ;
DBSkip( 1 ), ;
::Load(.t.),;
DBGoTo( nRecNo ),;
::lBlank := .t. )
METHOD Bof() INLINE ( ::nArea )->( BoF() )
METHOD Close() INLINE ( ::nArea )->( DbCloseArea() )
METHOD SetScope( n, xVar) INLINE ( ::nArea )->( OrdScope( n, xVar ) )
METHOD OrdKeyNo( n, xVar) INLINE ( ::nArea )->( OrdKeyNo() )
METHOD ClrScope( n ) INLINE ( ::nArea )->( OrdScope( n, NIL ) )
METHOD CloseIndex() INLINE ( ::nArea )->( OrdListClear() )
METHOD Commit() INLINE ( ::nArea )->( DBCommit() )
METHOD Create( cFile, aStruct, cDriver ) ;
INLINE DbCreate( cFile, aStruct, cDriver )
METHOD CreateIndex( cFile, cTag, cKey, bKey, lUnique) INLINE ;
( ::nArea )->( OrdCreate( cFile, cTag, cKey, bKey, lUnique ) )
METHOD ClearRelation() INLINE ( ::nArea )->( DbClearRelation() )
METHOD DbCreate( aStruct ) INLINE DbCreate( ::cFile, aStruct, ::cDriver )
METHOD Deactivate() INLINE ( ::nArea )->( DbCloseArea() ), ::nArea := 0
METHOD Eval( bBlock, bFor, bWhile, nNext, nRecord, lRest ) ;
INLINE ( ::nArea )->( DBEval( bBlock, bFor, ;
bWhile, nNext, nRecord, ;
lRest ) )
MESSAGE Delete METHOD _Delete()
METHOD Deleted() INLINE ( ::nArea )->( Deleted() )
METHOD DeleteIndex( cTag, cFile ) INLINE ( ::nArea )->( OrdDestroy( cTag, cFile ) )
METHOD Eof() INLINE ( ::nArea )->( EoF() )
METHOD FCount() INLINE ( ::nArea )->( FCount() )
MESSAGE FieldGet METHOD _FieldGet( nField )
METHOD FieldName( nField ) INLINE ( ::nArea )->( FieldName( nField ) )
METHOD FieldPos( cFieldName ) INLINE ( ::nArea )->( FieldPos( cFieldName ) )
MESSAGE FieldPut METHOD _FieldPut( nField, uVal )
METHOD Found() INLINE ( ::nArea )->( Found() )
METHOD GetBookMark()
METHOD GoTo( nRecNo ) INLINE ( ::nArea )->( DBGoTo( nRecNo ) ),;
If( ::lBuffer, ::Load(), )
METHOD GoTop() INLINE ( ::nArea )->( DBGoTop() ),;
If( ::lBuffer, ::Load(), )
METHOD GoBottom() INLINE ( ::nArea )->( DBGoBottom() ),;
If( ::lBuffer, ::Load(), )
METHOD IndexKey( ncTag, cFile ) INLINE ( ::nArea )->( OrdKey( ncTag, cFile ) )
METHOD IndexName( nTag, cFile ) INLINE ( ::nArea )->( OrdName( nTag, cFile ) )
METHOD IndexBagName( nInd ) INLINE ( ::nArea )->( OrdBagName( nInd ) )
METHOD IndexOrder( cTag, cFile ) INLINE ( ::nArea )->( OrdNumber( cTag, cFile ) )
METHOD LastRec( nRec ) INLINE ( ::nArea )->( LastRec() )
METHOD Load()
METHOD Lock() INLINE ( ::nArea )->( FLock() )
METHOD Modified()
MESSAGE OemToAnsi METHOD _OemToAnsi()
METHOD Pack() INLINE ( ::nArea )->( DbPack() )
METHOD ReCall() INLINE ( ::nArea )->( DBRecall() )
METHOD RecCount() INLINE ( ::nArea )->( RecCount() )
METHOD RecLock() INLINE ( ::nArea )->( RLock() )
METHOD RecNo() INLINE ( ::nArea )->( RecNo() )
METHOD Save()
METHOD SetBuffer( lOnOff )
METHOD SetBookMark()
METHOD Seek( uExp, lSoft )
METHOD SetOrder( cnTag, cFile ) INLINE ( ( ::nArea )->( OrdSetFocus( cnTag, cFile ) ) )
METHOD SetRelation( ncArea, cExp ) INLINE ;
( ::nArea )->( DbSetRelation( ncArea, Compile( cExp ), cExp ) )
METHOD Skip( nRecords )
METHOD Skipper( nRecords )
METHOD UnLock() INLINE ( ::nArea )->( DBUnLock() )
METHOD Used() INLINE ( ::nArea )->( Used() )
METHOD Insert()
METHOD Zap() INLINE ( ::nArea )->( DbZap() )
METHOD Debug()
METHOD NewObj()
METHOD LoadObj()
METHOD SaveObj()
METHOD SetBrowse()
METHOD Count() INLINE (::nArea)->(RecCount())
METHOD Fin() INLINE (::nArea)->(DBCloseArea())
METHOD SetFocus() INLINE (Select(::cAlias))
ERROR HANDLER OnError( uParam1 )
ENDCLASS
//---------------------------------------------------------------------------//
METHOD New( cAlias ) CLASS TDb
local n, oClass, aDatas := {}, aMethods := {}
local nWorkArea
nWorkArea := Select( cAlias )
::nArea = nWorkArea
::cAlias = Alias( nWorkArea )
::cFile = Alias( nWorkArea )
::cDriver = ( Alias( nWorkArea ) )->( DbSetDriver() )
::lShared = .t.
::lReadOnly = .f.
::lBuffer = .t.
::lOemAnsi = .f.
::bNetError = { || MsgStop( "Record in use", "Please, retry" ) }
::aFldNames = {}
for n = 1 to ( ::cAlias )->( FCount() )
AAdd( ::aFldNames, ( ::cAlias )->( FieldName( n ) ) )
next
::Load()
return Self
//----------------------------------------------------------------------------//
METHOD Activate() CLASS TDb
local nOldArea:= Select()
Select ( ::nArea )
if ! Used()
DbUseArea( .f., ::cDriver, ::cFile, ::cAlias, ::lShared, ::lReadOnly )
endif
Select ( nOldArea )
return nil
//----------------------------------------------------------------------------//
METHOD _AnsiToOem() CLASS TDb
local n
for n = 1 to Len( ::aBuffer )
if ValType( ::aBuffer[ n ] ) == "C"
::aBuffer[ n ] = AnsiToOem( ::aBuffer[ n ] )
endif
next
return nil
//----------------------------------------------------------------------------//
METHOD _Delete() CLASS TDb
if ::lShared
if ::Lock()
( ::nArea )->( DbDelete() )
::UnLock()
else
MsgAlert( "DataBase in use", "Please try again" )
endif
else
( ::nArea )->( DbDelete() )
endif
return nil
//---------------------------------------------------------------------------//
METHOD _FieldPut( nPos, uValue ) CLASS TDb
if ::lBuffer
::aBuffer[ nPos ] := uValue
else
if ::lShared
if ::RecLock()
( ::nArea )->( FieldPut( nPos, uValue ) )
::UnLock()
else
if ! Empty( ::bNetError )
return Eval( ::bNetError, Self )
endif
endif
else
( ::nArea )->( FieldPut( nPos, uValue ) )
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD _FieldGet( nPos ) CLASS TDb
if ::lBuffer
return ::aBuffer[ nPos ]
else
return ( ::nArea )->( FieldGet( nPos ) )
endif
return nil
//---------------------------------------------------------------------------//
static function Compile( cExp )
return &( "{||" + cExp + "}" )
//----------------------------------------------------------------------------//
METHOD Load() CLASS TDb
local n
if ::lBuffer
if Empty( ::aBuffer )
::aBuffer = Array( ::FCount() )
endif
for n = 1 to Len( ::aBuffer )
::aBuffer[ n ] = ( ::nArea )->( FieldGet( n ) )
next
if ::lOemAnsi
::OemToAnsi()
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD Modified() CLASS TDb
local cField, nFor
for nFor := 1 to Len( ::aFldNames )
cField = ( ::cAlias )->( FieldName( nFor ) )
if ( ::cAlias )->( FieldGet( nFor ) ) != ::aBuffer[ nFor ]
return .t.
endif
next
return .f.
//----------------------------------------------------------------------------//
METHOD _OemToAnsi() CLASS TDb
local n
for n = 1 to Len( ::aBuffer )
if ValType( ::aBuffer[ n ] ) == "C"
::aBuffer[ n ] = OemToAnsi( ::aBuffer[ n ] )
endif
next
return nil
//----------------------------------------------------------------------------//
METHOD OnError( uParam1 ) CLASS TDb
local cMsg := __GetMessage()
local nError := If( SubStr( cMsg, 1, 1 ) == "_", 1005, 1004 )
local nField
if ::lTenChars .and. Len( SubStr( cMsg, 2 ) ) == 9
cMsg = Upper( cMsg )
if SubStr( cMsg, 1, 1 ) == "_"
if ( nField := AScan( ::aFldNames,;
{ | cField | SubStr( cMsg, 2 ) == ;
RTrim( SubStr( cField, 1, 9 ) ) } ) ) != 0
::FieldPut( nField, uParam1 )
else
_ClsSetError( _GenError( nError, ::ClassName(), SubStr( cMsg, 2 ) ) )
endif
else
if( ( nField := ::FieldPos( cMsg ) ) != 0 )
return ::FieldGet( nField )
else
_ClsSetError( _GenError( nError, ::ClassName(), cMsg ) )
endif
endif
return nil
endif
if SubStr( cMsg, 1, 1 ) == "_"
if( ( nField := ::FieldPos( SubStr( cMsg, 2 ) ) ) != 0 )
::FieldPut( nField, uParam1 )
else
_ClsSetError( _GenError( nError, ::ClassName(), SubStr( cMsg, 2 ) ) )
endif
else
if( ( nField := ::FieldPos( cMsg ) ) != 0 )
return ::FieldGet( nField )
else
_ClsSetError( _GenError( nError, ::ClassName(), cMsg ) )
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD Seek( uExpr, lSoft ) CLASS TDb
local lFound
DEFAULT lSoft := Set( _SET_SOFTSEEK )
lFound = ( ::nArea )->( DbSeek( uExpr, lSoft ) )
if ::lBuffer
::Load()
endif
return lFound
//----------------------------------------------------------------------------//
METHOD SetBuffer( lOnOff ) CLASS TDb
DEFAULT lOnOff := .t.
if lOnOff != nil
::lBuffer = lOnOff
endif
if ::lBuffer
::Load()
else
::aBuffer := nil
endif
return ::lBuffer
//----------------------------------------------------------------------------//
METHOD Save() CLASS TDb
local n
if ::lBuffer
if ! ( ::nArea )->( EoF() )
if ::lShared
if ::RecLock()
for n := 1 to Len( ::aBuffer )
if ::lOemAnsi .and. ValType( ::aBuffer[ n ] ) == "C"
( ::nArea )->( FieldPut( n, AnsiToOem( ::aBuffer[ n ] ) ) )
else
( ::nArea )->( FieldPut( n, ::aBuffer[ n ] ) )
endif
next
::UnLock()
else
if ! Empty( ::bNetError )
return Eval( ::bNetError, Self )
else
MsgAlert( "Record in use", "Please, retry" )
endif
endif
else
for n := 1 to Len( ::aBuffer )
if ::lOemAnsi .and. ValType( ::aBuffer[ n ] ) == "C"
( ::nArea )->( FieldPut( n, AnsiToOem( ::aBuffer[ n ] ) ) )
else
( ::nArea )->( FieldPut( n, ::aBuffer[ n ] ) )
endif
next
endif
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD Skip( nRecords ) CLASS TDb
local n
DEFAULT nRecords := 1
( ::nArea )->( DbSkip( nRecords ) )
if ::lBuffer
::Load()
endif
if ::Eof()
if ::bEoF != nil
Eval( ::bEoF, Self )
endif
endif
if ::BoF()
if ::bBoF != nil
Eval( ::bBoF, Self )
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD Skipper( nRecords ) CLASS TDb
local nSkipped
DEFAULT nRecords := 1
nSkipped = ( ::nArea )->( _DbSkipper( nRecords ) )
if ::lBuffer
::Load()
endif
return nSkipped
//----------------------------------------------------------------------------//
METHOD SetBookMark() CLASS TDb
//::Load()
//::Debug()
::oBookMark := TBookMark():New( Self )
::oBookMark:Set()
RETURN Self
//----------------------------------------------------------------------------//
METHOD GetBookMark() CLASS TDb
::cAlias := ::oBookMark:cAlias
::SetOrder( ::oBookMark:cnIndex )
::goto( ::oBookMark:nRecno )
::aBuffer := AClone( ::oBookMark:aBuffer )
//Self := ::oBookMark:oDb
//::Debug()
RETURN Self
//----------------------------------------------------------------------------//
METHOD Debug() CLASS TDb
LOCAL i, cText
cText := ""
FOR i := 1 TO LEN( ::aBuffer )
//cText += xType( ::aBuffer[i] ) + CRLF
NEXT i
MsgInfo( cText )
RETURN .T.
//----------------------------------------------------------------------------//
METHOD NewObj() CLASS TDb
::Blank()
::SetBookMark()
RETURN TObjDb():New( Self, .T. )
//----------------------------------------------------------------------------//
METHOD LoadObj() CLASS TDb
::Load()
::SetBookMark()
RETURN TObjDb():New( Self, .F. )
//----------------------------------------------------------------------------//
METHOD SaveObj( oData ) CLASS TDb
::GetBookMark()
::aBuffer := AClone( oData:aBuffer )
IF oData:lNuevo
::Append()
ENDIF
::Save()
RETURN NIL
//----------------------------------------------------------------------------//
METHOD SetBrowse(oLbx) CLASS TDb
oLbx:bGotop := { || ::GoTop() }
oLbx:bGoBottom := { || ::GoBottom()}
oLbx:bSkip := { |nRec| ::Skipper( nRec ) }
oLbx:bLogicLen := { || ::RecCount() }
// oLbx:nHeaderHeight := 20
// oLbx:nLineHeight := 20
RETURN oLbx
//----------------------------------------------------------------------------//
METHOD Insert() CLASS TDb
LOCAL lOk:=.f.
(::nArea)->(DBAppend())
IF !NetErr()
::Save()
lOk:=.t.
ENDIF
RETURN lOk
#INCLUDE "FIVEWIN.CH"
//----------------------------------------------------------------------------//
CLASS TObjDb
DATA aBuffer
DATA aFldNames
DATA lNuevo
DATA oDb
METHOD New( oDb, lNew) CONSTRUCTOR
METHOD Debug()
ERROR HANDLER OnError( uParam1 )
ENDCLASS
//---------------------------------------------------------------------------//
METHOD New( oDb, lNew ) CLASS TObjDb
::aBuffer := AClone( oDb:aBuffer )
::aFldNames := AClone( oDb:aFldNames )
::lNuevo := lNew
RETURN Self
//----------------------------------------------------------------------------//
METHOD OnError( uParam1 ) CLASS TObjDb
LOCAL cMsg := __GetMessage()
LOCAL nError := IIF( SubStr( cMsg, 1, 1 ) == "_", 1005, 1004 )
LOCAL nField
if SubStr( cMsg, 1, 1 ) == "_"
if(( nField := AScan( ::aFldNames, { | cField | SubStr( cMsg, 2 ) == ;
RTrim( SubStr( cField, 1 ) ) } ) ) != 0 )
::aBuffer[ nField ] := uParam1
else
_ClsSetError( _GenError( nError, ::ClassName(), SubStr( cMsg, 2 ) ) )
endif
else
if( nField := AScan( ::aFldNames, { | cField | SubStr( cMsg, 1 ) == ;
RTrim( cField ) } ) ) != 0
return ::aBuffer[ nField ]
ELSE
_ClsSetError( _GenError( nError, ::ClassName(), cMsg ) )
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD Debug() CLASS TObjDb
LOCAL i, cText
cText := ""
FOR i := 1 TO LEN( ::aBuffer )
// cText += ::aFldNames[i] + ":" + xType( ::aBuffer[i] ) + CRLF
NEXT i
MsgInfo( cText )
RETURN .T.[code]
[/code]
to open an archive the procedure made
[code]
METHOD New() CLASS TPaciente
LOCAL oFont1
::oPaciente := Abrir_Arc( "paciente", { "paciente" } )
::oPaciente:SetOrder( "NOMBRE" )
::oPaciente:GoTop()
[/code]
to add a new customer it made this
[code]
METHOD Editar( lNuevo ) CLASS TPaciente
LOCAL oDlg
LOCAL nEdad
LOCAL lGrabar := .F.
LOCAL cTitulo
LOCAL cCodigo
LOCAL oGet := Array(8)
LOCAL QSelf := Self
DEFAULT lNuevo := .F.
IF lNuevo
cCodigo := fCrearDoc( "PACIENTES" )
cTitulo := "Creación de pacientes"
::oData := ::oPaciente:NewObj()
// -------------------------------- //
::oData:Codigo := cCodigo
ELSE
IF ::oPaciente:Lastrec() == 0
MsgInfo( "Hay informacion en el sistema", "Edicion" )
RETURN NIL
ENDIF
::oData := ::oPaciente:LoadObj()
cTitulo := "Modificar Paciente"
ENDIF[/code]
to create a new code it use a function and a control.dbf
[code]FUNCTION fCrearDoc( cTDoc )
LOCAL oControl
LOCAL cDoc
oControl := Abrir_Arc( "Control", {} )
DO CASE
CASE ALLTRIM( cTDoc ) == "PPTOS" ; oControl:GoTo( 1 )
CASE ALLTRIM( cTDoc ) == "TRATAMIENT" ; oControl:GoTo( 2 )
CASE ALLTRIM( cTDoc ) == "LABTORIO" ; oControl:GoTo( 3 )
CASE ALLTRIM( cTDoc ) == "ORDENES" ; oControl:GoTo( 4 )
CASE ALLTRIM( cTDoc ) == "INTERNO" ; oControl:GoTo( 5 )
CASE ALLTRIM( cTDoc ) == "PACIENTES" ; oControl:GoTo( 6 )
CASE ALLTRIM( cTDoc ) == "HISTORIAL" ; oControl:GoTo( 7 )
ENDCASE
oControl:Load()
IF oControl:RecLock()
cDoc := PADL( ( VAL( oControl:documento ) + 1 ), oControl:largo, "0" )
oControl:documento := cDoc
oControl:Save()
ELSE
MsgStop( "No se pudo crear el documento", cTDoc )
QUIT
ENDIF
oControl:Close()
RETURN cDoc
METHOD NewObj () CLASS TDb
:: Blank ()
:: SetBookmark ()
RETURN TObjDb (): New (Self, .T.)
METHOD LoadObj () CLASS TDb
:: Load ()
:: SetBookmark ()
RETURN TObjDb (): New (Self, .F.)
METHOD SaveObj (oData) CLASS TDb
:: GetBookmark ()
:: aBuffer: = AClone (oData: aBuffer)
IF or Data: levo
:: Append ()
ENDIF
:: Save ()
RETURN NIL
oGuest: = tdatabase():New(......
oGuest: SetScope (0, oClienti:IdCliente)
oGuest: SetScope (1, oClientiIdCliente)
oGuest: Gotop ()
You use the example of an Invoice. Mine must track client, service item, parts, labor, recommendations, finances, and more. Plus I have to call other routines for history, deposits, pending needs, and outside services.
There has been a lot of discussion here on Filters, but I have the active index for all of these items using the invoice number in each database. Rather than a filter, which can be slow, I simply use the Scope method to show only those items related to the open invoice. It is incredibly fast. It is activated, of course, within the method for opening the database. This is another way to simplify code and improve performance.
Silvio.Falconi wrote:To connect the guest archive to customers, I had thought of such a form
oGuest: = tdatabase():New(......
oGuest: SetScope (0, oClienti:IdCliente)
oGuest: SetScope (1, oClientiIdCliente)
oGuest: Gotop ()
It might work ?
Slowly, I convert my old program with the databases, I'm afraid I'll get to a point when I realize that I'm doing everything wrong, in the past few years I've lost the databases because they didn't work and now I'm very afraid, scared to start all over again other time and never get to the end of the conversion of my old application
oWorkorder := TWorkorder():New( cWorkID )
::oWorkParts := TWorkParts():New( ::oCurrentOrder:wrkord )
Method New( cWrkOrd ) CLASS TWorkParts //Data
::super():new(,"eprpar")
if ::use()
::setOrder( 1 )
::setscopetop( cWrkord )
::setscopebottom( cWrkord )
::gotop()
endif
Return self
A simple code:
::InvoiceNo:WorkDate
within a method would be better as:
LOCAL oOrder := self
oOrder:InvoiceNo:WorkDate
When initializing the workorder, two calls are made for parts:
::oWorkParts := TWorkParts():New( oEditWork:oCurrentOrder:wrkord )
::oWorkPartsr := TRecord():new( oEditWork:oWorkParts )
Then, in the browse, when scrolling, I simply do:
::oWorkPartsr:Load()
::oDlg:update()
Yes, filters are normally way too slow, expecially on a network. They require that the entire database be sent across the network just to find a few records.
Filters are optimized using indexes and only the required records (not the entire database) are read from the server.
Also, one word of caution: We often use :: to reference the object but this can sometimes result in conflicts with other classes.
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 46 guests