Liberty BASIC Community Forum
« Grid tool »

Welcome Guest. Please Login or Register.
Nov 24th, 2017, 10:51am


Rules|Home|Help|Search|Recent Posts|Notification


« Previous Topic | Next Topic »
Pages: 1 2  Notify Send Topic Print
 hotthread  Author  Topic: Grid tool  (Read 491 times)
Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5567
xx Grid tool
« Thread started on: Jul 20th, 2017, 03:26am »

Grid have been discussed. I revisited some code Dan posted a while back that displays everything in a graphicbox but allows editing in a relocated textbox.

This is very much work in progress, you can use the mouse, tab or enter to move between fields.

At this point I am just interested to know what kind of other functionality would folks want from a grid such as this. I plan to allow template and range checking for input. Printing also.

But seek, search, etc, what else is needed?

Code:
nomainwin
'setup dummy databases
open "contacts.dbf" for output as #contacts
#contacts "001Alfs Bakery         Alabama   0123456789";
#contacts "002Freds Bakery        New York  0123456789";
#contacts "003Lilly's Bakehouse   Scotland  0123456789";
#contacts "004Asia Baking         Dehli     0123456789";
close #contacts
open "products.dbf" for output as #products
#products "001Roll    099";
#products "002Bagel   099";
#products "003Danish  199";
#products "004Loaf    100";
#products "005IcedBun 150";
#products "006Tortia  100";
close #products
open "supplychain.dbf" for output as #supply
#supply "001001";
#supply "001002";
#supply "001003";
#supply "002001";
#supply "002002";
#supply "003003";
#supply "004003";
#supply "005003";
#supply "006004";
close #supply



dim dbf(3,10) 'three databases with total field length, max 10 fields
dbf(1,0)=43
dbf(1,1)=3
dbf(1,2)=20
dbf(1,3)=10
dbf(1,4)=10
dbf(2,0)=14
dbf(2,1)=3
dbf(2,2)=8
dbf(2,3)=3
dbf(3,0)=6
dbf(3,1)=3
dbf(3,2)=3

dim dbf$(3,10)'file names and field names
dbf$(1,0)="Contacts.dbf"
dbf$(1,1)="Ref"
dbf$(1,2)="Name"
dbf$(1,3)="Town"
dbf$(1,4)="Tel"
dbf$(2,0)="Products.dbf"
dbf$(2,1)="Ref"
dbf$(2,2)="Name"
dbf$(2,3)=""
dbf$(3,0)="Supplychain.dbf"
dbf$(3,1)="Prd"
dbf$(3,2)="Con"

'name databases
contact=1
product=2
supply=3

rows=10 'num of rows to show
record=1  'starting record

call grid contact,rows,record
end




