Code: Select all
function New( cAlias, cFileName )
local oDlg, oGet, oBrw, oBtn, cTitle, cNewAlias, oBrwNew, lCopy := .F.
local cFieldName := Space( 10 ), cType := "Character", nLen := 10, nDec := 0
local aFields := { Array( 4 ) }, cDbfName := Space( 8 ), aTemp
local oLen, oDec, aType := { "AutoIncr", "Character", "Number", "Date", "Logical", "Memo", "ModTime" }
local bChange := {|| If( cType == "AutoIncr", ( nLen := 4, nDec := 0, oDec:Disable() ),),;
If( cType == "Character", ( nLen := 10, nDec := 0, oDec:Disable() ),),;
If( cType == "Number", ( nLen := 10, nDec := 0, oDec:Enable() ),),;
If( cType == "Date", ( nLen := 8, nDec := 0, oDec:Disable() ),),;
If( cType == "Logical", ( nLen := 1, nDec := 0, oDec:Disable() ),),;
If( cType == "Memo", ( nLen := 10, nDec := 0, oDec:Disable() ),),;
If( cType == "ModTime", ( nLen := 8, nDec := 0, oDec:Disable() ),),;
oDlg:Update() }
local bEdit := {|| IF ( !Empty (aFields[1,1]) ,;
(oBtn:Enable (),;
cFieldName := aFields[oBrw:nArrayAt,1] ,;
cType := aFields[oBrw:nArrayAt,2] ,;
cType := aType[ aScan(aType, {|x| Left(x,1) = cType} )],;
Eval (bChange) ,;
nLen := aFields[oBrw:nArrayAt,3] ,;
nDec := aFields[oBrw:nArrayAt,4] ,;
oGet:SetPos( 0 ),;
oGet:SetFocus(),;
oDlg:Update() ) ,) ;
}
local bSave := { || oBtn:Disable (),;
aFields[ oBrw:nArrayAt, 1 ] := cFieldname,;
aFields[ oBrw:nArrayAt, 2 ] := if( Left( cType, 1 ) = "A", "+", Left( cType, 1 ) ), ;
aFields[ oBrw:nArrayAt, 2 ] := if( Left( cType, 3 ) = "Mod", "=", Left( cType, 1 ) ), ;
aFields[ oBrw:nArrayAt, 3 ] := nLen,;
aFields[ oBrw:nArrayAt, 4 ] := nDec,;
oBrw:SetArray( aFields ),;
cFieldName := Space( 10 ),;
Eval( bChange ) ,;
oDlg:Update() ,;
oGet:SetPos( 0 ),;
oGet:SetFocus(),;
oBrw:GoBottom();
}
if ! Empty( cAlias )
aFields = ( cAlias )->( DbStruct() )
cTitle = FWString( "Modify DBF structure" )
else
cTitle = FWString( "DBF builder" )
endif
DEFINE DIALOG oDlg TITLE cTitle SIZE 415, 500
@ 0.5, 2 SAY FWString( "Field Name" ) OF oDlg SIZE 40, 8
@ 0.5, 10 SAY FWString( "Type" ) OF oDlg SIZE 40, 8
@ 0.5, 17 SAY FWString( "Len" ) OF oDlg SIZE 40, 8
@ 0.5, 22 SAY FWString( "Dec" ) OF oDlg SIZE 20, 8
@ 1.4, 1 GET oGet VAR cFieldName PICTURE "!!!!!!!!!!" OF oDlg SIZE 41, 11 UPDATE
@ 1.3, 6.5 COMBOBOX cType ITEMS aType ;
OF oDlg ON CHANGE Eval (bChange) UPDATE
@ 1.4, 11.9 GET oLen VAR nLen PICTURE "999" OF oDlg SIZE 25, 11 UPDATE
@ 1.4, 15.4 GET oDec VAR nDec PICTURE "999" OF oDlg SIZE 25, 11 UPDATE
@ 0.9, 26 BUTTON FWString( "&Add" ) OF oDlg SIZE 45, 13 ;
ACTION AddField( @aFields, @cFieldName, @cType, @nLen, @nDec, oGet, oBrw )
@ 2.4, 26 BUTTON oBtn PROMPT FWString( "&Edit" ) OF oDlg SIZE 45, 13 ;
ACTION Eval (bSave)
@ 3.4, 26 BUTTON FWString( "&Delete" ) OF oDlg SIZE 45, 13 ;
ACTION DelField( @aFields, @cFieldName, oGet, oBrw )
@ 4.4, 26 BUTTON FWString( "Move &Up" ) OF oDlg SIZE 45, 13 ;
ACTION If( oBrw:nArrayAt > 1,;
( aTemp := aFields[ oBrw:nArrayAt ],;
aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt - 1 ],;
aFields[ oBrw:nArrayAt - 1 ] := aTemp,;
oBrw:GoUp() ),)
@ 5.4, 26 BUTTON FWString( "Move D&own" ) OF oDlg SIZE 45, 13 ;
ACTION If( oBrw:nArrayAt < Len( aFields ),;
( aTemp := aFields[ oBrw:nArrayAt ],;
aFields[ oBrw:nArrayAt ] := aFields[ oBrw:nArrayAt + 1 ],;
aFields[ oBrw:nArrayAt + 1 ] := aTemp,;
oBrw:GoDown() ),)
@ 11.8, 26 BUTTON FWString( "&Cancel" ) OF oDlg SIZE 45, 13 ;
ACTION oDlg:End()
@ 2.0, 1.8 SAY "Struct" OF oDlg SIZE 40, 8
@ 3.0, 1 XBROWSE oBrw ARRAY aFields AUTOCOLS NOBORDER STYLE FLAT ;
HEADERS FWString( "Name" ), FWString( "Type" ), FWString( "Len" ),;
FWString( "Dec" ) ;
COLSIZES 90, 55, 40, 40 ;
SIZE 138, 183 OF oDlg ;
ON DBLCLICK Eval (bEdit)
StyleBrowse( oBrw )
if lPijama
oBrw:bClrStd := { || If( oBrw:KeyNo() % 2 == 0, ;
{ CLR_BLACK, RGB( 198, 255, 198 ) }, ;
{ CLR_BLACK, RGB( 232, 255, 232 ) } ) }
oBrw:bClrSel := { || { CLR_WHITE, RGB( 0x33, 0x66, 0xCC ) } }
else
oBrw:bClrStd := { || { nClrTxtBrw, nClrBackBrw } }
oBrw:bClrSel := { || { nClrBackBrw, RGB( 0x33, 0x66, 0xCC ) } }
endif
oBrw:CreateFromCode()
@ 15.3, 1.4 SAY FWString( "DBF Name:" ) OF oDlg SIZE 40, 8
if ! Empty( cAlias )
cDbfName = cGetNewAlias( cAlias )
endif
@ 17.7, 6 GET cDbfName PICTURE "!!!!!!!!!!!!" OF oDlg SIZE 100, 11
@ 12.8, 26 BUTTON If( Empty( cAlias ), FWString( "&Create" ), FWString( "&Save" ) ) ;
OF oDlg SIZE 45, 13 ;
ACTION ( If( ! Empty( cDbfName ) .and. Len( aFields ) > 0,;
DbCreate( AllTrim( cDbfName ), aFields ),), oDlg:End(),;
lCopy := .T.,;
oBrwNew := Open( hb_CurDrive() + ":\" + CurDir() + "\" + AllTrim( cDbfName ) ) )
ACTIVATE DIALOG oDlg CENTERED ;
ON INIT ( Eval ( bChange ), oBtn:Disable() ) ;
VALID ! GETKEYSTATE( VK_ESCAPE )
if ! Empty( cAlias ) .and. lCopy
APPEND FROM ( cFileName )
oBrwNew:Refresh()
endif
return nil
//----------------------------------------------------------------------------//
function AddField( aFields, cFieldName, cType, nLen, nDec, oGet, oBrw )
local cSymbol := ""
if Empty( cFieldName )
oGet:SetPos( 0 )
return nil
endif
/* Harbour extended field types https://vivaclipper.wordpress.com/2012/ ... n-harbour/ */
if Upper( Left( cType, 1 ) ) = "A"
cType := "+"
elseif cType == "ModTime"
cType := "="
else
cType := Upper( Left( cType, 1 ) )
endif
if Len( aFields ) == 1 .and. Empty( aFields[ 1 ][ 1 ] )
aFields = { { cFieldName, cType, nLen, nDec } }
else
AAdd( aFields, { cFieldName, cType, nLen, nDec } )
endif
oBrw:SetArray( aFields )
oGet:VarPut( cFieldName := Space( 10 ) )
oGet:SetPos( 0 )
oGet:SetFocus()
oBrw:GoBottom()
return nil
//----------------------------------------------------------------------------//