// Exemplos no FiveWin Brasil:
/*
http://fivewin.com.br/index.php?/topic/ ... resolvido/
http://fivewin.com.br/index.php?/topic/ ... resolvido/
*/
// By Manuel Mercado
#include "FiveWin.ch"
#include "TSBrowse.CH"
//#include "TSButton.CH"
#define CLR_HBROWN nRGB( 205, 192, 176 )
REQUEST DBFCDX
STATIC oWnd, aRedir, nFrom, nDest
//--------------------------------------------------------------------------------------------------------------------//
Function Main()
Local oMenu, oIco
SET DATE BRITISH
SET EPOCH TO Year( Date() ) - 70
MENU oMenu
MENUITEM "Archivo"
MENU
MENUITEM "Create &Excel Sheet" ACTION fExcelDbf( ,, .F.)
MENUITEM "Create &Database" ACTION fExcelDbf()
MENUITEM "E&xit" ACTION oWnd:End()
ENDMENU
MENUITEM "E&xit" ACTION oWnd:End()
ENDMENU
DEFINE WINDOW oWnd MENU oMenu TITLE "From Excel To Dbf or Visceversa"
ACTIVATE WINDOW oWnd MAXIMIZED ON INIT fExcelDbf()
Return Nil
//--------------------------------------------------------------------------------------------------------------------//
Function fExcelDbf( cXls, cDbf, lXls )
Local oDlg, aCtl[ 9 ], lActivate, oFont, nVer, ;
nAvance := 0
Default cXls := Padr( "Libro1.xls", 60 ), ;
cDbf := Padr( "Base1.dbf", 60 ), ;
lXls := .T.
nVer := If( lXls, 1, 2 )
lActivate := lXls
DEFINE FONT oFont NAME "MS Sans Serif" SIZE 0, -11
DEFINE DIALOG oDlg FROM 0, 0 TO 202, 380 PIXEL FONT oFont ;
COLORS CLR_BLACK, CLR_HBROWN ;
TITLE "Excel/Database/Excel"
oDlg:nStyle := nOr( oDlg:nStyle, 4 )
@ 11, 6 SAY aCtl[ 1 ] PROMPT "Database" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_BLACK, CLR_HBROWN SIZE 39, 9 PIXEL
@ 11, 45 GET aCtl[ 2 ] VAR cDbf OF oDlg SIZE 141, 10 PIXEL COLOR CLR_BLACK, CLR_WHITE FONT oFont ;
ACTION ( cDbf := PadR( cGetFileName( .F. ), 60 ), aCtl[ 2 ]:Refresh() ) Bitmap "Find16"
@ 27, 6 SAY aCtl[ 3 ] PROMPT "Excel File" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_BLACK, CLR_HBROWN SIZE 39, 9 PIXEL
@ 27, 45 GET aCtl[ 4 ] VAR cXls OF oDlg SIZE 141, 10 PIXEL COLOR CLR_BLACK, CLR_WHITE FONT oFont ;
ACTION ( cXls := PadR( cGetFileName(), 60 ), aCtl[ 4 ]:Refresh() ) Bitmap "Find16"
@ 43, 31 CheckBox aCtl[ 5 ] VAR lActivate OF oDlg ;
PROMPT "Abrir Excel" FONT oFont UPDATE SIZE 50, 16 PIXEL
@ 39, 82 Radio aCtl[ 6 ] Var nVer PROMPT "Xls/Dbf", "Dbf/Xls" Of oDlg Size 200, 10 Pixel
// ALIGN DT_CENTER ;
// COLORS CLR_BLACK, CLR_HBROWN, CLR_WHITE, CLR_GRAY, ;
// CLR_BLACK
@ 66, 36 BUTTON aCtl[ 7 ] PROMPT "&Ok" OF oDlg ;
ACTION ( If( nVer == 1, fXls2Dbf( cXls, cDbf, aCtl[ 9 ] ), ;
fDbf2Xls( cXls, cDbf, aCtl[ 9 ], lActivate ) ), oDlg:End() ) ;
FONT oFont SIZE 38, 12 PIXEL
@66, 99 BUTTON aCtl[ 8 ] PROMPT "&Exit" OF oDlg ;
ACTION oDlg:End() ;
FONT oFont SIZE 38, 12 PIXEL
@ 86, 6 METER aCtl[ 9 ] VAR nAvance OF oDlg TOTAL 100 ;
PROMPT "Avance" SIZE 178, 12 PIXEL FONT oFont ;
COLORS CLR_HBROWN, CLR_BLACK ;
BARCOLOR CLR_HBLUE, CLR_YELLOW
ACTIVATE DIALOG oDlg CENTERED VALID ( oFont:End(), .T. )
Return Nil
//--------------------------------------------------------------------------------------------------------------------//
Static Function fXls2Dbf( cXls, cDbf, oMtr, nTitRow, nDatRow )
Local oExcel, oSheet, nRows, nCols, nRow, nCol, uData, nEle, nStep, ;
nAvance := 0, ;
aCampos := {}
Default aRedir := {}
If Empty( cXls )
Return Nil
EndIf
CursorWait()
cXls := UppCap( StrTran( Upper( AllTrim( cXls ) ), ".XLS" ) + ".XLS" )
Default cDbf := UppCap( StrTran( Upper( cXls ), ".XLS" ) ), ;
nTitRow := 1, ;
nDatRow := 2
If ! File( Lfn2Sfn( cXls ) )
CursorArrow()
MsgStop( "Unexist File", cXls )
Return Nil
EndIf
oExcel := TOleAuto():New( "Excel.Application" )
oExcel:WorkBooks:Open( cXls )
oSheet := oExcel:Get( "ActiveSheet" )
nRows := oSheet:UsedRange:Rows:Count()
nCols := oSheet:UsedRange:Columns:Count()
oMtr:cText := "Creando Base de Datos"
oMtr:nTotal := nCols + ( nCols * nRows )
oMtr:Set( nAvance )
oMtr:Refresh()
nStep := Max( 1, Int( oMtr:nTotal * .03 ) )
For nCol := 1 To nCols
If ValType( oSheet:Cells( nDatRow, nCol ):Value ) = "C"
AAdd( aCampos, { PadR( oSheet:Cells( nTitRow, nCol ):Value, 10 ), "C", 80, 0 } )
ElseIf ValType( oSheet:Cells( nDatRow, nCol ):Value ) = "N"
AADD( aCampos, { PadR( oSheet:Cells( nTitRow, nCol ):Value, 10 ), "N", 13, 0 } )
ElseIf ValType( oSheet:Cells( nDatRow, nCol ):Value ) = "L"
AADD( aCampos, { PadR( oSheet:Cells( nTitRow, nCol ):Value, 10 ), "L", 1, 0 } )
ElseIf ValType( oSheet:Cells( nDatRow, nCol ):Value ) = "D"
AADD( aCampos, { PadR( oSheet:Cells( nTitRow, nCol ):Value, 10 ), "D", 8, 0 } )
Else
AADD( aCampos, { PadR( oSheet:Cells( nTitRow, nCol ):Value, 10 ), "C", 80, 0 } )
ENDIf
oMtr:Set( ++ nAvance )
SysRefresh()
Next
CursorArrow()
If Empty( aCampos := aEditCampos( aCampos, cDbf ) )
oExcel:Quit()
Return Nil
EndIf
CursorWait()
For nRow := 1 To Len( aCampos )
Next
DbCreate( cDbf, aCampos )
Use ( cDbf ) New
For nRow := nDatRow To nRows
APPEND BLANK
For nCol := 1 To nCols
uData := oSheet:Cells( nRow, nCol ):Value
nEle := aRedir[ AScan( aRedir, {|e| e[ 1 ] == nCol } ), 2 ]
If aCampos[ nEle, 2 ] == "C"
If ValType( uData ) == "N"
uData := Mask( uData,,, .F., .F., .F. )
Else
uData := VtoC( uData )
EndIf
ElseIf aCampos[ nEle, 2 ] == "N"
uData := VtoN( uData )
ElseIf aCampos[ nEle, 2 ] == "D"
uData := CtoD( VtoC( uData ) )
EndIf
FieldPut( nEle, uData )
If ( ++ nAvance % nStep ) == 0
oMtr:Set( nAvance )
EndIf
SysRefresh()
Next
Next
DbCloseArea()
oExcel:Quit()
oMtr:Set( oMtr:nTotal )
oMtr:Refresh()
CursorArrow()
Return Nil
//--------------------------------------------------------------------------------------------------------------------//
Static Function fDbf2Xls( cXls, cDbf, oMtr, lActivate, cInd, cDrv, cTitle )
Local oExcel, oSheet, oClip, oRange, nCol, cLet, nTotCol, nTotRow, nAvance, uData, ;
nRow := 1, ;
aCol := { 26, 52, 78, 104, 130, 156 }, ;
aLet := { "", "A", "B", "C", "D", "E" }, ;
lCdx := .F., ;
cText := ""
If Empty( cDbf )
Return Nil
EndIf
CursorWait()
cDbf := AllTrim( StrTran( Upper( cDbf ), ".DBF" ) )
cDbf += ".DBF"
cInd := If( Empty( cInd ), "", AllTrim( Upper( cInd ) ) )
If ! Empty( cInd )
If At( ".", cInd ) > 0
lCdx := "CDX" $ cInd
ElseIf File( cInd + ".CDX" )
lCdx := .T.
EndIf
EndIf
Default cDrv := If( lCdx, "DBFCDX", "DBFNTX" )
If ! File( Lfn2Sfn( cDbf ) )
CursorArrow()
MsgStop( "No Existe el Archivo", cDbf )
Return Nil
EndIf
If ! Empty( cInd )
Use cDbf Shared New VIA cDrv
Set Index To ( cInd )
Else
Use ( cDbf ) Shared New VIA cDrv
EndIf
nTotRow := If( ! Empty( cInd ) .and. lCdx, OrdKeyCount(), LastRec() )
nTotCol := Min( Fcount(), 156 )
If Empty( nTotRow )
DbCloseArea()
CursorArrow()
MsgStop( "Base de datos vacía", "Error" )
Return Nil
EndIf
oMtr:cText := "Creando hoja de Excel"
oMtr:nTotal := nTotRow + nTotCol
oMtr:Set( nAvance := 0 )
oMtr:Refresh()
oExcel := TOleAuto():New( "Excel.Application" )
oExcel:WorkBooks:Add()
oSheet := oExcel:Get( "ActiveSheet" )
cLet := aLet[ AScan( aCol, {|e| nTotCol <= e } ) ]
If ! Empty( cLet )
nEle := AScan( aLet, cLet ) - 1
cLet += Chr( 64 + nTotCol - aCol[ Max( 1, nEle ) ] )
Else
cLet := Chr( 64 + nTotCol )
EndIf
If ! Empty( cTitle )
cText += cTitle + Chr( 13 )
EndIf
For nCol := 1 To nTotCol
cText += UppCap( FieldName( nCol ) ) + Chr( 9 )
nAvance ++
oMtr:Set( nAvance )
SysRefresh()
Next
cText += Chr( 13 )
DbGoTop()
nStart := nRow := 1
While ! EoF()
For nCol := 1 To nTotCol
uData := FieldGet( nCol )
uData := If( ValType( uData )=="D", DtoC( uData ), If( ValType( uData )=="N", Str( uData ) , ;
If( ValType( uData )=="L", If( uData ,".T." ,".F." ), VtoC( uData ) ) ) )
cText += AllTrim( uData ) + Chr( 9 )
Next
cText += Chr( 13 )
nRow ++
IF Len( cText ) > 20000
oClip := TClipBoard():New()
oClip:Clear()
oClip:SetText( cText )
oRange := oSheet:Range( "A" + LTStr( nStart ) )
oRange:Select()
oSheet:Paste()
oClip:End()
cText := ""
nStart := nRow + 1
EndIf
DbSkip()
nAvance ++
oMtr:Set( nAvance )
SysRefresh()
EndDo
If ! Empty( cText )
oClip := TClipBoard():New()
oClip:Clear()
oClip:SetText( cText )
oRange := oSheet:Range( "A" + LTStr( nStart ) )
oRange:Select()
oSheet:Paste()
oClip:End()
EndIf
oSheet:Range( "A1:" + cLet + "1" ):Set( "HorizontalAlignment", 7 )
cRange := "A" + If( ! Empty( cTitle ), "3", "1" ) + ":" + cLet + LTStr( oSheet:UsedRange:Rows:Count() )
oSheet:Range( cRange ):Borders():LineStyle := 1
oSheet:Columns( "A:" + cLet ):AutoFit()
DbCloseArea()
If lActivate
oExcel:Visible := .T.
EndIf
oExcel:Quit()
oMtr:Set( oMtr:nTotal )
CursorArrow()
Return Nil
//--------------------------------------------------------------------------------------------------------------------//
Static Function aEditCampos( aCampos, cDbf )
Local oDlg, oBrw, oFont, cGet, cAnt, cSay, aCtl[ 10 ], oDrCur, nBase, nEle, ;
aDbf := aCampos, ;
lOk := .F., ;
lRenamed := .F., ;
lCopy := .F., ;
nAvance := 0, ;
aCla := { "C", "N", "D", "L", "M" }, ;
aTip := { "Alfanumérico", "Numérico", "Fecha", "Lógico", "Memo" }
aRedir := {}
cGet := cAnt := If( At( "\", cDbf ) > 0, cDbf, cFilePath( GetModuleFileName( GetInstance() ) ) + cDbf )
cSay := "Campo 1" + Space( 3 ) + Trim( aDbf[ 1, 1 ] )
For nEle := 1 To Len( aDbf )
AAdd( aRedir, { nEle, nEle } )
Next
DEFINE FONT oFont NAME "MS Sans Serif" SIZE 0, -8
DEFINE CURSOR oDrCur RESOURCE "Drag"
DEFINE DIALOG oDlg FROM 0, 0 TO 388, 380 PIXEL FONT oFont ;
STYLE nOr( WS_POPUP, WS_BORDER ) ;
COLOR CLR_BLACK, CLR_HBROWN
@ 0, 0 SAY aCtl[ 1 ] PROMPT "Crear Base de Datos" OF oDlg ;
SIZE 192, 9 PIXEL CENTER ;
COLOR CLR_WHITE, CLR_BLUE FONT oFont
@ 13, 20 Group aCtl[ 2 ] To 29, 192 OF oDlg LABEL "Guardar Como" ;
PIXEL
@ 19, 23 SAY aCtl[ 3 ] VAR cGet SIZE 142, 8 PIXEL OF oDlg BORDER
@ 51, 20 SAY aCtl[ 5 ] VAR cSay OF oDlg SIZE 148, 8 PIXEL ;
COLOR CLR_WHITE, 8323200 BORDER CENTER
@ 61, 20 BROWSE aCtl[ 6 ] ARRAY aDbf OF oDlg CELLED SIZE 148, 93 PIXEL ;
COLORS CLR_BLACK, CLR_WHITE, CLR_BLACK, CLR_HGRAY, CLR_WHITE, CLR_BLACK
aCtl[ 6 ]:bChange := { || cSay := "Campo" + Space( 1 ) + ;
LTStr( aCtl[ 6 ]:nAt ) + Space( 3 ) + ;
If( aCtl[ 6 ]:nAt > 0 .and. ;
Len( aCtl[ 6 ]:aArray ) > 0 .and. ;
! aCtl[ 6 ]:lAppendMode, ;
aCtl[ 6 ]:aArray[ aCtl[ 6 ]:nAt ][ 1 ], "" ), ;
aCtl[ 5 ]:Refresh() }
ADD COLUMN TO aCtl[ 6 ] DATA ARRAY ELM 1 TITLE "Nombre" ;
VALID { |uVar| ! Empty( uVar ) } PICTURE "@K!" ;
ALIGN DT_LEFT, DT_CENTER SIZE 80 PIXELS ;
POSTEDIT { || lRenamed := If( aCtl[ 6 ]:lChanged, .T., lRenamed ) } ;
EDITABLE MOVE DT_MOVE_RIGHT
ADD COLUMN TO aCtl[ 6 ] COMBOBOX TITLE "Tipo" ;
DATA ComboWBlock( aCtl[ 6 ], 2, 2, { aTip, aCla } ) ;
ALIGN DT_LEFT, DT_CENTER SIZE 70 PIXELS ;
EDITABLE MOVE DT_MOVE_NEXT ;
POSTEDIT { |v,o,c| c := o:aArray[ o:nAt, 2 ], o:aArray[ o:nAt, 3 ] := ;
If( c == "L", 1, If( c == "D", 8, o:aArray[ o:nAt, 3 ] ) ), ;
o:aArray[ o:nAt, 4 ] := If( c != "N", 0, o:aArray[ o:nAt, 4 ] ) }
ADD COLUMN TO aCtl[ 6 ] DATA ARRAY ELM 3 TITLE "Longitud" ;
WHEN ( aCtl[ 6 ]:aArray[ aCtl[ 6 ]:nAt, 2 ] $ "CN" ) ;
PICTURE "@K!" ALIGN DT_LEFT SIZE 55 PIXELS ;
EDITABLE MOVE DT_MOVE_NEXT
ADD COLUMN TO aCtl[ 6 ] DATA ARRAY ELM 4 TITLE "Decimales" ;
WHEN aCtl[ 6 ]:aArray[ aCtl[ 6 ]:nAt, 2 ] == "N" ;
VALID { |uVar| uVar <= 9 } ;
PICTURE "@K" ALIGN DT_RIGHT, DT_CENTER SIZE 65 PIXELS ;
EDITABLE MOVE DT_MOVE_NEXT
aCtl[ 6 ]:lNoHScroll := .T.
aCtl[ 6 ]:lNoExit := .T.
aCtl[ 6 ]:SetAppendMode( .T. )
aCtl[ 6 ]:SetDeleteMode( .T., .F. )
aCtl[ 6 ]:aDefault := { Space( 10 ), "C", 10, 0 }
aCtl[ 6 ]:bKeyDown := { |nKey| If( nKey = VK_INSERT, ( ASize( aCtl[ 6 ]:aArray, Len( aCtl[ 6 ]:aArray ) + 1 ), ;
AIns( aCtl[ 6 ]:aArray, aCtl[ 6 ]:nAt ), ;
aCtl[ 6 ]:aArray[ aCtl[ 6 ]:nAt ] := aCtl[ 6 ]:aDefault, ;
aCtl[ 6 ]:Refresh( .T. ) ), Nil ) }
aCtl[ 6 ]:oDragCursor := oDrCur
aCtl[ 6 ]:bDropOver := { |u,n| nDest := u[ 2 ]:GetTxtRow( n ), ;
fDropDrag( u[ 3 ], u[ 2 ]:GetTxtRow( n ), u[ 1 ], u[ 2 ] ) }
aCtl[ 6 ]:bDragBegin = { |nRow,nCol,nFlags,x| nFrom := x:nAt, SetDropInfo( { x:nAt, x, x:nRowPos } ) }
@158, 20 BUTTON aCtl[ 7 ] PROMPT "Crear" OF oDlg SIZE 40, 12 PIXEL ;
ACTION ( aDbf := aCtl[ 6 ]:aArray, lOk := .T., oDlg:End() )
@158,127 BUTTON aCtl[ 8 ] PROMPT "Salir" OF oDlg SIZE 40, 12 PIXEL ;
ACTION oDlg:End() CANCEL
oDlg:bGotFocus := { || aCtl[ 6 ]:SetFocus() }
ACTIVATE DIALOG oDlg CENTERED ON INIT aCtl[ 6 ]:SetFocus() ;
VALID ( oFont:End(), oDrCur:End(), .T. )
If ! lOk
aDbf := {}
EndIf
Return aDbf
//--------------------------------------------------------------------------------------------------------------------//
Static Function cGetFileName( lXls )
Default lXls := .T.
Return LongFileName( cGetFile32( If( lXls, "Libro Excel (*.xls) | *.xls", "Base de Datos (*.dbf) | *.dbf" ), ;
"Selecciona el Archivo",,, .F. ) )
//--------------------------------------------------------------------------------------------------------------------//
Static Function fDropDrag( nSourceRow, nTargetRow, nAt, oBrw )
Local aItem, nEle, nAnt, nSkip
If ! ( ValType( nSourceRow ) == "N" .and. ValType( nTargetRow ) == "N" .and. ;
nSourceRow >= 1 .and. nTargetRow >= 1 .and. nSourceRow <= Len( oBrw:aArray ) .and. ;
nTargetRow <= Len( oBrw:aArray ) )
Return Nil
EndIf
nSkip := nTargetRow - nSourceRow
If nSkip < 0
nEle := AScan( aRedir, {|e| e[ 1 ] == nAt } )
aRedir[ nEle, 2 ] := nAt + nSkip // nTargetRow
For nAnt := 1 To ( nAt - 1 )
aRedir[ nAnt, 2 ] ++
Next
Else
nEle := AScan( aRedir, {|e| e[ 1 ] == nAt } )
aRedir[ nEle, 2 ] := nTargetRow
For nAnt := Len( aRedir ) To ( nAt + 1 ) Step -1
aRedir[ nAnt, 2 ] --
Next
EndIf
aItem := AClone( oBrw:aArray[ nAt ] )
ADel( oBrw:aArray, nAt )
nAt += nSkip
AIns( oBrw:aArray, nAt )
oBrw:aArray[ nAt ] := AClone( aItem )
oBrw:Refresh()
oBrw:lHasChanged := .T.
Return Nil
//--------------------------------------------------------------------------------------------------------------------//
Function fTraMsg()
Return Nil
//--------------------------------------------------------------------------------------------------------------------//
Function fManMsg()
Return Nil
//--------------------------------------------------------------------------------------------------------------------//
Static Function LongFileName( cShName )
Local nLen, ;
cBuffer := Space( 255 ), ;
cFilNam := Space( 255 )
cShName := AllTrim( cShName )
nLen := GetFullName( cShName, 255, @cBuffer, @cFilNam )
Return UppCap( Left( cBuffer, nLen ) )
//--------------------------------------------------------------------------------------------------------------------//
DLL32 Static Function GetFullName( cFileName AS STRING, nBuffer AS LONG, @lpBuffer AS STRING, @lpFilePart AS STRING ) ;
AS LONG PASCAL FROM "GetFullPathNameA" LIB "kernel32.dll"
Function Create_Dbf(cDir)
DBCREATE(cDir+'TA',;
{{'teacher','C',024,000},;
{'Mon1','C',004,000},; // Monday
{'Mon2','C',004,000},;
{'Mon3','C',004,000},;
{'Mon4','C',004,000},;
{'Mon5','C',004,000},;
{'Mon6','C',010,000},;
{'Mon7','C',004,000},;
{'Mon8','C',004,000},;
{'Mon9','C',004,000},;
{'Mon10','C',010,000},;
{'Tue1','C',004,000},; // Tuesday
{'Tue2','C',004,000},;
{'Tue3','C',004,000},;
{'Tue4','C',004,000},;
{'Tue5','C',004,000},;
{'Tue6','C',010,000},;
{'Tue7','C',004,000},;
{'Tue8','C',004,000},;
{'Tue9','C',004,000},;
{'Tue10','C',010,000},;
{'Wed1','C',004,000},; //Wednesday
{'Wed2','C',004,000},;
{'Wed3','C',004,000},;
{'Wed4','C',004,000},;
{'Wed5','C',004,000},;
{'Wed6','C',010,000},;
{'Wed7','C',004,000},;
{'Wed8','C',004,000},;
{'Wed9','C',004,000},;
{'Wed10','C',010,000},;
{'Thu1','C',004,000},; //Thursday
{'Thu2','C',004,000},;
{'Thu3','C',004,000},;
{'Thu4','C',004,000},;
{'Thu5','C',004,000},;
{'Thu6','C',010,000},;
{'Thu7','C',004,000},;
{'Thu8','C',004,000},;
{'Thu9','C',004,000},;
{'Thu10','C',010,000},;
{'Fri1','C',004,000},; //Friday
{'Fri2','C',004,000},;
{'Fri3','C',004,000},;
{'Fri4','C',004,000},;
{'Fri5','C',004,000},;
{'Fri6','C',010,000},;
{'Fri7','C',004,000},;
{'Fri8','C',004,000},;
{'Fri9','C',004,000},;
{'Fri10','C',010,000},;
{'Sat1','C',004,000},; //Saturday
{'Sat2','C',004,000},;
{'Sat3','C',004,000},;
{'Sat4','C',004,000},;
{'Sat5','C',004,000},;
{'Sat6','C',010,000},;
{'Sat7','C',004,000},;
{'Sat8','C',004,000},;
{'Sat9','C',004,000},;
{'Sat10','C',010,000},;
{'Matter','C',020,000}}, 'DBFCDX') // Matter of teacher
close all
use &(cDir+'TA') new
select TA
if FILE(cDir+'Tabella.DBF')
delete file &(cdir+'Tabella.cdx')
append from &(cdir+'Tabella')
dbcommitall()
close all
delete file &(cdir+'Tabella.dbf')
endif
close all
rename &(cdir+'Ta.dbf') to &(cdir+'Tabella.dbf')
return nil
//---------------------------------------------------------------------------------//
dbcreate(cDir+'LZ',;
{{"prof ", "n", 3, 0},; //teacher
{"classe ", "c", 4, 0},; // class
{"aula ", "c", 4, 0},; // room
{"materia ", "n", 3, 0},; // matterof teacher
{"flag ", "c", 1, 0},; // not
{"gruppo ", "n", 3, 0},; // not
{"oreseq ", "c", 1, 0},; // not
{"gg_ora ", "c", 2, 0}, ; // - >day_hour
{"blocco ", "c", 1, 0}}, 'DBFCDX' ) // Not
#include "fivewin.ch"
#include "ord.ch"
#include "dtpicker.ch"
REQUEST HB_Lang_IT
REQUEST HB_CODEPAGE_ITWIN
REQUEST DBFCDX
REQUEST DBFFPT
EXTERNAL ORDKEYNO,ORDKEYCOUNT,ORDCREATE,ORDKEYGOTO
FUNCTION Main()
HB_LangSelect("IT")
HB_SetCodePage("ITWIN")
SET _3DLOOK ON
SET CENTURY ON
SET DATE ITALIAN
RDDSetDefault( 'DBFCDX' )
Converte_Orario()
RETURN NIL
// converte Orario.Xls to Dbf
Function Converte_Orario()
Local oRange,lOpened:=.f.
Local cDir:= ".\"
Create_Dbf(cDir)
oRange := GetExcelRange("C:\Work\Errori\xlstodbf\orario.xls" , , @lOpened)
USE tabella ALIAS TA
SELECT TA
FW_ExcelToDBF( oRange, nil, .t. )
xbrowse(oRange)
oRange := NIL
RETURN NIL
//-------------------------------------------------------------------------//
Function Create_Dbf(cDir)
DBCREATE(cDir+'TA',;
{{'teacher','C',024,000},;
{'Mon1','C',004,000},; // Monday
{'Mon2','C',004,000},;
{'Mon3','C',004,000},;
{'Mon4','C',004,000},;
{'Mon5','C',004,000},;
{'Mon6','C',010,000},;
{'Mon7','C',004,000},;
{'Mon8','C',004,000},;
{'Mon9','C',004,000},;
{'Mon10','C',010,000},;
{'Tue1','C',004,000},; // Tuesday
{'Tue2','C',004,000},;
{'Tue3','C',004,000},;
{'Tue4','C',004,000},;
{'Tue5','C',004,000},;
{'Tue6','C',010,000},;
{'Tue7','C',004,000},;
{'Tue8','C',004,000},;
{'Tue9','C',004,000},;
{'Tue10','C',010,000},;
{'Wed1','C',004,000},; //Wednesday
{'Wed2','C',004,000},;
{'Wed3','C',004,000},;
{'Wed4','C',004,000},;
{'Wed5','C',004,000},;
{'Wed6','C',010,000},;
{'Wed7','C',004,000},;
{'Wed8','C',004,000},;
{'Wed9','C',004,000},;
{'Wed10','C',010,000},;
{'Thu1','C',004,000},; //Thursday
{'Thu2','C',004,000},;
{'Thu3','C',004,000},;
{'Thu4','C',004,000},;
{'Thu5','C',004,000},;
{'Thu6','C',010,000},;
{'Thu7','C',004,000},;
{'Thu8','C',004,000},;
{'Thu9','C',004,000},;
{'Thu10','C',010,000},;
{'Fri1','C',004,000},; //Friday
{'Fri2','C',004,000},;
{'Fri3','C',004,000},;
{'Fri4','C',004,000},;
{'Fri5','C',004,000},;
{'Fri6','C',010,000},;
{'Fri7','C',004,000},;
{'Fri8','C',004,000},;
{'Fri9','C',004,000},;
{'Fri10','C',010,000},;
{'Sat1','C',004,000},; //Saturday
{'Sat2','C',004,000},;
{'Sat3','C',004,000},;
{'Sat4','C',004,000},;
{'Sat5','C',004,000},;
{'Sat6','C',010,000},;
{'Sat7','C',004,000},;
{'Sat8','C',004,000},;
{'Sat9','C',004,000},;
{'Sat10','C',010,000}}, 'DBFCDX')
close all
use &(cDir+'TA') new
select TA
if FILE(cDir+'Tabella.DBF')
delete file &(cdir+'Tabella.cdx')
append from &(cdir+'Tabella')
dbcommitall()
close all
delete file &(cdir+'Tabella.dbf')
endif
close all
rename &(cdir+'Ta.dbf') to &(cdir+'Tabella.dbf')
return nil
//---------------------------------------------------------------------------------//
dbcreate(cDir+'LZ',;
{{"prof ", "n", 3, 0},; //teacher
{"classe ", "c", 4, 0},; // class
{"aula ", "c", 4, 0},; // room
{"materia ", "n", 3, 0},; // matter of teacher
{"flag ", "c", 1, 0},; // not
{"gruppo ", "n", 3, 0},; // not
{"oreseq ", "c", 1, 0},; // not
{"gg_ora ", "c", 2, 0}, ; // - >day_hour
{"blocco ", "c", 1, 0}}, 'DBFCDX' ) // Not
the end user uses one of my programs to create teacher replacements. He must enter the time and from his schedule to create the timetable he can print it in xlx format.
FW_ExcelToDBF( oExelRange, ; // Excel Range object
[cFieldList], ; // Optional ( now we will omit this)
[lRangeHasHeaders] ) // Now set it to True
oBrw[6]:aCols[1]:bClrStd := { || IF( oRs:selection , { CLR_BLACK,CLR_HGREEN } , { CLR_HRED,CLR_WHITE } ) }
oBrw[6]:T1:bClrStd := { || showcolors(oBrw[6]:T1:Value) }
oBrw[6]:T2:bClrStd := { || showcolors(oBrw[6]:T2:Value) }
oBrw[6]:T3:bClrStd := { || showcolors(oBrw[6]:T3:Value) }
oBrw[6]:T4:bClrStd := { || showcolors(oBrw[6]:T4:Value) }
oBrw[6]:T5:bClrStd := { || showcolors(oBrw[6]:T5:Value) }
...
function showcolors(cVeld)
local cKleur:=""
local aColorPairs := { ;
{ CLR_BLACK, MY_LIGHTGREEN },; //1
{ CLR_BLACK, MY_GREEN},; //2
{ CLR_BLACK, MY_PAARS},; //3
{ CLR_BLACK, MY_LIGHTYELLOW },; //4
{ CLR_BLACK, MY_YELLOW }} //5
do case
case cVeld = "T"
cKleur = aColorPairs[2]
case cVeld = "W"
cKleur = aColorPairs[3]
case cVeld = "A"
cKleur = aColorPairs[5]
otherwise
cKleur = aColorPairs[1]
endcase
return cKleur
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 84 guests