sub grid dbf,numR,recP
    fontW=12
    fontH=25

    'set the cell xyh values for field widths
    dim cell(10,3) 'x,w,h
    dim cell$(numR,10)
    X=1
    W=2
    H=3
    for n=1 to numR
        if dbf(dbf,n)=0 then exit for
        numC=numC+1
        cell(n,X)=x
        cell(n,W)=dbf(dbf,n)*fontW
        cell(n,H)=fontH
        x=x+cell(n,W)
    next
    xW=x


    cellColor$="black"
    cellBackcolor$="white"


    WindowWidth=x+50
    WindowHeight=numR*fontH+150
    UpperLeftX=(DisplayWidth-WindowWidth)/2
    UpperLeftY=(DisplayHeight-WindowHeight)/2
    Margin=25
    'place a graphicbox
    graphicbox #grid.g,Margin,Margin,xW,(numR+1)*fontH

    'set up a hidden default button
    'now if enter is pressed [tabclicked] will be called
    button #grid.ok,"",[tabclicked],UL,-25,-25,20,20
    stylebits #grid.ok, _BS_DEFPUSHBUTTON, 0, 0, 0

    'set up a hidden textboxes
    'these will be relocated to intercept data input
    'when a cell is clicked

    textbox #grid.txt1, -100, -100, cell(1,W), cell(1,H)
    textbox #grid.txt2, -100, -100, cell(2,W), cell(2,H)
    textbox #grid.txt3, -100, -100, cell(3,W), cell(3,H)
    textbox #grid.txt4, -100, -100, cell(4,W), cell(4,H)
    textbox #grid.txt5, -100, -100, cell(5,W), cell(5,H)
    textbox #grid.txt6, -100, -100, cell(6,W), cell(6,H)
    textbox #grid.txt6, -100, -100, cell(7,W), cell(7,H)
    textbox #grid.txt8, -100, -100, cell(8,W), cell(8,H)
    textbox #grid.txt9, -100, -100, cell(9,W), cell(9,H)
    textbox #grid.txt10, -100, -100, cell(10,W), cell(10,H)



    button #grid.print, "Print", [printit], LR, 105, 25
    button #grid.submit, "Submit", [okclicked],LR, 50,25

    open dbf$(dbf,0) 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]"
    hok = hWnd(#grid.submit)

    [opendatabase]
    open dbf$(dbf,0) for binary as #dbf
    maxR=lof(#dbf)/dbf(dbf,0)

    [redraw]
    'delete the last segment, redraw all cells and flush
    #grid.g "delsegment t"
    #grid.g "color ";cellColor$;";backcolor ";cellBackcolor$
    rec=recP
    for r=0 to numR
        seek #dbf,(rec-1)*dbf(dbf,0)
        for c=1 to numC
            if r=0 then
                #grid.g "place ";cell(c,X)+6;" ";fontH-9;";|";dbf$(dbf,c)
            else
                cell$(r,c)=input$(#dbf,dbf(dbf,c))
                #grid.g "place ";cell(c,X);" ";(r+1)*fontH
                #grid.g "boxfilled ";cell(c,X)+cell(c,W);" ";(r)*fontH
                #grid.g "place ";cell(c,X)+6;" ";(r+1)*fontH-9;";|";cell$(r,c)
            end if
        next c
        if rec=maxR then lastR=r : exit for
        rec=rec+(rec<maxR and r>0)
    next r
    #grid.g "flush t"

    'now if we are editing start to repeatedly check if the user
    'has moved focus by tabbing, pressing enter or
    'clicking the ok button.

    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 branch accordingly
        if htxt<>h then
            if h=hok then
                goto [okclicked]
            else
                gosub [closeclicked]
               'tab to next cell
               curC=curC+1
                if curC>numC then curC=1 : curR=curR+1
                if curR>lastR then curC=1 : curR=1
                goto [editit]
            end if
        end if

    end if
    wait




    [cellclicked]
    'set an editing flag and capture cell coordinates
    if editing then gosub [closeclicked]
    x=MouseX
    y=MouseY
    for c=1 to numC
        if x>cell(c,X)and x<cell(c,X)+cell(c,W) then curC=c : exit for
    next
    curR=int(y/fontH)
    if y>lastR*fontH+fontH then editing=0 : goto [redraw]



    [editit]
    editing=1
    'set x and y to locate the textbox at the cell location
    h$="#grid.txt";curC
    #h$ "!locate ";cell(curC,X)+Margin+1;" ";curR*fontH+fontH+1;" ";cell(curC,W);" ";fontH
    #h$ cell$(curR,curC)
    #h$ "!setfocus"
    #grid "refresh"
    htxt=hwnd(#h$)
    goto [redraw]

    [tabclicked]
    if editing then gosub [closeclicked]
    'tab to next cell
    curC=curC+1
    if curC>numC then curC=1 : curR=curR+1
    if curR>lastR then curC=1 : curR=1
    goto [editit]

    [okclicked]
    timer 0
    if editing then gosub [closeclicked]
    goto [quitgrid]

    [closeclicked]
    'the user either pressed enter or clicked the ok button
    'set the editing flag, move the textbox off screen and save the changes
    timer 0
    editing=0
    #h$ "!locate ";-100;" ";-100;" ";cell(curC,W);" ";cell(curC,H)
    #grid "refresh"
    #h$ "!contents? t$"
    return





    [printit]
    timer 0
    #grid.g "cls"
    'redraw all cells and flush
    #grid.g "delsegment t"
    #grid.g "color ";cellColor$;";backcolor ";cellBackcolor$
    for C=1 to numCols
        for R=1 to numRows
       '     #grid.g "place ";(C-1)*cellW;" ";(R-1)*cellH
       '     #grid.g "boxfilled ";C*cellW+1;" ";R*cellH+1
       '     #grid.g "place ";(C-1)*cellW+8;" ";((R-1)*cellH)+17;";|";cell$(C,R)
        next R
    next C
    #grid.g "flush t"
    #grid.g "print ";gridW+Margin
    wait

    [quitgrid]
    close #dbf
    close #grid

end sub

sub quit handle$
    close #handle$
    kill "product.dbf"
    kill "contacts.dbf"
    kill "supplychain.dbf"
    end
end sub
 
User IP Logged

tsh73
Board Moderator

member is offline

Avatar

Anatoly (real name)


PM

Gender: Male
Posts: 1689
xx Re: Grid tool
« Reply #1 on: Jul 20th, 2017, 04:12am »

copy/paste
tab delimited columns, CR LF delimited lines
would ber very handy (probably allow to copy/paste with Excel)
User IP Logged

damned Dog in the Manger
Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5567
xx Re: Grid tool
« Reply #2 on: Jul 20th, 2017, 07:31am »

Quote:
tab delimited columns, CR LF delimited lines



It would be easy to write a converter, but I was assuming a database input, RAF, Binary or .dbf file which are all much more rigid in structure.

So an import feature. csv/delimited file to structured dbf file.
User IP Logged

metro
Full Member
ImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 194
xx Re: Grid tool
« Reply #3 on: Jul 20th, 2017, 07:41am »

I think this is a great start Rod,

I can't speak for Dan but from what I have seen I think he is trying to create a DBMS for SQLite using LB and one of the issues from my perspective is creating an input screen on the fly for the fields in each table within a DB.

Fields mostly can be changed or filled using a textbox but some require a DatePicker or TextEdit and possibly a GraphicBox to accept info, the requirement for each can be determined by an initial SQL"PRAGMA table_info" query of the DB but I think it will then need API calls to create the widgets on the fly for each field. Bearing in mind these DB's are already created.

I have looked at ZeeGrid as an option, however my skill set at the moment is well below Par so I do not have the ability to modify the DLL calls (if thats possible) for use by LB. http://www.kycsepp.com/

DLL's are something I can copy and paste to get a desired result but not something I fully comprehend.

I believe your proposed grid will be great for new ground-up Databases,and am looking forward to the final outcome.


« Last Edit: Jul 20th, 2017, 11:16am by metro » User IP Logged

Win10 64 HP laptop + desktop Mint Linux 64bit
meerkat
Junior Member
ImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 67
xx Re: Grid tool
« Reply #4 on: Jul 20th, 2017, 4:53pm »

Quote:
Fields mostly can be changed or filled using a textbox but some require a DatePicker or TextEdit and possibly a GraphicBox to accept info


You are soo correct Laurie..
I said somewhere I'd like to rewrite it in Run Basic, just to see a comparison. I started to do that and should have it in a day or two depending on time. So far it takes about 1/2 the amount of code. And the layouts are simple. Using the HTML 5 features, it does date picker, time picker, numeric checks, decimal checks, range checks, color picker, scrolled text and forms, and others. All the forms float to automatically line up everything. This takes no RB code. Personally I like the REBOL forms the best for ease of use, layout, and features. I may write some RB code to allow that type of layout. Plus the code is available on the WEB when done.
I'll post it on the Run Basic form. Maybe I should post it here also, so people can compare the two.

Have a g'day..
dan
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5567
xx Re: Grid tool
« Reply #5 on: Jul 22nd, 2017, 10:51am »

OK, changing tack a little. The SQL project offers way too much functionality to mimic. But an editable grid tool with sort and select feels worthwhile.

Still very much wip but its fun.

User Image

Code:
' I changed tack, this now imports csv data
' you need to know the number of fields and set the dbf$()
' to match in the openDBF routine. Sample data here or use your own
' https://www.briandunning.com/sample-data/uk-500.zip

'lots to do, page, seek, sort, select. Paging first then
'a multicolumn sort, then seek/select

'I am liking the way it looks and feels up to now.
'All with ONE textbox!

global numCol,maxRec,dbfName$,X,W,H,wX,wY,wW,wH,fontW,fontH
X=1
W=2
H=3
fontW=10
fontH=25
dim dbf(10,10)
dim dbf$(10,10)
call openDBF "uk-500.csv",500,11 'file name, num records, num fields
call grid 24,1
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 [tabclicked] will be called
    button #grid.ok,"",[tabclicked],UL,-25,-25,20,20
    stylebits #grid.ok, _BS_DEFPUSHBUTTON, 0, 0, 0

    'set up a hidden textbox
    'to be relocated to intercept data input
    'when a cell is clicked
    textbox #grid.txt, -100, -100, 100, 25
    button #grid.print, "Print", [printit], LR, 105, 25
    button #grid.submit, "Submit", [okclicked],LR, 50,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
    hok = hWnd(#grid.submit)


    [redraw]
    'delete the last segment, redraw all cells and flush
    #grid.g "delsegment t"
    #grid.g "color black ;backcolor white"
    rec=recP
    lastRow=numRow
    for r=0 to numRow
        for c=1 to numCol
                if r=0 then
                #grid.g "backcolor buttonface"
                #grid.g "place ";dbf(c,X)+6;" ";(r+1)*fontH-9;";|";dbf$(r,c)
                else
                #grid.g "backcolor white ; 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
        if rec=maxRec then lastRow=r : exit for
        if r<>0 then rec=rec+(rec<maxRec)
    next r
    #grid.g "flush t"

    'now if we are editing start to repeatedly check if the user
    'has moved focus by tabbing, pressing enter or
    'clicking the ok button.

    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 branch accordingly
        if htxt<>h then
            if h=hok then
                goto [okclicked]
            else
                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]
            end if
        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 x>dbf(c,X)and x<dbf(c,X)+dbf(c,W) then curCol=c : exit for
    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]

    [okclicked]
    timer 0
    if editing then gosub [closeclicked]
    goto [quitgrid]

    [closeclicked]
    'the user either pressed enter or clicked the ok button
    '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$"
    'save still to do
    return





    [printit]
    timer 0
    #grid.g "cls"
    'redraw all cells and flush
    'still to do
    wait

    [quitgrid]
    close #grid

end sub


sub openDBF f$,nr,nf
    dbfName$=f$
    redim dbf$(nr,nf)'database array
    redim dbf(nf,3) 'xpos, width and height of field
    open f$ for input as #csv
    rec=0 'field names in 0
    while eof(#csv)=0
        'this needs changed because the command needs to fit the field structure of the csv
        'probably need to write own csv parser
        inputcsv #csv,dbf$(rec,1),dbf$(rec,2),dbf$(rec,3),dbf$(rec,4),dbf$(rec,5),dbf$(rec,6),dbf$(rec,7),dbf$(rec,8),dbf$(rec,9),dbf$(rec,10),dbf$(rec,11)
        rec=rec+1
    wend
    maxRec=rec-1
    close #csv
    'set the cell xyh values for field widths
    for n=1 to nf
        dbf(n,X)=x
        dbf(n,W)=len(dbf$(0,n))*fontW
        dbf(n,H)=fontH
        x=x+dbf(n,W)
    next
    wX=x
    numCol=nf
end sub

sub quit handle$
    close #handle$
    end
end sub



 
« Last Edit: Jul 22nd, 2017, 11:01am by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5567
xx Re: Grid tool
« Reply #6 on: Jul 22nd, 2017, 4:39pm »

I forgot to say "way to go Dan", one textbox relocation and I can host a huge grid.

Going back to the competition entries for the sort routines, I know that will work well. Search and select will be fun. Don't want this based on one column, it needs to be smarter and multi column. But how to take the input?
User IP Logged

metro
Full Member
ImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 194
xx Re: Grid tool
« Reply #7 on: Jul 22nd, 2017, 6:15pm »

Wow, impressive.
I'm going to find this very useful when its complete, I don't think it would be too much of a stretch to have other hidden widgets like a listbox or calendar control drop in where needed.Maybe in the next incarnation.

Your code also enlightened me to something I wasn't aware of
http://www.libertybasicuniversity.com/lb4help/Handle_Variables.htm

thanks for taking on the challenge Rod.

Laurie

PS Hope you don't mind, I like to see a result when I edit something
Code:
 [closeclicked]
    'the user either pressed enter or clicked the ok button
    '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$"
    'save still to do
     dbf$(curRow,curCol)=t$  'ADD THIS to Rods code
       return
 


Obviously the change needs to occur in the Db too
« Last Edit: Jul 23rd, 2017, 01:29am by metro » User IP Logged

Win10 64 HP laptop + desktop Mint Linux 64bit
Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5567
xx Re: Grid tool
« Reply #8 on: Jul 23rd, 2017, 2:33pm »

Ok, we now have paging and a command line for sorting and finding. We have multi column sort. "2,1" in the command line will sort on column 2 then column 1. "7" will sort on column 7 etc etc. Very simple find will find any command line fragment in the whole record, case sensitive right now.

Bplus's classic qsort routine was tweaked to handle multi column.

User Image

Code deleted see below
« Last Edit: Jul 24th, 2017, 02:41am by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5567
xx Re: Grid tool
« Reply #9 on: Jul 23rd, 2017, 2:49pm »

Should add that the initial column widths are set by the field names, so if they are the correct size for the data and the data is fixed width then it will all line up nicely. But it is pretty cool that variable width data is handled just as easily!
User IP Logged

metro
Full Member
ImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 194
xx Re: Grid tool
« Reply #10 on: Jul 23rd, 2017, 7:03pm »

Small bug Rod
click on #grid.cmd first , then sort works
click on graphicbox then #grid.txt gets focus. Any mouse clicks anywhere (including on #grid.cmd) is as if Tab has been pressed, so focus moves between fields.

Also "[search]" does not exist
User IP Logged

Win10 64 HP laptop + desktop Mint Linux 64bit
Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5567
xx Re: Grid tool
« Reply #11 on: Jul 24th, 2017, 02:43am »

Still has bugs, Find Next, and Select are next on the agenda. Sort/Select/Save is the cut copy and paste of databases.

Code:
nomainwin
'Sample data here or use your own
'https://www.briandunning.com/sample-data/uk-500.zip

'paging = first, pagedown numRow, pageup numRow , last
'sort = comma delimited command line ie "7" or "2,1"
'find takes command line fragment and finds first occurrence in any column

global numCol,maxRec,dbfName$,X,W,H,wX,wY,wW,wH,fontW,fontH
X=1
W=2
H=3
fontW=10
fontH=25
dim dbf(10,10)
dim dbf$(10,10)
call openDBF "uk-500.csv",500,11 'file name, num records, num fields
call grid 20,1
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.cmd, Margin,WindowHeight-80,100,25
    button #grid.print, "Print", [printit], LR, 110, 25
    button #grid.submit, "Submit", [quitgrid],LR, 60,25
    button #grid.sort, "Sort", [sort],LL,130,9
    button #grid.find,"Find", [find],LL,175,9
    button #grid.select,"Select",[select],LL,220,9
    button #grid.first, "<<",[first],LR,203,25
    button #grid.pageup, "<",[pageup],LR,175,25
    button #grid.pagedown, ">",[pagedown],LR,155,25
    button #grid.last, ">>",[last],LR,135,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)
    hsubmit=hwnd(#grid.submit)
    hfirst=hwnd(#grid.first)
    hpageup=hwnd(#grid.pageup)
    hpagedown=hwnd(#grid.pagedown)
    hlast=hwnd(#grid.last)
    hsort=hwnd(#grid.sort)
    hfind=hwnd(#grid.find)
    htab=hwnd(#grid.tab)
    hcmd=hwnd(#grid.cmd)

    [redraw]
    'delete the last segment, redraw all cells and flush
    #grid.g "delsegment t"
    #grid.g "color black"
    rec=recP
    lastRow=numRow
    for r=0 to numRow
        if r=0 then #grid.g "backcolor buttonface" else  #grid.g "backcolor white"
        if r<>0 and dbf$(rec,0)="2" then #grid.g "backcolor cyan"
        for c=1 to numCol
                if r=0 then
                #grid.g "place ";dbf(c,X)+6;" ";(r+1)*fontH-9;";|";dbf$(r,c)
                else
                #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
        if r>0 and dbf$(rec,0)="2" then dbf$(rec,0)="1"
        if rec=maxRec then lastRow=r : exit for
        if r<>0 then rec=rec+(rec<maxRec)
    next r
    #grid.g "flush t"

    '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, branch
        if htxt<>h then
            timer 0
            gosub [closeclicked]
            if h=hsubmit then goto [quitgrid]
            if h=henter then  goto [redraw]
            if h=hfirst then goto [first]
            if h=hpageup then goto [pageup]
            if h=hpagedown then goto [pagedown]
            if h=hlast then goto [last]
            if h=hsort then goto [sort]
            if h=hfind then goto [find]
            if h=htab then goto [tabclicked]
            if h=hcmd then goto [enterclicked]
            'else 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]
        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 x>dbf(c,X)and x<dbf(c,X)+dbf(c,W) then curCol=c : exit for
    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$"
    'save still to do
    return

    [first]
    if editing then gosub [closeclicked]
    recP=1
    goto [redraw]

    [pagedown]
    if editing then gosub [closeclicked]
    recP=recP+numRow
    if recP>maxRec then recP=maxRec-numRow
    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=maxRec-numRow
    if recP<1 then recP=1
    goto [redraw]

    [sort]
    if editing then gosub [closeclicked]
    #grid.cmd "!contents? sort$"
    if sort$<>"" then
        call qsort 1, maxRec, sort$
        recP=1
        #grid.cmd "Sorted"
    end if
    goto [redraw]

    [find]
    if editing then gosub [closeclicked]
    'very simple search, find fragment in any field
    #grid.cmd "!contents? find$"
    found=0
    while found=0 and recP<=maxRec
        t$=""
        for n= 1 to numCol
            t$=t$+dbf$(recP,n)
        next
        found = instr(t$,find$)
        recP=recP+1
    wend
    if recP>maxRec then
        #grid.cmd "Not Found"
        recP=1
    else
        #grid.cmd find$
        recP=recP-1
        dbf$(recP,0)="2"
    end if
    goto [redraw]

    [printit]
    timer 0
    #grid.g "cls"
    'redraw all cells and flush
    'still to do
    wait

    [quitgrid]
    timer 0
    if editing then gosub [closeclicked]
    'save the file
    close #grid

end sub


sub openDBF f$,nr,nf
    dbfName$=f$
    redim dbf$(nr,nf)'database array
    redim dbf(nf,3) 'xpos, width and height of field
    open f$ for input as #csv
    rec=0 'field names in 0
    while eof(#csv)=0 and rec<nr
        'this needs changed because the command needs to fit the field structure of the csv
        'probably need to write own csv parser
        inputcsv #csv,dbf$(rec,1),dbf$(rec,2),dbf$(rec,3),dbf$(rec,4),dbf$(rec,5),dbf$(rec,6),dbf$(rec,7),dbf$(rec,8),dbf$(rec,9),dbf$(rec,10),dbf$(rec,11)
        dbf$(rec,0)="1" 'selected
        rec=rec+1
    wend
    maxRec=rec-1
    close #csv
    'set the cell xyh values for field widths
    for n=1 to nf
        dbf(n,X)=x
        dbf(n,W)=len(dbf$(0,n))*fontW
        dbf(n,H)=fontH
        x=x+dbf(n,W)
    next
    wX=x
    numCol=nf
end sub

sub quit handle$
    close #handle$
    end
end sub


sub qsort Start, Finish, order$
  'Bplus's classic qsort code tweaked for multi column
  '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=1 to numCol
            temp$(p)=dbf$(i,p)
        next
        'a$ = sa$(i)
        for p=1 to numCol
            dbf$(i,p)=dbf$(j,p)
        next
        'sa$(i) = sa$(j)
        for p=1 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


 



« Last Edit: Jul 24th, 2017, 3:00pm by Rod » User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5567
xx Re: Grid tool
« Reply #12 on: Jul 26th, 2017, 10:34am »

I am still playing with this, it has evolved into a .csv review and browse style of grid tool. It will analyse and open any .csv file. It allows sort, find, find next, select. Sum and Save might be next.

Anyways the core grid tool seems to work well. Fixed width data would make it look a whole lot better but that isn't the nature of .csv.



The .zip is the .bas file and a 2000 record sample .csv wrapped in a folder so it is easily unzipped and erased.

http://gamebin.webs.com/Liberty/GridTool-1.zip
« Last Edit: Jul 27th, 2017, 3:06pm by Rod » User IP Logged

cor
New Member
Image


member is offline

Avatar




PM

Gender: Male
Posts: 6
xx Re: Grid tool
« Reply #13 on: Jul 26th, 2017, 2:38pm »

Hi Rod,

You mention a zip file but I see no address. Can you point me to the latest version of the grid tool?

Thanks, Cor.

Sorry Rod, saw the address - I was viewing the forum on a tablet and it missed the address. Again thanks.

Cor
« Last Edit: Jul 26th, 2017, 2:39pm by cor » User IP Logged

cor massar, Dutch member located in Germany
Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5567
xx Re: Grid tool
« Reply #14 on: Jul 26th, 2017, 3:06pm »

Sorry missed out the link. It is there now. I like the grid and I like the power it has over the .csv.

Obviously a way to go before it becomes a dbms. Add, edit, delete, create, index, forms, lists etc etc

But at least this simple start gets us talking about database basics like sort, select, find.
User IP Logged

Pages: 1 2  Notify Send Topic Print
« Previous Topic | Next Topic »

Rules|Home|Help|Search|Recent Posts|Notification

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls