kasboek [ huiswerk 20-6-2012 ]

Algemene discussies en vragen omtrent Liberty BASIC programma's. Stuur zoveel mogelijk delen van listings (snippets) in als je hulp wilt.

Moderators: anthonio, Abcott

kasboek [ huiswerk 20-6-2012 ]

Berichtdoor bluatigro » do jun 21, 2012 11:47 am

dit is n poging voor t huiswerk van 20-6-2012

de plaatjes zijn al ongeveer wat t moet zijn

de werking is nog niet corecrt

Code: Selecteer alles
WindowWidth = 800
WindowHeight = 640
global kasboek$ , file$
nomainwin
menu #m , "File" _
        , "New" , [new_main] _
        , "Open" , [open_main] _
        , "Save" , [save_main] _
      ,|, "Quit" , [quit_main]
menu #m , "item" _
        , "New Item" , [newItem]
textbox #m.txt , 0 , 0 , 800 , 640
open "" for window as #m
  #m "trapclose [quit_main]"
  #m "font Courier_new 30 bold"
wait
[new_main]
  #m.txt ""
wait
[open_main]
  filedialog "load kasboek" , "*.txt" , file$
  if file$ <> "" then
    open file$ for input as #in
      while not( eof( #in ) )
        input #in , line$
        kasboek$ = push$( kasboek$ , line$ , 0 )
      wend
    close #in
  end if
  call updatekasboek
wait
[save_main]
  filedialog "save kasboek" , "*.txt" , file$
  if file$ <> "" then
    open file$ for output as #uit
      print #uit , kasboek$
    close #uit
  end if
wait
[quit_main]
  close #m
wait
[newItem]
  textbox    #item.txtitem , 400 , 0 , 400 , 50
  statictext #item.lblitem , "item" , 0 , 0 , 400 , 50
  textbox    #item.txtprijs , 400 , 100 , 400 , 50
  statictext #item.lblprijs , "prijs" , 0 , 100 , 400 , 50
  textbox    #item.txtmerk , 400 , 200 , 400 , 50
  statictext #item.lblmerk , "merk" , 0 , 200 , 400 , 50
  textbox    #item.txtwinkel , 400 , 300 , 400 , 50
  statictext #item.lblwinkel , "winkel" , 0 , 300 , 400 , 50
  button     #item.btnok , "ok" , [quit_item] , ul , 350 , 500 , 100 ,100
  open "" for window as #item
    #item "trapclose [quit_item]"
    #item "font Courier_new 30 bold"
wait
[quit_item]
  #item.txtitem   "!contents? item$"
  #item.txtprijs  "!contents? prijs$"
  #item.txtmerk   "!contents? merk$"
  #item.txtwinkel "!contents? winkel$"
  kasboek$ = push$( kasboek$ , Qitem$( item$ , prijs$ , merk$ , winkel$ ) , 0 )
  call updatekasboek
  close #item
wait
sub updatekasboek
  t$ = kasboek$
  txt$ = ""
  while t$ <> ""
    txt$ = txt$ + top$( t$ ) + chr$( 13 )
    t$ = pop$( t$ )
  wend
  #m.txt txt$
end sub
function Qitem$( i$ , p$ , m$ , w$ )
  Qitem$ = f$( i$ , 10 ) + f$( p$ , 6 ) + f$( m$ , 10 ) + w$
end function
function f$( a$ , n )
  f$ = a$ + space$( n - len( a$ ) )
end function
function push$( stack$ , object$ , l )
  if object$ <> cut$ then
    if l <> 0 then
      push$ = object$ + cut$ + stack$
    else
      push$ = stack$ + object$ + cut$
      ''push$ = stack$ + cut$ + object$
    end if
  else
    push$ = stack$
  end if
end function

function pop$( stack$ )
''delete last object$
  i = instr( stack$ , cut$ )
  if stack$ = "" then pop$ = ""
''get right side of stack
  pop$ = mid$( stack$ , i + 1 , len( stack$ ) -i )
end function

function top$( stack$ )
''read last object$
  i = instr( stack$ , cut$ )
  if stack$ = "" then
    top$ = ""
  else
    top$ = mid$( stack$ , 1 , i - 1 ) '   <<<<<<<<
  end if
end function

function size( a$ )
  result = 0
  for i = 1 to len( a$ )
    if mid$( a$ , i , 1 ) = cut$ then result = result + 1
  next i
  size = result
end function

function insertAt$( a$ , item$ , i )
  p = 1
  result$ = ""
  max = size( a$ )
  i = i mod max
  while p < i
    result$ = push$( result$ , word$( a$ , p , cut$ ) , false )
    p = p + 1
  wend
  result$ = push$( result$ , item$ , false )
  while p <= max
    result$ = push$( result$ , word$( a$ , p , cut$ ) , false )
    p = p + 1
  wend
  insertAt$ = result$
end function

function insertSorted$( a$ , item$ , no , isStr )
  p = 1
  result$ = ""
  max = size( a$ )
  while p <= max
    m$ = word$( a$ , p , cut$ )
    mp$ = word$( m$ , no )
    ip$ = word$( item$ , no )
    result$ = push$( result$ , m$ , false )
    if isStr then
      if mp$ <= ip$ then
        result$ = push$( result$ , item$ , false )
      end if
    else
      if val( mp$ ) <= val( ip$ ) then
        result$ = push$( result$ , item$ , false )
      end if
    end if
    p = p + 1
  wend
  insertSorted$ = result$
end function

function sort$( a$ , no , isStr )
  max = size( a$ )
  for i = 1 to max
    result$ = insertSorted$( result$ , word$( a$ , i , cut$ ) , no , isStr )
  next i
  sort$ = result$
end function

function remove$( a$ , item$ )
  p = 1
  result$ = ""
  max = size( a$ )
  while p <= max
    if word$( a$ , p , cut$ ) <> item$ then
      result$ = push$( result$ , word$( a$ , p , cut$ ) , false )
    end if
    p = p + 1
  wend
  remove$ = result$
end function

function removeAt$( a$ , i )
  p = 1
  result$ = ""
  max = size( a$ )
  i = i mod max
  while p <= max
    if p <> i then
      result$ = push$( result$ , word$( a$ , p , cut$ ) , false )
    end if
    p = p + 1
  wend
  removeAt$ = result$
end function

function reverse$( a$ )
  p = 1
  max = size( a$ )
  while p <= max
    result$ = push$( result$ , word$( a$ , p , cut$ ) , true )
    p = p + 1
  wend
  reverse$ = result$
end function

function part$( a$ , b , e )
  for i = b to e
    r$ = push$( r$ , word$( a$ , i , cut$ ) , false )
  next i
  part$ = r$
end function

function element( a$ , item$ )
  p = instr( cut$ + a$ , cut$ + item$ + cut$ )
  element = p > 0
end function
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Keer terug naar Liberty BASIC Code

Wie is er online

Gebruikers op dit forum: Geen geregistreerde gebruikers. en 2 gasten

cron