to Nages: test for tdatabase

User avatar
Silvio.Falconi
Posts: 4956
Joined: Thu Oct 18, 2012 7:17 pm

Re: to Nages: test for tdatabase

Post by Silvio.Falconi »

thanks ok
I use : FiveWin for Harbour August 2020 (Revision) - Harbour 3.2.0dev (r1712141320) - Bcc7.30 - xMate ver. 1.15.3 - PellesC
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:

Re: to Nages: test for tdatabase

Post by Otto »

Hello Silvio,
I read that you have a new law starting on 1-7-2019 for billing.
How does this effect your software.
Best regards
Otto
google translated
According to the new provision, the daily income
- electronically recorded and
- telematically transmitted to the Agency for Revenue.
By introducing the electronically recorded daily income with the already introduced electronic invoice, the circle is closed with which all active sales are electronically occupied. The tax receipt ("Ricevuta fiscale") is de facto abolished with the introduction of telematic daily revenues. As of 01.01.2020 (or from 01.07.2019 for companies with previous year's turnover of more than Euro 400.000) it will no longer be possible to issue tax receipts.
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org

********************************************************************
User avatar
Silvio.Falconi
Posts: 4956
Joined: Thu Oct 18, 2012 7:17 pm

Re: to Nages: test for tdatabase

Post by Silvio.Falconi »

the tax office will take care of sending the daily fees directly to the Revenue Agency
ci penserà il registratore di cassa fiscale a inviare direttamente all'agenzia delle Entrate i corrispettivi giornalieri
Das Finanzamt sorgt dafür, dass die täglichen Gebühren direkt an die Finanzbehörde gesendet werden
La oficina de impuestos se encargará de enviar las tarifas diarias directamente a la Agencia de Impuestos.

In my program I have two types of prints: a non-tax receipt
and then I send the client what the customer has to pay to the cash register. The cash register, as I have already said, is already prepared to send daily fees to the revenue agency for the daily fees

In meinem Programm habe ich zwei Arten von Drucken: eine nicht steuerliche Quittung
und dann sende ich dem Kunden, was der Kunde an die Kasse zahlen muss. Wie bereits gesagt, ist die Kasse bereits bereit, Tagesgebühren für die Tagesgebühren an die Finanzbehörde zu senden

En mi programa tengo dos tipos de impresiones: un recibo no tributario
y luego le envío al cliente lo que el cliente tiene que pagar a la caja registradora. La caja registradora, como ya he dicho, ya está preparada para enviar tarifas diarias a la agencia de ingresos por las tarifas diarias
I use : FiveWin for Harbour August 2020 (Revision) - Harbour 3.2.0dev (r1712141320) - Bcc7.30 - xMate ver. 1.15.3 - PellesC
User avatar
Silvio.Falconi
Posts: 4956
Joined: Thu Oct 18, 2012 7:17 pm

Re: to Nages: test for tdatabase

Post by Silvio.Falconi »

But I have to tell the truth that I find this whole system a little unpleasant, because I certainly can't use my old procedures and open files in share mode and save with lock / unlock

Making the customer archive I stopped because I don't know how to connect a customer to another archive: I have to enter the guests or family members that are hosted under the umbrella that the customer rents.

One more thing: I'd like to use a function to open archives and their indexes. For example, if in a program I only have to use a single archive in other systems, there are so many archives.

Then I have a window template with an explorer menu on the left and an xbrowse on the right and under the xbrowse a tab control where I insert the indexes.
You could not create a function that would give me the return of the archive and the loading of the its indexes in an array aIdx?

On this page I saw a function to open an archive with tdatabase http://forums.fivetechsupport.com/viewt ... 03&start=0

I used a system so long ago that it seems easier to me than James and Mr. Nages

also in this system the tdatabase class was used but the trecord was not used and there was a small class that served as trecord

I explain you the procedure give mr from Miguel_Angel_Cortés_Marchant many year ago

I tried the applicatin also on lan and it run okand it is very fast


Image

the archives are opened through this easy function

Code: Select all

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
 
the tdb class is this

Code: Select all


#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
 
there is another class ( the grandmother of trcord)

Code: Select all


#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]



to open an archive  the procedure  made

Code: Select all

METHOD New() CLASS TPaciente
   LOCAL oFont1

   ::oPaciente   := Abrir_Arc( "paciente", { "paciente" } )
   ::oPaciente:SetOrder( "NOMBRE" )
   ::oPaciente:GoTop()

to add a new customer  it made this

Code: Select all


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
to create a new code it use a function and a control.dbf

Code: Select all

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
 
the problem of this function is ( the same of james ) if I not save arecord it lose the code and the next code is ncode+1
But on this application first it use a code type 0000000001 and the the code of customer become , i not Know where,
another code for a sample "0019-04-91" I think the number of code 4 cr with the mounth and year
I use : FiveWin for Harbour August 2020 (Revision) - Harbour 3.2.0dev (r1712141320) - Bcc7.30 - xMate ver. 1.15.3 - PellesC
User avatar
James Bott
Posts: 4654
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA
Contact:

Re: to Nages: test for tdatabase

Post by James Bott »

Silvio,

>But I have to tell the truth that I find this whole system a little unpleasant, because I certainly can't use my old procedures and open files in share mode and save with lock / unlock.

Yes, it is uncomfortable to move ahead to better techniques. But the payoff is immense.

>Making the customer archive I stopped because I don't know how to connect a customer to another archive: I have to enter the guests or family members that are hosted under the umbrella that the customer rents.

This is called a one-to-many relationship. Have you never done one before? This can be built into the database class. This is one reason for making a different class for each database.

All invoice classes require at least one, one-to-many relationship. Thus you have basic info like InvNo, date, customer, and then one or more line items. The line items are stored in a different database which is automatically opened when you open the invoice object. Then you can do:

oInvoice := Tinvoice:():New( cInvno ) // Actually opens two databases and establishes relationships, with one line of code. Simple!

msgInfo( oInvoice:aLineitem[1] ) // show the first line item

You can do something similar with guests. So you will have two, one-to-many relationships.

msgInfo( oInvoice:aGuest[1] ) // show the first guest.

>One more thing: I'd like to use a function to open archives and their indexes. For example, if in a program I only have to use a single archive in other systems, there are so many archives.

This is how we used to do things 20 years ago. Unfortunately you use up lots of memory opening all the files at once and you have to keep track of workareas and database states, and all kinds of functions to manipulate the information. Using objects eliminates all that.

Then I have a window template with an explorer menu on the left and an xbrowse on the right and under the xbrowse a tab control where I insert the indexes.
You could not create a function that would give me the return of the archive and the loading of the its indexes in an array aIdx?

If you are using CDXs they are all opened automatically. And if you are using objects the database and indexes are opened automatically even if they aren’t CDXs.

>On this page I saw a function to open an archive with tdatabase http://forums.fivetechsupport.com/viewt ... 03&start=0

I used a system so long ago that it seems easier to me than James and Mr. Nages.


It only seems easier because you are used to it. But it is back to the dark ages–opening all the files at once and keeping track of workareas and database states. If you mess up tracking and restoring states then you have serious bugs which are very hard to find. With database objects all this goes away. Further you can pass entire objects around just like a single variable. It opens all kinds of new possibilities.

Regarding speed. Your old way of writing code took an order of magnitude more lines of code. Thus you can most likely reduce your code to 10 percent of the original size. These means the objects are usually much faster than procedural code.
FWH 18.05/xHarbour 1.2.3/BCC7/Windows 10
User avatar
TimStone
Posts: 2536
Joined: Fri Oct 07, 2005 1:45 pm
Location: Trabuco Canyon, CA USA
Contact:

Re: to Nages: test for tdatabase

Post by TimStone »

James,

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.

Tim
Tim Stone
http://www.MasterLinkSoftware.com
timstone@masterlinksoftware.com
Using: FWH 19.06 with Harbour 3.2.0 / Microsoft Visual Studio Community 2019
User avatar
Silvio.Falconi
Posts: 4956
Joined: Thu Oct 18, 2012 7:17 pm

Re: to Nages: test for tdatabase

Post by Silvio.Falconi »

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
I use : FiveWin for Harbour August 2020 (Revision) - Harbour 3.2.0dev (r1712141320) - Bcc7.30 - xMate ver. 1.15.3 - PellesC
User avatar
Silvio.Falconi
Posts: 4956
Joined: Thu Oct 18, 2012 7:17 pm

Re: to Nages: test for tdatabase

Post by Silvio.Falconi »

James
"That's how we did things 20 years ago .." certainly but surely that little app still runs very well and there is a dentist here in my country who is using it, of course I changed it by changing and adding something but I stayed on that system that is in the way that Miguel_Angel_Cortés_Marchant had done it

If we analyze the Tdb class it is the same Tdatabase of 2005 and Miguel_Angel_Cortés_Marchant added the class TObjDb which is a real Trecord is indeed in the methods of the Tdb we find the calls to this class

Code: Select all

    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


I think instead that the system is very simple and is similar to James's Tdata and Trecord


Of course the Tdb class still uses the listbox (wbrowse) but I think we can use the Xbrowse
I use : FiveWin for Harbour August 2020 (Revision) - Harbour 3.2.0dev (r1712141320) - Bcc7.30 - xMate ver. 1.15.3 - PellesC
User avatar
James Bott
Posts: 4654
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA
Contact:

Re: to Nages: test for tdatabase

Post by James Bott »

Silvio,

Code: Select all

oGuest: = tdatabase():New(......
oGuest: SetScope (0, oClienti:IdCliente)
oGuest: SetScope (1, oClientiIdCliente)
oGuest: Gotop ()
Objects can contain other objects.

First, make an oGuests (plural since it is a table) class, instead of using TDatabase directly. There are good reasons for doing this that we have discussed in the past. Then you can just do:

oInvoice := TInvoice():New( cInvNo )

Then you should make "oGuests" data of the TInvoice class. Now you can use it anywhere in the class as ::oGuests. And outside the invoice object too.

msgInfo( oInvoice:oGuests:name ) // shows the first guest

Now you will be able to just use it in your Print() method. And you will be able to use it in your invoice edit function.

Also, don't forget to close the oGuests object in the invoice class End() method.
FWH 18.05/xHarbour 1.2.3/BCC7/Windows 10
User avatar
James Bott
Posts: 4654
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA
Contact:

Re: to Nages: test for tdatabase

Post by James Bott »

Tim,
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.
Is that all inside your invoice class?
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.
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.

Scopes are much faster and even a SEEK then DO WHILE is about the same speed. Again, are you doing this inside the invoice object?

James
FWH 18.05/xHarbour 1.2.3/BCC7/Windows 10
User avatar
nageswaragunupudi
Posts: 8017
Joined: Sun Nov 19, 2006 5:22 am
Location: India
Contact:

Re: to Nages: test for tdatabase

Post by nageswaragunupudi »

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
Use scoped relations.

There have been a lot of improvements
Regards

G. N. Rao.
Hyderabad, India
User avatar
TimStone
Posts: 2536
Joined: Fri Oct 07, 2005 1:45 pm
Location: Trabuco Canyon, CA USA
Contact:

Re: to Nages: test for tdatabase

Post by TimStone »

James,

I use "workorders" to create estimates, invoices, counter sales, and technician worksheets. To open a workorder, I use this call:

Code: Select all

 oWorkorder := TWorkorder():New( cWorkID )
WIthin that method, everything is handled. Each workorder has a unique ID, and that is used to link everthing to it, except customers are linked by their ID, and the serviced item by it's unique ID.

Everything is on one screen with folders which are automatically loaded with the appropriate data for speed. The Parts folder displays all the data in it's upper half, which is connected to the browse in the
lower half. The parts data is called with:

Code: Select all

   ::oWorkParts := TWorkParts():New( ::oCurrentOrder:wrkord )
 
The other databases are opened as objects also. When opening the parts object, speed is important, so instead of filter, the Method automatically uses the scope so only the parts for that workorder are displayed:

Code: Select all

Method New( cWrkOrd ) CLASS TWorkParts //Data
   ::super():new(,"eprpar")
   if ::use()
      ::setOrder( 1 )
          ::setscopetop( cWrkord )
          ::setscopebottom( cWrkord )
      ::gotop()
   endif   
Return self
 
Of course there are many other processes that take place, and they are also optimized as Methods within the Workorder class.  In one case, I found that I was using 5 different functions, in various places, when calculating totals.  Thus, if I changed something in one, I had to modify the other 4 also, or have a calculation error.  After working through this, I now have 1 totals method that applies everywhere, and a change in it will always work wherever it is applied.

Also, one word of caution:  We often use :: to reference the object but this can sometimes result in conflicts with other classes.  

Code: Select all

A simple code:
   ::InvoiceNo:WorkDate
within a method would be better as:
 LOCAL oOrder := self
 oOrder:InvoiceNo:WorkDate
 
This sample designates the date field for a workorder.

Of course the beauty of this is I can have multiple workorders open on various computers, or even the same one on multiple computers.  All record locking is automatic and we never have data conflicts.

Finally, I use a dialog where all of the data fields are displayed ( edited ) in the upper half of the dialog, and the browse displays in the lower half.  Thus when I'm moving up and down, the data in the upper half must be refreshed with the browse record in focus.  When I open the parts database, for example, I also open tRecord for the part in focus, and it will fill all the fields appropriately.  The data is all in buffers, and is only written back to the actual database with the Save() method.  Thus system crashes, data entry errors, etc. are not a problem because the values are not committed to the database unless that button is pushed.  The other advantage is that the display links to the data in the record buttons, so it's simple to handle updating as the browse is scrolled.

Code: Select all

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()
 
The amount of code saved is awesome.
Tim Stone
http://www.MasterLinkSoftware.com
timstone@masterlinksoftware.com
Using: FWH 19.06 with Harbour 3.2.0 / Microsoft Visual Studio Community 2019
User avatar
nageswaragunupudi
Posts: 8017
Joined: Sun Nov 19, 2006 5:22 am
Location: India
Contact:

Re: to Nages: test for tdatabase

Post by nageswaragunupudi »

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.
This was a very old story till Foxpro introduced rush-more technology many many years ago. SIX and Loadstone's bitmapped filter technology brought fast filters for Clipper. Later Nantucket bought the technology from Loadstone and adopted for DBFCDX in Clipper 5.3. That is what we have now with (x)Harbour.

Filters are optimized using indexes and only the required records (not the entire database) are read from the server.

But to use this effectively, the programmer should first know that there is this kind of optimization available and then should understand how the optimization works and then should plan the indexes and construct the filter expressions to take full advantage of this optimization.
Regards

G. N. Rao.
Hyderabad, India
User avatar
James Bott
Posts: 4654
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA
Contact:

Re: to Nages: test for tdatabase

Post by James Bott »

Nages,
Filters are optimized using indexes and only the required records (not the entire database) are read from the server.
Hmm, I haven't used filters in many years. Are you saying that they are now as fast as scopes?

James
FWH 18.05/xHarbour 1.2.3/BCC7/Windows 10
User avatar
James Bott
Posts: 4654
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA
Contact:

Re: to Nages: test for tdatabase

Post by James Bott »

Tim,
Also, one word of caution: We often use :: to reference the object but this can sometimes result in conflicts with other classes.
Hmm, I have never experienced this. Can you provide an example?

James
FWH 18.05/xHarbour 1.2.3/BCC7/Windows 10
Post Reply