I want a extra item(field) on a Xbrowse. I'm browsing a dbf, but showing the structure and not the data. After selecting one line, I want to color that line so I know that I've used it.
I believe i've seen a sample where there is a temporary field to do this.
When I add a field to the database, it is not usable, since i don't browse the data, but the fieldnames.
In the code the function MASTER is where the browse is located.
- Code: Select all Expand view
#include "FiveWin.ch"
#include "report.ch"
#include "hbcompat.ch"
#include 'ord.ch'
#include "XBrowse.Ch"
#include "fileio.ch"
REQUEST DBFCDX
#define WID 600
#define HGT 350
FUNCTION Main
RDDSetDefault( "DBFCDX" )
set( 4, "mm/dd/yyyy" )
set( 5, 1930 )
SET DATE BRITISH
set deleted on
SetHandleCount( 100 )
setkey( VK_F12,{|| Dbfsopen() } )
SET 3DLOOK ON
DEFINE BRUSH oBrush STYLE TILED // FiveWin new predefined Brushes
DEFINE WINDOW oWnd TITLE "F A C T U M A T" MENU BuildMenu() BRUSH oBrush
DEFINE BUTTONBAR oBar OF oWnd
DEFINE FONT oDlFont NAME 'Courier New' SIZE 8,15
SET MESSAGE OF oWnd TO "Version 22.10.16 : "
ACTIVATE WINDOW oWnd MAXIMIZED
oWnd:end()
oFont:end()
//oInitrep:end()
dbcloseall()
//freelibrary(hBor)
//SET RESOURCES TO
return nil
function BuildMenu()
//Local aMenu:= validMenu()
local oMenu
MENU oMenu
MENUITEM "&Csv Transform" ACTION csvtransform()
MENUITEM "&Mapping data" action master()
ENDMENU
return oMenu
function csvtransform()
LOCAL hCsv, cLine, aLine, nI := 0,aFiles[ADIR("*.csv")]
ADIR("*.csv", aFiles)
nFile = msglist(aFiles )
cFile = aFiles[nFile]
cDbf = STRTRAN(cFile, ".csv", ".dbf")
// Calculate the max field lengt
// Caution : If there are CDX-files, dbf ceation will faile !! erase them first of code it...
IF ( hCsv := fOpen( cFile , 16 ) ) > 0
HB_FReadLine( hCsv, @cLine, chr( 10 ) )
aHeader = strtoarr(cLine)
nlenarray = len(aHeader)
aFieldcount = array(nLenarray)
afill(aFieldcount,1)
nTester = 1
nTeller = 1
WHILE HB_FReadLine( hCsv, @cLine, chr( 10 ) ) == 0
// oWnd:SetMsg( "Process data "+str(nTeller++)) // Show progress, but slows down on large files
FOR I := 1 TO nLenarray
//cLine := subStr( cLine, at( ["], cLine ) + 1 )
//cStr = subStr( cLine, 1, at( ["], cLine ) - 1 )
//nlengte = len(alltrim(cStr))
if I < nLenarray
cStr = subStr( cLine, 1, at( [,], cLine ) - 1 )
cStr = STRTRAN(cStr, '"', '')
else
cStr = STRTRAN(cLine, '"', '')
endif
nlengte = len(cStr)
if aFieldcount[ I ] < nLengte
afieldcount[i] = nLengte
endif
cLine := subStr( cLine, at( [,], cLine ) + 1 )
//cLine := subStr( cLine, at( ["], cLine ) + 1 )
NEXT
ENDDO
builddbf(aHeader,aFieldcount,cDbf)
fClose( hCsv )
ELSE
alert( "BAD LUCK" )
return
ENDIF
fClose( hCsv )
close all
// fill de database
USE &cDbf NEW EXCL ALIAS HUNT
IF ( hCsv := fOpen( cFile, 16 ) ) > 0
WHILE HB_FReadLine( hCsv, @cLine, chr( 10 ) ) == 0
//oWnd:SetMsg( "Process data "+str(nTeller--)) // Show progress, but slows down on large files
nI ++
IF nI > 1
hunt->( dbAppend() )
FillFields( cLine )
ENDIF
ENDDO
fClose( hCsv )
alert( str( nI ) )
ELSE
alert( "BAD LUCK 2" )
return
ENDIF
xbrowse()
close all
RETURN NIL
STATIC FUNCTION FillFields( cLine )
LOCAL nJ
nMax = hunt->( fCount() )
FOR nJ := 1 TO nMax
//cLine := subStr( cLine, at( ["], cLine ) + 1 )
//hunt->( FieldPut( nJ, subStr( cLine, 1, at( ["], cLine ) - 1 ) ) )
//cLine := subStr( cLine, at( ["], cLine ) + 1 )
if nJ < nMax
cStr = subStr( cLine, 1, at( [,], cLine ) - 1 )
cStr = STRTRAN(cStr, '"', '')
hunt->( FieldPut( nJ, cStr ))
cLine := subStr( cLine, at( [,], cLine ) + 1 )
else
cStr = STRTRAN(cLine, '"', '')
hunt->( FieldPut( nJ, cStr )) // Process last item, regel
endif
NEXT
RETURN NIL
function strtoArr(cMaat)
Local aTemp:={}
if !empty(cMaat)
do while at(",",cMaat) > 0
AADD(aTemp,substr(cMaat,1,at(",",cMaat)-1))
cMaat = substr(cMaat,at(",",cMaat)+1)
enddo
AADD(aTemp,alltrim(cMaat))
endif
return aTemp
function Builddbf(adata,Alengte,cDbf)
LOCAL aStru := {}
// msginfo(atostr(adata))
for i = 1 to len(adata)
cField = STRTRAN(aData[i], '"', '')
aAdd( aStru, { cField , "C", alengte[i]+1 , 0 } )
next
dbCreate( cDbf , aStru )
return
Static Function AToStr( aArray )
Local cStr := "", nI, nLen := Len( aArray )
For nI := 1 To nLen
cStr += AllTrim( aArray[nI] ) + If( nI < nLen, ", ", "" )
Next
Return cStr
function show_data(cDbf)
USE &cDbf NEW EXCL ALIAS DATA
xbrowse()
close all
return
Function XbrShowSizes( oBrw )
XBrowse( ArrTranspose( { oBrw:cHeaders, oBrw:nWidths } ), nil, nil, { |o| o:cHeaders := { "Header", "Width" } } )
return nil
function DbfsOpen()
Local aLocal := {}
for n = 1 to 255
if ! Empty( Alias( n ) )
AADD( aLocal,Str( n, 3 ) + ": " + If( Select() == n,"=> ", " " ) + PadR( Alias( n ), 15 ) )
endif
for j = 1 to 15
if ! Empty( ( Alias( n ) )->( IndexKey( j ) ) )
AADD( aLocal," "+ ( Alias( n ) )->( OrdName( j ) ) +" -> "+ PadR( ( Alias( n ) )->( IndexKey( j ) ), 35 ) )
endif
next
next
cTemp = MsgSelect( aLocal )
sysrefresh()
return
function MsgSelect( aItems, cValue, cTitle )
local oDlg
DEFINE FONT oFont NAME "Courier New" SIZE 8,15
DEFAULT cTitle := "Maak uw keuze"
DEFINE DIALOG oDlg FROM 5,10 TO 24, 95 font oFont TITLE cTitle
@ 1, 2 LISTBOX cValue ITEMS aItems SIZE 305, 110 OF oDlg
@ 7, 05 BUTTON "&OK" OF oDlg SIZE 40, 12 ACTION oDlg:End() DEFAULT
@ 7, 12 BUTTON "&Cancel" OF oDlg SIZE 40, 12 ACTION ( cValue := "", oDlg:End() )
ACTIVATE DIALOG oDlg CENTERED
return cValue
static function ValidProdID( oGet, oCol )
local nVal := oGet:VarGet()
if .not. PRD->( DBSEEK( nVal ) )
PRD->( DBSEEK( nVal, .t. ) )
oGet:cText := oCol:Value
oCol:lRunBtnAction := .t.
endif
return .t.
//----------------------------------------------------------------------------//
static function ProductSelect( nCode )
local nSelect
local oDlg, oBrw, oFont
DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
DEFINE DIALOG oDlg SIZE 400,500 PIXEL FONT oFont TITLE "PRODUCTS"
@ 30,10 XBROWSE oBrw SIZE -10,-30 PIXEL OF oDlg ;
DATASOURCE "PRD" ;
COLUMNS "ID","veld","string","Select" ;
CELL LINES NOBORDER AUTOSORT ;
COLSIZES 50,100,100,40 ;
// oBrw:aCols[2]:bClrStd := { || IF( PRD->select , { CLR_BLACK,CLR_WHITE } , { CLR_HRED,CLR_WHITE } ) }
oBrw:aCols[2]:bClrStd := { || IF( PRD->select , { CLR_WHITE,CLR_HRED } , { CLR_BLACK,CLR_WHITE } ) }
WITH OBJECT oBrw
:bLDblClick := { || nSelect := PRD->veld, oDlg:End() }
:bKeyChar := { |nKey| If( nKey == VK_RETURN, ;
( nSelect := PRD->veld, oDlg:End() ), nil ) }
//
:CreateFromCode()
END
//@ 230,150 BUTTON "Select" SIZE 40,14 PIXEL OF oDlg ACTION ( nSelect := PRD->veld, oDlg:End() )
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
PRD->select = .t.
return nSelect
//----------------------------------------------------------------------------//
static function CalcRow( oBrw )
oBrw:Amount:VarPut( oBrw:Quantity:Value * oBrw:Price:Value )
return nil
function buildmasterdbf()
aStruct := {}
AADD(aStruct, { "ID" , "C", 35, 0 }) // Id
AADD(aStruct, { "Aktief" , "C", 35, 0 }) // Aktief (0/1)
AADD(aStruct, { "Naam" , "C", 35, 0 }) // Naam *
AADD(aStruct, { "Cat_main", "C", 35, 0 }) // Categorieën (x,y,z...)
AADD(aStruct, { "Cat_Sub1", "C", 35, 0 }) // Categorieën (x,y,z...)
AADD(aStruct, { "Prijs" , "C", 35, 0 }) // Prijs excl. Btw of Prijs incl. Btw
AADD(aStruct, { "Tax" , "C", 35, 0 }) // Tax rules id // NO USED
AADD(aStruct, { "gr_prijs", "C", 35, 0 }) // Groothandelsprijs // NOT
AADD(aStruct, { "offer" , "C", 35, 0 }) // Aanbieding (0/1) // NOT
AADD(aStruct, { "dis_val" , "C", 35, 0 }) // Discount amount // NOT
AADD(aStruct, { "dis_per" , "C", 35, 0 }) // Discount percent // NOT
AADD(aStruct, { "dis_from", "C", 35, 0 }) // Discount from (yyyy-mm-dd) // NOT
AADD(aStruct, { "dis_to ", "C", 35, 0 }) // Discount to (yyyy-mm-dd) // NOT
AADD(aStruct, { "Art_Code", "C", 35, 0 }) // Referentie
AADD(aStruct, { "Art_Lev" , "C", 35, 0 }) // Referentie leverancier
AADD(aStruct, { "Leveranc", "C", 35, 0 }) // Leverancier // NOT
AADD(aStruct, { "Fabrikan", "C", 35, 0 }) // Fabrikant
AADD(aStruct, { "Ean" , "C", 35, 0 }) // EAN13 // NOT
AADD(aStruct, { "Upc" , "C", 35, 0 }) // UPC // NOT
AADD(aStruct, { "Milieu" , "C", 35, 0 }) // Milieuheffing // NOT
AADD(aStruct, { "Gewicht" , "C", 35, 0 }) // Gewicht // NOT
AADD(aStruct, { "Aantal" , "C", 35, 0 }) // Aantal
AADD(aStruct, { "Kort_txt", "C", 35, 0 }) // Korte omschrijving
AADD(aStruct, { "Memo" , "C", 35, 0 }) // Omschrijving
AADD(aStruct, { "Tags" , "C", 35, 0 }) // Tags (x,y,z...)
AADD(aStruct, { "Meta_tit", "C", 35, 0 }) // Meta titel
AADD(aStruct, { "Meta_zoe", "C", 35, 0 }) // Meta zoekwoorden
AADD(aStruct, { "Meta_inf", "C", 35, 0 }) // Meta omschrijving
AADD(aStruct, { "Url_rewr", "C", 35, 0 }) // URL rewritten
AADD(aStruct, { "Msg_sto" , "C", 35, 0 }) // Bericht indien op voorraad
AADD(aStruct, { "Msg_nsto", "C", 35, 0 }) // Bericht indien niet op voorraad
AADD(aStruct, { "Url_pic" , "C", 35, 0 }) // URLs afbeelding (x,y,z...)
AADD(aStruct, { "Optie" , "C", 35, 0 }) // 1= foto wissen bij upload
AADD(aStruct, { "Beschikb", "C", 35, 0 }) // Only available online
AADD(aStruct, { "Kleur" , "C", 35, 0 }) // Only available online
AADD(aStruct, { "Size" , "C", 35, 0 }) // Only available online
AADD(aStruct, { "Struct" , "C", 35, 0 }) // Only available online
DbCreate( "master.dbf", aStruct)
use master NEW
append blank
replace master->id with "5101000"
replace master->aktief with "1"
replace master->naam with "The Name of the artikel"
replace master->cat_main with "Main Menu"
replace master->cat_Sub1 with "Sub Menu"
// All fields in order to give a sample of the data needed
adbf := {}
AADD(adbf, { "ID" , "N", 3, 0 }) // Id
AADD(adbf, { "Veld" , "C", 50, 0 }) // Aktief (0/1)
AADD(adbf, { "string" , "C", 50, 0 }) // Naam *
AADD(adbf, { "select" , "L", 1, 0 }) // Naam *
DbCreate( "struct.dbf", adbf)
use struct NEW
close all
return
FUNCTION master()
local oDlg, oData, oStru, oFont, aDbf[ADIR("*.dbf")]
Buildmasterdbf() // only for testing.
// Select a random dbf to Map/link to the master
ADIR("*.dbf", aDbf)
nFile = msglist(aDbf )
cDbf = aDbf[nFile]
USE struct new ALIAS PRD
USE master NEW ALIAS MASTER
if Select( "MASTER" ) == 0
MsgStop( "Can not open MasterFile.DBF" )
return 1
endif
USE &cDbf NEW ALIAS CUST
if Select( "CUST" ) == 0
MsgStop( "Can not open File.DBF" )
return 1
endif
dbselectarea("CUST")
for i = 1 to CUST->(FCOUNT())
PRD->(dbappend())
replace PRD->id with i
replace PRD->veld with Fieldname(i) // len en valtype
next
DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-12
DEFINE DIALOG oDlg SIZE 2*WID,2*HGT PIXEL FONT oFont
@ 10,10 XBROWSE oData SIZE 200,320 PIXEL OF oDlg ;
DATASOURCE MASTER->( DbStruct() ) ;
COLUMNS 1, ;
{ |x| If( x == nil, MASTER->( FieldGet( oData:nArrayAt ) ), ;
MASTER->( If( DbRLock(), ( FieldPut( oData:nArrayAt, x ), DbRUnLock() ), nil ) ) ) } ;
HEADERS "FldName","FieldValue" ;
COLSIZES 120,250 ;
AUTOCOLS CELL LINES
@ 10,220 XBROWSE oStru SIZE -10,-10 PIXEL OF oDlg ;
DATASOURCE CUST->( DbStruct() ) ;
COLUMNS 1,2,3,4, ;
{ |x| If( x == nil, CUST->( FieldGet( oStru:nArrayAt ) ), ;
CUST->( If( DbRLock(), ( FieldPut( oStru:nArrayAt, x ), DbRUnLock() ), nil ) ) ) } ;
HEADERS "FldName","Typ","Len","Dec", "FieldValue" ;
COLSIZES 120,40,40,40,400 ;
AUTOCOLS CELL LINES
WITH OBJECT oData
WITH OBJECT :oCol( 2 )
:nEditType := EDIT_GET_BUTTON
:bClrSel := { || { CLR_BLACK, CLR_HGRAY }}
//:bEditValid := { |oGet| ValidProdID( oGet, oBrw:oCol( 1 ) ) }
:bEditBlock := { |r,c,oCol| ProductSelect( oCol:Value ) }
:bOnChange := { |oCol,uOldVal| oData:FieldValue:VarPut( PRD->VELD ) }
ENDWITH
:bClrEdits := { || { CLR_BLACK, CLR_YELLOW }}
:bClrRowFocus := { || { CLR_BLACK, RGB(185,220,255) } }
:CreateFromCode()
END
WITH OBJECT oStru
:bClrSel := { || { CLR_BLACK, CLR_HGRAY }}
// :bChange := { || oData:SelectCol( oData:ColPos( oData:oCol( oStru:nArrayAt ) ), .t. ) }
// :nStretchCol := 5
//
WITH OBJECT :aCols[ 5 ]
//:nEditType := EDIT_GET
:bClrEdit := { || { CLR_BLACK, CLR_YELLOW }}
//:bOnChange := { || oData:RefreshCurrent() }
END
//
:CreateFromCode()
END
@ 205,350 BUTTON "Close" SIZE 40,14 PIXEL OF oDlg ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
close all
return 0
