Post by Admin on Apr 2, 2018 3:15:04 GMT -5
This code grabs a .csv file and formats a grid to display the data. It has a little command line window where you can sort, order, select sum, break sum and a few other things. It is not meant to be a spreadsheet, it simply allows you to view and analyse .csv datasets.
nomainwin
'This is a tool to present a table of data. You may order, select and sum records.
'You can edit individual fields and save or export selections. It is not a tool to
'manipulate numbers, it is a tool to review, order and query data.
'The .csv file will be analysed and opened in an array called dbf$(), parameters about the
'.csv structure are held in dbf()
'The OPEN sub will analyse the .csv, it expects a .csv with CRLF record delimiters,
'it will count the number of fields then dimension the dbf$()array using the first record
'as the column title. This is the normal format of an Excel .csv export. For best results
'ensure the title value has trailing spaces that define the field width, less two for numbering.
'In any event fields are truncated for display but enlarge for editing.
'You can OPEN the whole file or specify a maximum number of records to load, fewer will be
'loaded if there are fewer. You specify how many records to see on screen. All fields will be
'loaded initially but you may HIDE fields.
'Once loaded you can move to << FIRST, LAST >> or < PAGE > up or down by the number of
'records you have chosen to display
'You can SORT on single or multiple fields, use a comma delimited string to list field order "7"
'will sort the dbf on field 7, or "2,1" will sort on field 1 within field 2.
'You can FIND fragments in any field or a specific field using a comma delimited string. "Hello" finds
'first occurrence of "hello" in any field, "7,Hello" finds first occurrence in field 7.
'Clicking Find without changing the find string will FIND NEXT occurence.
'You can SELECT a subset on any field or on a specified field "Carl" selects the record if any fragment
'"carl" is found in any field. "7,Carl" selects only if found in field 7. You can select again within
'the selection or selecting an empty string restores all records.
'HIDE takes comma delimited list of fields to hide, an empty string restores all
'SUM sums the specified field, 7 will sum field 7 for all SELECTED records. 8,7 will sum field 8 breaking
'on field 7 and showing sub totals. You would need to SORT on field 7 for this to be effective. Once summed
'only summary records will be displayed.
'PRINT will print the current selection on display, change the size parameter if the printing is too large
'in that case increase the size.
'SAVE I am reluctant to create a save since users may corrupt data sets inadvertantly
'EXPORT will save the current selection to a new csv
'set these globals in your program
global numCol,lastRec,maxRec,dbfName$,X,W,H,wX,wY,wW,wH,fontW,fontH,printit,fName$
'dim the main arrays, these will be redimmed in the sub.
dim dbf(10,10)
dim dbf$(10,10)
'choose a .csv to open and the maximum records to bring in
filedialog "Open CSV:", "*.csv", fName$
call openDBF fName$,2000
'now call the grid sub specifying how many rows to display
'and where the record pointer starts
call grid 20,1
'thats it you have a grid tool
end
sub grid numRow,recP
TextboxColor$="yellow"
WindowWidth=wX+60
WindowHeight=numRow*fontH+150
UpperLeftX=(DisplayWidth-WindowWidth)/2
UpperLeftY=(DisplayHeight-WindowHeight)/2
Margin=25
'place a graphicbox
graphicbox #grid.g,Margin,Margin,wX+2,(numRow+1)*fontH
'set up a hidden default button
'now if enter is pressed [enterclicked] will be called
button #grid.enter,"",[enterclicked],UL,-50,-25,20,20
stylebits #grid.enter, _BS_DEFPUSHBUTTON, 0, 0, 0
'set up a hidden textbox to be relocated later
'set up another hidden text box to catch tab press
textbox #grid.txt, -100, -100, 100, 25
textbox #grid.tab, -100,-100,100,25
textbox #grid.loc, Margin,(numRow+3)*fontH,300,25
open dbfName$ for window_nf as #grid
#grid "trapclose [quitgrid]"
#grid "font courier_new 10 "
#grid.g "font courier_new 10 "
#grid.g "down;fill buttonface;flush"
#grid.g "when leftButtonUp [cellclicked]"
'get the handle of the hidden ok button
henter = hwnd(#grid.enter)
htab=hwnd(#grid.tab)
'now set up a little control window that will always be on top
WindowWidth=400
WindowHeight=110
stylebits #ctrl, 0, _WS_MAXIMIZEBOX or _WS_MINIMIZEBOX,0 or _WS_EX_TOPMOST, 0
button #ctrl.sort, "Sort", [sort],UL,120,10
button #ctrl.find,"Find", [find],UL,170,10
button #ctrl.select,"Select",[select],UL,215,10
button #ctrl.sum,"Sum",[sum],UL,280,10
button #ctrl.hide,"Hide",[hide],UL,320,10
button #ctrl.export,"Export",[export],UL 200,40
button #ctrl.print, "Print", [printit], UL, 264, 40
button #ctrl.submit, "Save", [quitgrid],UL, 320,40
button #ctrl.first, "<<",[first],UL,10,40
button #ctrl.pageup, "<",[pageup],UL,40,40
button #ctrl.pagedown, ">",[pagedown],UL,60,40
button #ctrl.last, ">>",[last],UL,85,40
textbox #ctrl.cmd, 10,10,100,25
open "DBF Control" for window_nf as #ctrl
#ctrl "trapclose [quitgrid]"
#ctrl "font courier_new 10 "
#ctrl.cmd "Rec=";maxRec
[redraw]
'delete the last segment, redraw all cells and flush
#grid.g "delsegment t"
#grid.g "backcolor buttonface ; color black"
#grid.g "place 0 0 ; boxfilled ";wX;" ";fontH
'set out the field names (record 0)
cn=1
for c=1 to numCol
if dbf(c,4)=0 then
#grid.g "place ";dbf(c,X)+6;" ";fontH-9;";|";dbf$(0,c)+" "+str$(cn)
cn=cn+1
end if
next c
'now draw the number of rows of data required starting from the current
'record pointer position
rec=recP
lastRow=numRow
for r=1 to numRow
'draw the row or not based on the records status
'record status 0=display 1=unselected 2=found record
[skip]
select case dbf$(rec,0)
case "2" 'still selected and currently the found record
#grid.g "backcolor cyan"
#grid.g "place 0 ";(r+1)*fontH;" ; boxfilled ";wX;" ";(r)*fontH
for c=1 to numCol
if dbf(c,4)=0 then
#grid.g "place ";dbf(c,X);" ";(r+1)*fontH
#grid.g "boxfilled ";dbf(c,X)+dbf(c,W);" ";(r)*fontH
#grid.g "place ";dbf(c,X)+6;" ";(r+1)*fontH-9;";|";dbf$(rec,c)
end if
next c
dbf$(rec,0)="0"
case "1" 'unselected record ignore
skip=1
case "0" 'still selected for display
#grid.g "backcolor white"
#grid.g "place 0 ";(r+1)*fontH;" ; boxfilled ";wX;" ";(r)*fontH
'#grid.g "place 0 ";(r+1)*fontH;" ; boxfilled 40 ";(r)*fontH
'#grid.g "place 6 ";(r+1)*fontH-9;";|";str$(rec)
for c=1 to numCol
if dbf(c,4)=0 then
#grid.g "place ";dbf(c,X);" ";(r+1)*fontH
#grid.g "boxfilled ";dbf(c,X)+dbf(c,W);" ";(r)*fontH
#grid.g "place ";dbf(c,X)+6;" ";(r+1)*fontH-9;";|";dbf$(rec,c)
end if
next c
'print the summation field
#grid.g "place ";wX-94;" ";(r+1)*fontH-9;";|";sum$(rec)
end select
if rec=lastRec then lastRow=r : exit for
rec=rec+1
if skip then skip=0 : goto [skip]
next r
'print blank boxes if needed
if numRow>lastRow then
for n=lastRow+1 to numRow
#grid.g "backcolor white"
#grid.g "place 0 ";(n+1)*fontH;" ; boxfilled ";wX;" ";(n)*fontH
for c=1 to numCol
if dbf(c,4)=0 then
#grid.g "place ";dbf(c,X);" ";(n+1)*fontH
#grid.g "boxfilled ";dbf(c,X)+dbf(c,W);" ";(n)*fontH
end if
next c
next
end if
#grid.loc "Record ";recP;" to ";recP+numRow-1;" of ";lastRec
#grid.g "flush t"
if printit then
'if the printing is too big set the [size] parameter something larger
'if you hide fields the printing will grow to fill the page
#grid.g "print ";wX+fontW
printit=0
end if
'now if we are editing start to repeatedly check if the user
'has moved focus by tabbing, pressing enter or
'clicking.
if editing=1 then
timer 100, [check]
wait
[check]
'check if we have lost focus
CallDLL #user32, "GetFocus", h As ulong
'if focus is not on the textbox stop edit
'move to next field if Tab pressed
if htxt<>h then
timer 0
gosub [closeclicked]
if h=htab then goto [tabclicked]
end if
end if
wait
[cellclicked]
'set an editing flag and capture cell coordinates
x=MouseX
y=MouseY
if editing then gosub [closeclicked]
'find which col was clicked
for c=1 to numCol
if dbf(c,4)=0 then
if x>dbf(c,X)and x<dbf(c,X)+dbf(c,W) then curCol=c : exit for
end if
next
'find which row we are on
curRow=int(y/fontH)
'if we are below the last record exit
if y>lastRow*fontH+fontH then editing=0 : goto [redraw]
[editit]
editing=1
'set x and y to locate and refresh the textbox at the cell location
h$="#grid.txt"
'slip the textbox left if it will be cropped off screen
tbw=max(dbf(curCol,W),len(dbf$(recP+curRow-1,curCol))*fontW)
tbx=dbf(curCol,X)+Margin+1
if tbx+tbw>wX+26 then tbx=wX-tbw+26
#h$ "!locate ";tbx;" ";curRow*fontH+fontH+1;" ";tbw;" ";fontH
#h$ dbf$(recP+curRow-1,curCol)
#h$ "!setfocus"
#grid "refresh"
htxt=hwnd(#h$)
goto [redraw]
[tabclicked]
if editing then gosub [closeclicked]
'tab to next cell
curCol=curCol+1
if curCol>numCol then curCol=1 : curRow=curRow+1
if curRow>lastRow then curCol=1 : curRow=1
goto [editit]
[enterclicked]
if editing then gosub [closeclicked]
goto [redraw]
[closeclicked]
'set the editing flag, move the textbox off screen and save the changes
timer 0
editing=0
#h$ "!locate ";-100;" ";-100;" ";dbf(curCol,W);" ";dbf(curCol,H)
#grid "refresh"
#h$ "!contents? t$"
dbf$(recP+curRow-1,curCol)=t$
return
[first]
if editing then gosub [closeclicked]
recP=1
goto [redraw]
[pagedown]
if editing then gosub [closeclicked]
recP=recP+numRow
if recP>lastRec then recP=lastRec-numRow+1
if recP<1 then recP=1
goto [redraw]
[pageup]
if editing then gosub [closeclicked]
recP=recP-numRow
if recP<1 then recP=1
goto [redraw]
[last]
if editing then gosub [closeclicked]
recP=lastRec-numRow+1
if recP<1 then recP=1
goto [redraw]
[sort]
if editing then gosub [closeclicked]
#ctrl.cmd "!contents? sort$"
if sort$<>"" then
sort$=transform$(sort$)
call qsort 1, lastRec, sort$
recP=1
#ctrl.cmd "Sorted"
end if
findString$=""
sort$=""
goto [redraw]
[find]
if editing then gosub [closeclicked]
'find fragment in any field or specified field, case insensitive
#ctrl.cmd "!contents? find$"
'find again?
if find$=findString$ then
recP=foundRec+1
else
recP=1
findString$=find$
end if
if instr(find$,",",1) then
find=val(transform$(word$(find$,1,",")))
find$=word$(find$,2,",")
end if
found=0
while found=0 and recP<=lastRec
t$=""
if find=0 then
for n = 1 to numCol
if dbf(n,4)=0 then
t$=t$+dbf$(recP,n)
end if
next
else
t$=dbf$(recP,find)
end if
found = instr(lower$(t$),lower$(find$))
recP=recP+1
wend
if recP>lastRec then
#ctrl.cmd "Not Found"
findString$=""
recP=1
else
#ctrl.cmd findString$
recP=recP-1
foundRec=recP
dbf$(recP,0)="2"
end if
goto [redraw]
[select]
if editing then gosub [closeclicked]
'selected records dbf$(n,0) marked "0", display else "1" don't
'find in any or specified column, case insensitive
#ctrl.cmd "!contents? find$"
if find$="" then
for n=1 to maxRec
dbf$(n,0)="0"
next
lastRec=maxRec
goto [redraw]
end if
if instr(find$,",",1) then
find=val(transform$(word$(find$,1,",")))
find$=word$(find$,2,",")
end if
recS=0
recP=1
while recP<=lastRec
t$=""
if find=0 then
for n = 1 to numCol
if dbf(n,4)=0 then
t$=t$+dbf$(recP,n)
end if
next
else
t$=dbf$(recP,find)
end if
if instr(lower$(t$),lower$(find$)) then
dbf$(recP,0)="0"
recS=recS+1
else
dbf$(recP,0)="1"
end if
recP=recP+1
wend
call qsort 1,lastRec,"0"
lastRec=recS
recP=1
findString$=""
sort$=""
goto [redraw]
[hide]
#ctrl.cmd "!contents? hide$"
if hide$="" then
for c=1 to numCol
dbf(c,4)=0
dbf(c,5)=c
next
else
c=1
hide$=transform$(hide$)
c$=word$(hide$,c,",")
while c$<>""
dbf(val(c$),4)=1
c=c+1
c$=word$(hide$,c,",")
wend
end if
'set the cell xyh values for included field widths
x=0
for c=1 to numCol
if dbf(c,4)=0 then
dbf(c,X)=x
dbf(c,W)=len(dbf$(0,c))*fontW+2*fontW
dbf(c,H)=fontH
x=x+dbf(c,W)
end if
wX=x+100
next
#grid.g "locate ";Margin;" ";Margin;" ";wX+2;" ";(numRow+1)*fontH
#grid "refresh"
goto [redraw]
[sum]
if editing then gosub [closeclicked]
'find column specified for summation and any break on column
sumc=0 'not summing
sumb=0 'no break
#ctrl.cmd "!contents? sum$"
if instr(sum$,",",1) then
sumc=val(transform$(word$(sum$,1,",")))
sumb=val(transform$(word$(sum$,2,",")))
else
sumc=val(sum$)
end if
'the first column is the column to sum
'the second column is the column to break on
'exit if parameters are in error
if sumc>numCol or sumb>numCol then goto [redraw]
t=0 'total
st=0 'subtotal
'if break sum then remember the starting value
if sumb then bs$=dbf$(1,sumb)
redim sum$(maxRec)
oldn=1
for n=1 to maxRec
if dbf$(n,0)="0" then
'if we are break summing
if sumb then
'if same value keep summing
'and hide the record
if bs$=dbf$(n,sumb) then
dbf$(n,0)="1"
st=st+val(dbf$(n,sumc))
oldn=n
else
'if not save the total
'save the new break value
'start counting from zero
sum$(oldn)=str$(st)
dbf$(oldn,0)="0"
dbf$(n,0)="1"
bs$=dbf$(n,sumb)
t=t+st
'st=0
oldn=n
st=val(dbf$(n,sumc))
end if
'catch the trailing records
if n=maxRec then
sum$(n)=str$(st)
t=t+st
end if
else
'simple sum everything
t=t+val(dbf$(n,sumc))
sum$(n)=str$(t)
end if
end if
next
#ctrl.cmd t
goto [redraw]
[export]
filedialog "Save CSV:", "*.csv", eName$
if eName$=fName$ or eName$="" then
#ctrl.cmd "Invalid Name"
goto [redraw]
end if
open eName$ for output as #export
'save the title line
for c=1 to numCol
'is the field selected
if dbf(c,4)=0 then
#export chr$(34)+trim$(dbf$(0,c))+chr$(34)+",";
end if
next c
#export chr$(13)+chr$(10);
'save the records
for n=1 to maxRec
'is the record selected
if dbf$(n,0)="0" then
for c=1 to numCol
'is the field selected
if dbf(c,4)=0 then
#export chr$(34)+trim$(dbf$(n,c))+chr$(34)+",";
end if
next c
#export chr$(13)+chr$(10);
end if
next
close #export
#ctrl.cmd "Exported"
goto [redraw]
[printit]
timer 0
if editing then gosub [closeclicked]
printit=1
#grid.g "cls"
goto [redraw]
[quitgrid]
timer 0
if editing then gosub [closeclicked]
'save the file
close #grid
close #ctrl
end sub
sub openDBF f$,maxwanted
dbfName$=f$
'set these global values X,W,H are index values for dbf()
X=1
W=2
H=3
'set the desired font width and height that matches your chosen font.
'the font is set in the grid sub, best use a fixed width font
fontW=10
fontH=25
'open csv file and get number of columns
'we are not saving anything here just counting the columns
open f$ for input as #csv
line input #csv,l$
l$=","+l$+","
col=1 'the column we are at
pos=1 'the position in l$
dat$="?"
while col<=100 and dat$<>""
'if we are sitting on a [,"] then look for matching [",]
'else look for [,]
if mid$(l$,pos,2)=","+chr$(34) then
pos=pos+2
pos2=instr(l$,chr$(34)+",",pos)
dat$=mid$(l$,pos,pos2-pos)
pos2=pos2+1
else
pos=pos+1
pos2=instr(l$,",",pos)
dat$=mid$(l$,pos,pos2-pos)
end if
'strip down remaining double quotes to single quotes
a$=chr$(34)+chr$(34)
b$=chr$(34)
dat$=replstr$( dat$, a$, b$ )
pos=pos2
col=col+1
wend
'set the global numCol
numCol=col-2 'last inc plus "" so -2
close #csv
'now read in the csv file to array dbf$()
'using my own parser because inputcsv$ chokes on embeded ""
redim dbf$(maxwanted,numCol)'main database array
redim dbf(numCol,5) 'display x, width and height of field and hidden or not
open f$ for input as #csv
rec=0 'field names in 0
'get the records if available up to maxwanted, ignore rest if there are more
while eof(#csv)=0 and rec<maxwanted
dbf$(rec,0)="0" 'display
line input #csv,l$
l$=","+l$+","
col=1 'the column we are at
pos=1 'the position in l$
while col<=numCol
'if we are sitting on a [,"] then look for matching [",]
'else look for [,]
if mid$(l$,pos,2)=","+chr$(34) then
pos=pos+2
pos2=instr(l$,chr$(34)+",",pos)
dat$=mid$(l$,pos,pos2-pos)
pos2=pos2+1
else
pos=pos+1
pos2=instr(l$,",",pos)
dat$=mid$(l$,pos,pos2-pos)
end if
'strip down remaining double quotes to single quotes
a$=chr$(34)+chr$(34)
b$=chr$(34)
dat$=replstr$( dat$, a$, b$ )
'if col=1 then
' dbf$(rec,col)=str$(rec);" "
'else
dbf$(rec,col)=trim$(dat$)
'end if
pos=pos2
col=col+1
wend
rec=rec+1
wend
'set the global maxRec
maxRec=rec-1
lastRec=maxRec
dim sum$(maxRec)
close #csv
'set the cell xyh values for field widths
x=0
for c=1 to numCol
dbf(c,X)=x
dbf(c,W)=len(dbf$(0,c))*fontW+2*fontW
dbf(c,H)=fontH
dbf(c,4)=0 'hide
dbf(c,5)=c 'Id
x=x+dbf(c,W)
next
'set global wX, graphicbox width required
'add enough room for summation column
wX=x+100
end sub
sub quit handle$
close #ctrl
close #grid
end
end sub
sub qsort Start, Finish, order$
'order$ is a comma delimited priority list of columns to sort on "2,1" "7" etc
i = Start
j = Finish
dim temp$(numCol)
'create the compare string
r=int((i+j)/2)
compa$=""
o=1
o$=word$(order$,o,",")
while o$<>""
compa$=compa$+dbf$(r,val(o$))
o=o+1
o$=word$(order$,o,",")
wend
while i <= j
'create the string to compare against
compb$=""
o=1
o$=word$(order$,o,",")
while o$<>""
compb$=compb$+dbf$(i,val(o$))
o=o+1
o$=word$(order$,o,",")
wend
while compb$ < compa$
i = i + 1
compb$=""
o=1
o$=word$(order$,o,",")
while o$<>""
compb$=compb$+dbf$(i,val(o$))
o=o+1
o$=word$(order$,o,",")
wend
wend
'create the string to compare against
compb$=""
o=1
o$=word$(order$,o,",")
while o$<>""
compb$=compb$+dbf$(j,val(o$))
o=o+1
o$=word$(order$,o,",")
wend
while compb$ > compa$
j = j - 1
compb$=""
o=1
o$=word$(order$,o,",")
while o$<>""
compb$=compb$+dbf$(j,val(o$))
o=o+1
o$=word$(order$,o,",")
wend
wend
if i <= j then
for p=0 to numCol
temp$(p)=dbf$(i,p)
next
'a$ = sa$(i)
for p=0 to numCol
dbf$(i,p)=dbf$(j,p)
next
'sa$(i) = sa$(j)
for p=0 to numCol
dbf$(j,p)=temp$(p)
next
'sa$(j) = a$
i = i + 1
j = j - 1
end if
wend
if j > Start then call qsort Start, j,order$
if i < Finish then call qsort i, Finish,order$
end sub
function transform$(s$)
'transform the column numbers
'to account for hidden columns
tr$=""
c=1
c$=word$(s$,c,",")
while c$<>"" and val(c$)<=numCol
i=0
n=0
while i<val(c$)
if dbf(n+1,4)=0 then i=i+1
n=n+1
wend
tr$=tr$+str$(n)+","
c=c+1
c$=word$(sort$,c,",")
wend
transform$=tr$
end function