METHOD Duplicate(oClients) CLASS TClients
Local oClienteTemp := oClients:Record()
Local oClienteNew
oClienteTemp:Copy()
oClienteNew := oClients:Record( , .t. )
oClienteNew:Paste()
oClienteNew:Edit()
return nil
I suppose ID’s are the same as account numbers. In many cases they are just a field for quick connection of data and I’m not sure why chronological order would be of any value.
However, with invoices, you certainly want them in the exact order created.
I use a Counters.dbf that has one record and it contains the latest assigned number in fields for each ID assigned ( ie. Workorder/Invoice, customer number, accounting, etc ). Since I have classes for each process like work orders, my Add() method appends a record, fills the buffers with blanks, then goes to the counter dbf, increments the proper number, saves the value back to the record, and saves it to the appended record. The interaction with the counters file takes a fraction of a second and that is never an issue in multi-user environments.
nageswaragunupudi wrote:Dear Friend Silvio
The inherent problem in this approach is that the IDs are not chronologically in ascending order and there can be gaps in the serial order.
In case of invoices, invoice numbers not being in serial order would be highly objectionable. Some programmer friends even felt that such database may be viewed with suspicion by tax authorities.
You were always insisting on displaying the next serial number in the append dialog. None of us can guess what exactly will be the next serial number in chronological order when the new record is saved in a multi-user environment. This can be known only when the new record is appended.
I remember very well that you refused all advices in this regard. Even at the risk of you blaming me also, I would reuest you once again re-consider your insistence to display the next serial in the append dialog even before saving it.
Silvio.Falconi wrote:First of all I have to specify one thing:
For the management of customers, the system (the test) that Rao did as well for other archives is fine for me.
the only thing I asked for was to use only a control.dbf file for all the archives and to have different types of lengths for example 4-digit customers, 10-digit orders
Silvio.Falconi wrote:Nages
on the test I add a new Method to duplicate a record ( seem run ok)
#include "fivewin.ch"
REQUEST DBFCDX
static cPath // give here your path
static l3BtnStyle := .t.
//----------------------------------------------------------------------------//
function Main()
DEFAULT cPath := cFilePath( ExeName() )
TClients():New():Browse():Close()
TItems():New():Browse():Close()
// View Raw Tables
SET DELETED OFF
XBROWSER cPath + "SCLIENTS.DBF"
XBROWSER cPath + "SITEMS.DBF"
return nil
//----------------------------------------------------------------------------//
INIT PROCEDURE PrgInit
RDDSETDEFAULT( "DBFCDX" )
SET DELETED ON
SET DATE ITALIAN
SET CENTURY ON
SET TIME FORMAT TO "HH:MM:SS"
FWNumFormat( "E", .t. )
SetGetColorFocus()
return
//----------------------------------------------------------------------------//
//----------------------------------------------------------------------------//
// TCLIENTS CLASS DERIVED FROM TDATASEQ in TSEQ.PRG
//----------------------------------------------------------------------------//
CLASS TClients FROM TDataSEQ
METHOD New() CONSTRUCTOR
METHOD Browse()
METHOD EditDlg( oRec )
METHOD ValidRec( oRec )
METHOD CreateDBF( cName )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New() CLASS TClients
local cDBF := cPath + "SCLIENTS.DBF"
if !File( cDbf ); ::CreateDBF( cDbf ); endif
::Super:New( cDBF, "CLIENTID" ) // dbfName, KeyField
return Self
//----------------------------------------------------------------------------//
METHOD Browse() CLASS TClients
local oSelf := Self
local oDlg, oFont, oBrw, oRec
DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
DEFINE DIALOG oDlg SIZE 700,500 PIXEL TRUEPIXEL FONT oFont TITLE "Clients"
@ 60,20 XBROWSE oBrw SIZE -20,-20 PIXEL OF oDlg DATASOURCE Self ;
COLUMNS "ClientID", "First", "Last", "City" CELL LINES NOBORDER
oBrw:CreateFromCode()
@ 20, 20 BTNBMP PROMPT "New" SIZE 100,35 PIXEL OF oDlg FLAT ACTION oBrw:EditSource( .T. )
@ 20,140 BTNBMP PROMPT "Edit" SIZE 100,35 PIXEL OF oDlg FLAT ACTION oBrw:EditSource()
@ 20,260 BTNBMP PROMPT "Duplicate" SIZE 100,35 PIXEL OF oDlg FLAT ;
ACTION ( oRec := oSelf:Record( .t. ), ;
oRec:Paste( oSelf:Record() ), ;
oRec:oBrw := oBrw, ;
oRec:Edit() )
@ 20,380 BTNBMP PROMPT "Delete" SIZE 100,35 PIXEL OF oDlg FLAT ACTION oBrw:Delete()
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
return Self
//----------------------------------------------------------------------------//
METHOD EditDlg( oRec ) CLASS TClients
local oSelf := Self
local oDlg, oFont, oBmp, oBmp3, nID
local lExit := .f.
oRec:bValid := { |o| oSelf:ValidRec( o ) }
DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
DEFINE DIALOG oDlg SIZE 400,240 PIXEL TRUEPIXEL FONT oFont ;
TITLE If( oRec:RecNo == 0, "NEW CLIENT", "EDIT CLIENT" )
@ 40, 40 SAY "ClientID :" GET oRec:ClientID SIZE 300,26 PIXEL OF oDlg UPDATE READONLY
@ 70, 40 SAY "First :" GET oRec:First SIZE 300,26 PIXEL OF oDlg UPDATE
@ 100, 40 SAY "Last :" GET oRec:Last SIZE 300,26 PIXEL OF oDlg UPDATE
@ 130, 40 SAY "City :" GET oRec:City SIZE 300,26 PIXEL OF oDlg UPDATE
if l3BtnStyle
@ 180, 40 BTNBMP oBmp PROMPT "SAVE" SIZE 090,30 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
ACTION ( oRec:Save( .t. ), oDlg:Update() )
@ 180,150 BTNBMP oBmp PROMPT "UNDO" SIZE 090,30 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
ACTION ( oRec:Undo(), oDlg:Update() )
@ 180,260 BTNBMP oBmp3 PROMPT { || If( oRec:Modified, "CANCEL", "CLOSE" ) } ;
SIZE 090,30 PIXEL OF oDlg FLAT UPDATE ;
WHEN ( oBmp3:Refresh(), .t. ) ;
ACTION ( If( oRec:RecNo == 0, oSelf:ResetID( Val( oRec:ClientID ) ), ), ;
lExit := .t., oDlg:End() )
oBmp:lCancel := .t.
else
@ 180, 40 BTNBMP oBmp PROMPT "SAVE" SIZE 100,35 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
ACTION If( oRec:Save( .t. ), ( lExit := .t., oDlg:End() ), nil )
@ 180,260 BTNBMP oBmp PROMPT "CANCEL" SIZE 100,35 PIXEL OF oDlg FLAT ;
ACTION ( If( oRec:RecNo == 0, oSelf:ResetID( Val( oRec:ClientID ) ), ), ;
lExit := .t., oDlg:End() )
oBmp:lCancel := .t.
endif
ACTIVATE DIALOG oDlg CENTERED VALID ( lExit )
RELEASE FONT oFont
return nil
//----------------------------------------------------------------------------//
METHOD ValidRec( oRec ) CLASS TClients
if Empty( oRec:First ) .or. Empty( oRec:Last ) .or. Empty( oRec:City )
MsgAlert( "First, Last, City can not be empty", "INVALID RECORD" )
return .f.
endif
return ::UniqueValue( oRec:First -"|"- oRec:Last, "FIRSTLAST", oRec:RecNo, .t. )
//----------------------------------------------------------------------------//
METHOD CreateDBF( cName ) CLASS TClients
field FIRST,LAST
local aStruct := { ;
{ "ROWID", "+", 6, 0 }, ;
{ "CREATEDT", "T", 8, 0 }, ;
{ "UPDATEDT", "=", 8, 0 }, ;
{ "CLIENTID", "C", 4, 0 }, ;
{ "FIRST", "C",20, 0 }, ;
{ "LAST", "C",20, 0 }, ;
{ "CITY", "C",20, 0 } }
DBCREATE( cName, aStruct, "DBFCDX", .T., "SD" )
FW_CdxCreate()
INDEX ON UPPER( FIRST-"|"-LAST ) TAG FIRSTLAST
CLOSE SD
return nil
//----------------------------------------------------------------------------//
// TITEMS CLASS DERIVED FROM TDATASEQ in TSEQ.PRG
//----------------------------------------------------------------------------//
CLASS TItems FROM TDataSEQ
METHOD New() CONSTRUCTOR
METHOD Browse()
METHOD EditDlg( oRec )
METHOD ValidRec( oRec )
METHOD CreateDBF( cName )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New() CLASS TItems
local cDBF := cPath + "SITEMS.DBF"
if !File( cDbf ); ::CreateDBF( cDbf ); endif
::Super:New( cDBF, "ITEMID" ) // DbfName, KeyField
return Self
//----------------------------------------------------------------------------//
METHOD Browse() CLASS TItems
local oSelf := Self
local oDlg, oFont, oBrw, oRec
DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
DEFINE DIALOG oDlg SIZE 700,500 PIXEL TRUEPIXEL FONT oFont ;
TITLE "Items"
@ 60,20 XBROWSE oBrw SIZE -20,-20 PIXEL OF oDlg ;
DATASOURCE Self COLUMNS "ItemID", "ItemName", "Rate", "VAT" ;
CELL LINES NOBORDER FASTEDIT
oBrw:CreateFromCode()
@ 20, 20 BTNBMP PROMPT "New" SIZE 100,35 PIXEL OF oDlg FLAT ACTION oBrw:EditSource( .T. )
@ 20,140 BTNBMP PROMPT "Edit" SIZE 100,35 PIXEL OF oDlg FLAT ACTION oBrw:EditSource()
@ 20,260 BTNBMP PROMPT "Duplicate" SIZE 100,35 PIXEL OF oDlg FLAT ;
ACTION ( oRec := oSelf:Record( .t. ), ;
oRec:Paste( oSelf:Record() ), ;
oRec:oBrw := oBrw, ;
oRec:Edit() )
@ 20,380 BTNBMP PROMPT "Delete" SIZE 100,35 PIXEL OF oDlg FLAT ACTION oBrw:Delete()
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
return Self
//----------------------------------------------------------------------------//
METHOD EditDlg( oRec ) CLASS TItems
local oSelf := Self
local oDlg, oFont, oBmp, oBmp3, nID
local lExit := .f.
oRec:bValid := { |o| oSelf:ValidRec( o ) }
DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
DEFINE DIALOG oDlg SIZE 400,240 PIXEL TRUEPIXEL FONT oFont ;
TITLE If( oRec:RecNo == 0, "NEW CLIENT", "EDIT CLIENT" )
@ 40, 40 SAY "ItemID :" GET oRec:ItemID SIZE 300,26 PIXEL OF oDlg UPDATE READONLY
@ 70, 40 SAY "ItemName :" GET oRec:ItemName SIZE 300,26 PIXEL OF oDlg UPDATE ;
VALID ::UniqueValue( oRec:ItemName, "ITEMNAME", oRec:RecNo, .t. )
@ 100, 40 SAY "Rate :" GET oRec:Rate SIZE 300,26 PIXEL OF oDlg UPDATE ;
PICTURE "@E 99,999.99" RIGHT VALID oRec:Rate > 0.0
@ 130, 40 SAY "VAT % :" GET oRec:Vat SIZE 300,26 PIXEL OF oDlg UPDATE ;
PICTURE "@E 99.99 %" RIGHT VALID oRec:Vat >= 0.0
if l3BtnStyle
@ 180, 40 BTNBMP oBmp PROMPT "SAVE" SIZE 090,30 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
ACTION ( oRec:Save( .t. ), oDlg:Update() )
@ 180,150 BTNBMP oBmp PROMPT "UNDO" SIZE 090,30 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
ACTION ( oRec:Undo(), oDlg:Update() )
@ 180,260 BTNBMP oBmp3 PROMPT { || If( oRec:Modified, "CANCEL", "CLOSE" ) } ;
SIZE 090,30 PIXEL OF oDlg FLAT UPDATE ;
WHEN ( oBmp3:Refresh(), .t. ) ;
ACTION ( If( oRec:RecNo == 0, oSelf:ResetID( Val( oRec:ItemID ) ), ), ;
lExit := .t., oDlg:End() )
oBmp:lCancel := .t.
else
@ 180, 40 BTNBMP oBmp PROMPT "SAVE" SIZE 100,35 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
ACTION If( oRec:Save( .t. ), ( lExit := .t., oDlg:End() ), nil )
@ 180,260 BTNBMP oBmp PROMPT "CANCEL" SIZE 100,35 PIXEL OF oDlg FLAT ;
ACTION ( If( oRec:RecNo == 0, oSelf:ResetID( Val( oRec:ItemID ) ), ), ;
lExit := .t., oDlg:End() )
oBmp:lCancel := .t.
endif
ACTIVATE DIALOG oDlg CENTERED VALID ( lExit )
RELEASE FONT oFont
return nil
//----------------------------------------------------------------------------//
METHOD ValidRec( oRec ) CLASS TItems
if Empty( oRec:ItemName ) .or. Empty( oRec:Rate )
MsgAlert( "ItemName, Rate can not be empty", "INVALID RECORD" )
return .f.
endif
return ::UniqueValue( oRec:ItemName, "ITEMNAME", oRec:RecNo, .t. )
//----------------------------------------------------------------------------//
METHOD CreateDBF( cName ) CLASS TItems
field FIRST,LAST
DBCREATE( cName, { ;
{ "ROWID", "+", 6, 0 }, ;
{ "CREATEDT", "T", 8, 0 }, ;
{ "UPDATEDT", "=", 8, 0 }, ;
{ "ITEMID", "C", 8, 0 }, ;
{ "ITEMNAME", "C",20, 0 }, ;
{ "RATE", "N", 8, 2 }, ;
{ "VAT", "N", 5, 2 } }, ;
"DBFCDX", .T., "SD" )
FW_CdxCreate()
CLOSE SD
return nil
//----------------------------------------------------------------------------//
//----------------------------------------------------------------------------//
// TDATASEQ CLASS: Derive classes for tables from this class
//----------------------------------------------------------------------------//
CLASS TDataSEQ FROM TDatabase
DATA oSequenza
DATA cKeyFld, nKeyLen
METHOD New( cDbf, cKeyFld ) CONSTRUCTOR
METHOD Browse() INLINE XBrowse( Self )
METHOD EditDlg( oRec )
METHOD NextID() INLINE STRZERO( ::oSequenza:NextVal(), ::nKeyLen )
METHOD ResetID( nID ) INLINE ::oSequenza:Reset( nID )
METHOD Record()
METHOD UniqueValue( uValue, cOrder, nRec, lMsg )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( cDbf, cKeyFld ) CLASS TDataSEQ
field CREATEDT, UPDATEDT
::Super:Open( , cDbf, "DBFCDX", .T. )
::cKeyFld := cKeyFld
::nKeyLen := ::FieldLen( ::FieldPos( ::cKeyFld ) )
::oSequenza := TSequenze():New( ::cFile )
::bEdit := { |oRec| ::EditDlg( oRec ) }
if ::FieldPos( "CREATEDT" ) > 0 .and. ::FieldPos( "UPDATEDT" ) > 0
::bTrigger := { || If( Empty( CREATEDT ), CREATEDT := UPDATEDT, nil ) }
endif
return Self
//----------------------------------------------------------------------------//
METHOD Record( cFieldList, lNew ) CLASS TDataSEQ
local oRec, cID, n
if HB_ISLOGICAL( cFieldList )
lNew := cFieldList
cFieldList := nil
endif
oRec := TDataRow():New( Self, cFieldList, lNew )
WITH OBJECT oRec
:lNavigate := .f.
:bEdit := ::bEdit
if lNew == .t.
cID := ::NextID()
:SetDefault( ::cKeyFld, cID, .f. )
:aOrg[ :FieldPos( ::cKeyFld ), 2 ] := cID
endif
:FieldReadOnly( ::cKeyFld, .t. )
END
return oRec
//----------------------------------------------------------------------------//
METHOD UniqueValue( uValue, cOrder, nRec, lMsg ) CLASS TDataSEQ
local cSaveOrd := ::OrdSetFocus()
local nSaveRec := ::RecNo()
local cFoundID := ""
local nFoundAt := 0
local lUnique := .f.
local c
DEFAULT nRec := nSaveRec, lMsg := .f.
::SetOrder( cOrder )
if HB_ISCHAR( C := ::OrdKeyVal() )
uValue := PadR( cValToChar( uValue ), Len( c ) )
if "UPPER" $ ::OrdKey()
uValue := Upper( uValue )
endif
endif
if ::Seek( uValue )
nFoundAt := ::RecNo()
cFoundID := ::FieldGet( ::cKeyFld )
endif
::OrdSetFocus( If( Empty( cSaveOrd ), 0, cSaveOrd ) )
::GoTo( nSaveRec )
lUnique := ( nFoundAt == 0 .or. nFoundAt == nRec )
if lMsg .and. !lUnique
MsgAlert( cFoundID + " has the same value" + CRLF + ;
cValToChar( uValue ) , "DUPLICATE" )
endif
return lUnique
//----------------------------------------------------------------------------//
METHOD EditDlg( oRec ) CLASS TDataSEQ
oRec:Edit()
return nil
//----------------------------------------------------------------------------//
// TSEQUENZE CLASS
//----------------------------------------------------------------------------//
CLASS TSequenze FROM TDatabase
METHOD New( cDbf ) CONSTRUCTOR
METHOD NextVal()
METHOD Reset( nId )
METHOD CreateSEQDBF( cPath )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( cDbf ) CLASS TSequenze
local cPath := cFilePath( cDbf )
local cName := Upper( cFileNoExt( cDbf ) )
local cSeqDbf := cPath + "SEQUENZE.DBF"
local cFilter := 'TRIM( FIELD->DBF ) == "' + cName + '"'
if !File( cSeqDbf )
::CreateSEQDBF( cSeqDbf )
endif
::Super:Open( , cSeqDbf, "DBFCDX", .T. )
::SetFilter( cFilter )
::GoTop()
if ::Eof()
// ::Append( "DBF,COUNTER,UNUSED", { cName, 0, {} } )
//
::Append( "DBF,COUNTER", { cName, 0 } )
::RecLock()
( ::cAlias )->UNUSED := {}
::Skip( 0 )
::RecUnlock()
//
::GoTop()
endif
return Self
//----------------------------------------------------------------------------//
METHOD NextVal() CLASS TSequenze
field COUNTER, UNUSED
local nID, bAction
bAction := <||
local a := UNUSED
local nRet
if !Empty( a )
nRet := ATail( a )
a := ASize( a, Len( a ) - 1 )
UNUSED := a
else
COUNTER := COUNTER + 1
nRet := COUNTER
endif
DBCOMMIT()
return nRet
>
do while .not. ::RecLock()
enddo
nID := ::Exec( bAction )
::Unlock()
::Load()
return nID
//----------------------------------------------------------------------------//
METHOD Reset( nID ) CLASS TSequenze
field COUNTER, UNUSED
local bAction
bAction := <||
local a
if nID == COUNTER
COUNTER := COUNTER - 1
elseif nID < COUNTER
a := UNUSED
AAdd( a, nID )
UNUSED := a
endif
DBCOMMIT()
return nil
>
do while .not. ::RecLock()
enddo
::Exec( bAction )
::Unlock()
::Load()
return nil
//----------------------------------------------------------------------------//
METHOD CreateSEQDBF( cName ) CLASS TSequenze
DBCREATE( cName, { ;
{ "DBF", "C", 20, 0 }, ;
{ "COUNTER", "N", 10, 0 }, ;
{ "UNUSED", "M", 10, 0 } }, ;
"DBFCDX" )
return nil
//----------------------------------------------------------------------------//
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 23 guests