I have implemented your requirements. This is the program to test.
Code: Select all
#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
//----------------------------------------------------------------------------//
This approach has the same cons as discussed above, i.e., the IDs generated may not be ascending the chronological order and some IDs in the serial may be missing.
However, the fields RowID (autoincrement), CreateDt, UpdateDt, which are internal to the dbf and not displayed to the user, are in chronologically serial order and are evidence of the genuineness of data.
Please delete any tables like "sclients.*" created by the previous sample, before testing this program