Code: Select all
#include "fivewin.ch"
REQUEST DBFCDX
static cPath // give here your path
//----------------------------------------------------------------------------//
function Main()
local oClients
DEFAULT cPath := cFilePath( ExeName() )
CreateDBF()
oClients := TClients():New()
BrowseClients()
return nil
//----------------------------------------------------------------------------//
function BrowseClients()
local oClients
local oDlg, oFont, oBrw
oClients := TClients():New()
DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
DEFINE DIALOG oDlg SIZE 500,500 PIXEL TRUEPIXEL FONT oFont
@ 60,20 XBROWSE oBrw SIZE -20,-20 PIXEL OF oDlg ;
DATASOURCE oClients AUTOCOLS ;
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 "Delete" SIZE 100,35 PIXEL OF oDlg FLAT ;
ACTION oBrw:Delete()
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
oClients:Close()
return nil
//----------------------------------------------------------------------------//
CLASS TClients FROM TDatabase
DATA oControl
METHOD New() CONSTRUCTOR
METHOD NextID() INLINE STRZERO( ::oControl:NextVal(), 4 )
METHOD ResetID( nID ) INLINE ::oControl:Reset( nID )
METHOD Close() INLINE ( ::oControl:Close(), ::Super:Close() )
METHOD EditDlg( oRec )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New() CLASS TClients
::Super:Open( , cPath + "SCLIENTS.DBF", "DBFCDX", .T. )
::oControl := IDControl():New()
::bEdit := { |oRec| ::EditDlg( oRec ) }
return Self
//----------------------------------------------------------------------------//
METHOD EditDlg( oRec ) CLASS TClients
local oSelf := Self
local oDlg, oFont, nID
local lExit := .f.
DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
DEFINE DIALOG oDlg SIZE 500,220 PIXEL TRUEPIXEL FONT oFont ;
TITLE If( oRec:RecNo == 0, "NEW CLIENT", "EDIT CLIENT" )
If oRec:RecNo == 0
nID := ::NextID()
oRec:SetDefault( "ID", nID )
endif
@ 40, 40 SAY "ID :" GET oRec:ID SIZE 300,26 PIXEL OF oDlg READONLY
@ 70, 40 SAY "Name :" GET oRec:Name SIZE 300,26 PIXEL OF oDlg
@ 100, 40 SAY "City :" GET oRec:City SIZE 300,26 PIXEL OF oDlg
@ 150, 40 BTNBMP PROMPT "SAVE" SIZE 100,35 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
ACTION ( oRec:Save(), lExit := .t., oDlg:End() )
@ 150,200 BTNBMP PROMPT "CANCEL" SIZE 100,35 PIXEL OF oDlg FLAT ;
ACTION ( If( oRec:RecNo == 0, oSelf:ResetID( Val( oRec:ID ) ), ), ;
lExit := .t., oDlg:End() )
ACTIVATE DIALOG oDlg CENTERED VALID ( lExit )
RELEASE FONT oFont
return nil
//----------------------------------------------------------------------------//
CLASS IDControl FROM TDatabase
METHOD New() CONSTRUCTOR
METHOD NextVal()
METHOD Reset( nId )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New() CLASS IDControl
::Super:Open( , cPath + "CONTROL.DBF", "DBFCDX", .T. )
return Self
//----------------------------------------------------------------------------//
METHOD NextVal() CLASS IDControl
field ID, 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
ID := ID + 1
nRet := ID
endif
DBCOMMIT()
return nRet
>
do while .not. ::RecLock()
enddo
nID := ::Exec( bAction )
::Unlock()
::Load()
return nID
//----------------------------------------------------------------------------//
METHOD Reset( nID ) CLASS IDControl
field ID, UNUSED
local bAction
bAction := <||
local a
if nID == ID
ID := ID - 1
else
a := UNUSED
AAdd( a, nID )
UNUSED := a
endif
DBCOMMIT()
return nil
>
do while .not. ::RecLock()
enddo
::Exec( bAction )
::Unlock()
::Load()
return nil
//----------------------------------------------------------------------------//
function CreateDBF()
if !File( cPath + "CONTROL.DBF" )
DBCREATE( cPath + "CONTROL.DBF", { ;
{ "ID", "N", 4, 0 }, ;
{ "UNUSED", "M",10, 0 } }, ;
"DBFCDX", .T., "CTR" )
DBAPPEND()
FIELD->ID := 0
FIELD->UNUSED := {}
CLOSE CTR
endif
if !File( cPath + "SCLIENTS.DBF" )
DBCREATE( cPath + "SCLIENTS.DBF", { ;
{ "ID", "C", 4, 0 }, ;
{ "NAME", "C",20, 0 }, ;
{ "CITY", "C",20, 0 } }, ;
"DBFCDX", .T., "SD" )
FW_CdxCreate()
CLOSE SD
endif
return nil
//----------------------------------------------------------------------------//
Mr. Silvio
Please test this sample.
This displays the ID for new record. It is guaranteed that no other user will save a record with the same ID.
If you like this approach, you may adopt to your situation.
If you do not like, ignore this.