Liberty BASIC Community Forum
« Search Results »

Welcome Guest. Please Login or Register.
Jul 25th, 2017, 11:43am


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

--Liberty BASIC Resources--
Liberty BASIC Community WikiSpace
Frequently Asked Questions
Bay Six Software Forum
Liberty BASIC Home Page
Carl Gundel's Blog
Official Liberty BASIC Support
Liberty BASIC Programmer's Encyclopedia
Liberty BASIC on Rosetta Code

Search Results

Total results: 10


 1   Liberty BASIC Code / Re: Genetic Programming  on: Today at 04:53am
Started by bluatigro | Post by bluatigro
update :
i tryed to catch ALL "error"s in gprun
i got them all now but i think i made some mistakes
[ see REM ]

please look in gprun if i got them rigth
and report mistakes and forgotten ones

code at :
http://libertybasic.nl/viewtopic.php?f=4&t=649&p=2571#p2571
 
  Reply Quote Notify of replies

 2   Database Applications / Re: Where to find: Tsunami, ODBC, Cheetah  on: Yesterday at 3:09pm
Started by Alyce Watson | Post by CarlGundel
Try this one:

http://lbpe.wikispaces.com/A+Kit+for+Using+Cheetah

smiley

-Carl
 
  Reply Quote Notify of replies

 3   Database Applications / Re: Grid tool  on: Yesterday at 02:43am
Started by Rod | Post by Rod
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


 




 
  Reply Quote Notify of replies

 4   Database Applications / Re: Grid tool  on: Jul 23rd, 2017, 7:03pm
Started by Rod | Post by metro
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
 
  Reply Quote Notify of replies

 5   Database Applications / Re: Grid tool  on: Jul 23rd, 2017, 2:49pm
Started by Rod | Post by Rod
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!
 
  Reply Quote Notify of replies

 6   Database Applications / Re: Grid tool  on: Jul 23rd, 2017, 2:33pm
Started by Rod | Post by Rod
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
 
  Reply Quote Notify of replies

 7   Liberty BASIC Code / Re: Randon Acess file question.  on: Jul 23rd, 2017, 12:59am
Started by milfredo | Post by milfredo
I don't know why, but it seems when I get stuck and post a question on here, the Universe seems to answer me sometimes. I believe I have figured out the solution.

Instead of trying to put the data records in different folders, I will just include the folder info in each record. Then I should be able to search the RAF and just pull out the info associated with the folder name that is chosen by the user. Make sense?

Milfredo
 
  Reply Quote Notify of replies

 8   Liberty BASIC Code / Randon Acess file question.  on: Jul 22nd, 2017, 9:48pm
Started by milfredo | Post by milfredo
I have a situation where I have an RAF that stores some data that my program user selects. But sometimes the data needs to go in one folder and maybe the next time the user collects some data that is put in a record like the previously mentioned, needs to go in a different folder.

Do I need to have a separate RAF for each folder to put the data in and store it?

The problem is that the user creates these folders and they can create as many as they want. I would have no idea how many they might create.

Thanks for any input,
Milfredo

 
  Reply Quote Notify of replies

 9   Database Applications / Re: Grid tool  on: Jul 22nd, 2017, 6:15pm
Started by Rod | Post by metro
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
 
  Reply Quote Notify of replies

 10   Database Applications / Re: Grid tool  on: Jul 22nd, 2017, 4:39pm
Started by Rod | Post by Rod
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?
 
  Reply Quote Notify of replies


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