home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / qtoolsa / names.bas < prev    next >
BASIC Source File  |  1987-01-22  |  9KB  |  275 lines
  1. rem $linesize:132
  2. rem $title:'Names - Partial creation by Application Engineer'
  3. rem $subtitle:'(c) Copyright Roy Barrow 1987.'
  4. rem $include:'aecommon.bas'
  5.  
  6. ' Screen Generator Version used was : 5.36a
  7.  
  8.     dim dl$(6%)
  9.  
  10.   call Color.Init("appcolor.ctl")           ' Initialize color parameters
  11.  
  12.  
  13.     open "r",2%,"names.dat",512
  14.     w!=lof(2%)
  15.     if w!=0 then                                          '  New file
  16.         call init.new.file(2%,512%)                        '  Initialise it
  17.         call mark.file.open(2%,512%)                       '  Mark it open
  18.         call bit.creatq(3%,"namesidx",40%)                 '  Create index
  19.         if aesb.fatal% or aesb.warning% then
  20.             call ae.error("NAMES - namesidx index creation error")
  21.         end if
  22.         call mark.file.closed(2%,512%)                     '  Mark it closed
  23.     end if
  24.  
  25.     call mark.file.open(2%,512%)                          '  Mark open
  26.     field #2,2 as du$,40 as nm$,30 as tl$,440 as notes$   '  Fielding
  27.     call bit.open(3%,"namesidx")                          '  Open index
  28.     if aesb.fatal% then
  29.         call ae.error("NAMES - namesidx index opening error")
  30.     end if
  31.     call names.frame                                      '  Display Screen
  32.  
  33. menu:
  34.     data 3,"Edit","Options","Exit"
  35.     data 5,"Insert","Amend","Delete","","Browse"
  36.     data 2,"Color preferences","Details"
  37.     data 1,"To DOS"
  38.  
  39.     loop%=0%
  40.  
  41.     while loop%=0%
  42.         call names.frame
  43.         call centre.text("NAMES Indexing Demonstration Program",1%)
  44.         call centre.text("By Roy Barrow",2%)
  45.         restore menu                           '  Menu data statements
  46.         gosub get.menu                         '  Put values in common array
  47.         call pull.down.menu                    '  Display & get menu options
  48.  
  49.         if menu%=1% then                       '  Editing functions
  50.             if menop%=1% then                   '  Insert a new record
  51.                 iloop%=0%                        '  For correct? Y/N
  52.                 while iloop%=0%
  53.                     call input.block(9%,19%,1%,40%,inm$,0%)
  54.                     call ctrl.trim(inm$)
  55.                     iloop%=1%
  56.                     if len(inm$) then                '  Good name
  57.                         call input.block(11%,30%,1%,30%,tnum$,0%)
  58.                         call input.block(13%,13%,8%,55%,hist$,0%)
  59.                         call correct(iloop%)          '  Get flag
  60.                     end if
  61.                 wend
  62.                 if len(inm$) then                   '  Good record !
  63.                     call get.avail.record(2%,512%,rr%)
  64.                     call bit.ins(3%,inm$,rr%,success%)
  65.                     get #2,rr%
  66.                     lset nm$=inm$
  67.                     lset tl$=tnum$
  68.                     lset notes$=hist$
  69.                     put #2,rr%
  70.                 end if
  71.             end if
  72.  
  73.             if menop%=2% then                   '  Amend an existing record
  74.                 if xh%(3%,2%)<>0% then
  75.                     dialog$(1%)="Select item to"
  76.                     dialog$(2%)="amend from the"
  77.                     dialog$(3%)="list on the left"
  78.                     dialog$(4%)=""
  79.                     dl$(1%)="Type in the initial search key value for the"
  80.                     dl$(2%)="item that you wish to amend."
  81.                     call Key.Select.Box(30%,dl$(),opt$,3%,ky$,rrec%,success%)
  82.                     if rrec%>0% and success%>0% then
  83.                         get #2,rrec%
  84.                         gosub disp.frame
  85.                         iloop%=0%
  86.                         hist$=notes$
  87.                         tnum$=tl$
  88.                         while iloop%=0%
  89.                             call input.block(11%,30%,1%,30%,tnum$,0%)
  90.                             call input.block(13%,13%,8%,55%,hist$,0%)
  91.                             call correct(iloop%)          '  Get flag
  92.                         wend
  93.                         lset tl$=tnum$
  94.                         lset notes$=hist$
  95.                         put #2,rrec%
  96.                     end if
  97.                 else
  98.                     dialog$(1%)="Sorry, no records to amend !"
  99.                     dialog$(2%)="Use the INSERT option now."
  100.                     call Press.Any.Key(2%)
  101.                 end if
  102.  
  103.             end if
  104.  
  105.             if menop%=3% then                   '  Delete a record
  106.                 if xh%(3%,2%)<>0% then
  107.                     dialog$(1%)="Select item to"
  108.                     dialog$(2%)="delete from the"
  109.                     dialog$(3%)="list on the left"
  110.                     dialog$(4%)=""
  111.                     dl$(1%)="Type in the initial search key value for the"
  112.                     dl$(2%)="item that you wish to delete."
  113.                     call Key.Select.Box(30%,dl$(),opt$,3%,ky$,rrec%,success%)
  114.                     if rrec%>0% and success%>0% then
  115.                         get #2,rrec%
  116.                         gosub disp.frame
  117.                         dialog$(1%)="DELETE this record"
  118.                         dialog$(2%)="Are you sure ?"
  119.                         call yes.no(yn$)
  120.                         if yn$="Y" then
  121.                             call bit.kill(3%,ky$,rrec%,success%)
  122.                             call Release.Avail.Record(2%,512%,rrec%)
  123.                         end if
  124.                         get #2,rrec%
  125.                         lset tl$=string$(30%,0%)
  126.                         lset notes$=string$(440%,0%)
  127.                         lset nm$=string$(40%,0%)
  128.                         put #2,rrec%
  129.                     end if
  130.                 else
  131.                     dialog$(1%)="Sorry, no records to delete !"
  132.                     dialog$(2%)="Use the INSERT option now."
  133.                     call Press.Any.Key(2%)
  134.                 end if
  135.             end if
  136.  
  137.             if menop%=5% then                   '  Browse
  138.                 if xh%(3%,2%)<>0% then
  139.                     dialog$(1%)="Select item to"
  140.                     dialog$(2%)="start browsing"
  141.                     dialog$(3%)="at from the list"
  142.                     dialog$(4%)="on the left."
  143.                     dl$(1%)="Type in the initial search key value for the"
  144.                     dl$(2%)="item that you wish to browse from."
  145.                     call Key.Select.Box(30%,dl$(),opt$,3%,ky$,rrec%,success%)
  146.                     if rrec%>0% and success%>0% then
  147.                         get #2,rrec%
  148.                         gosub disp.frame
  149.                         iloop%=0%
  150.                         while iloop%=0%
  151.                             call qprint ("- for previous,  + for next,  ESC to exit",25%,10%)
  152.                             call Get.Single( co%, ct%)
  153.                             if ct%=1% then
  154.                                 if co%=asc("+") then
  155.                                     call bit.next(3%,ky$,rrec%,success%)
  156.                                     if rrec%>0% and success%>0% then
  157.                                         get #2,rrec%
  158.                                         gosub disp.frame
  159.                                     end if
  160.                                 end if
  161.                                 if co%=asc("-") then
  162.                                     call bit.prev(3%,ky$,rrec%,success%)
  163.                                     if rrec%>0% and success%>0% then
  164.                                         get #2,rrec%
  165.                                         gosub disp.frame
  166.                                     end if
  167.                                 end if
  168.                                 if co%=27% then
  169.                                     iloop%=1%
  170.                                     locate 25,1
  171.                                     call clreol
  172.                                 end if
  173.                             end if
  174.                         wend
  175.                     end if
  176.                 else
  177.                     dialog$(1%)="Sorry, no records to browse !"
  178.                     dialog$(2%)="Use the INSERT option now."
  179.                     call Press.Any.Key(2%)
  180.                 end if
  181.  
  182.             end if
  183.  
  184.         end if
  185.  
  186.         if menu%=2% then                       '  Color & Details
  187.             if menop%=1% then                   '  It's color
  188.                 call aecolins                    '  Color options
  189.                 cls
  190.                 call names.frame
  191.             end if
  192.             if menop%=2% then                   '  Display info
  193.                 dialog$(1%)="NAMES, a simple demonstration of using the"
  194.                 dialog$(2%)="binary tree indexing routines. This program"
  195.                 dialog$(3%)="and the indexing, menu & dialogue routines"
  196.                 dialog$(4%)="was written by Roy Barrow. If you want the"
  197.                 dialog$(5%)="source code for these routines, then send "
  198.                 dialog$(6%)="a contribution to:"
  199.                 dialog$(7%)="R.Barrow, 3J-222 Church Street, Philadelphia"
  200.                 dialog$(8%)="PA 19107.    (215) 922-2557"
  201.                 call Press.Any.Key(8%)
  202.             end if
  203.         end if
  204.  
  205.         if menu%=3% then                       '  Exit
  206.  
  207.             if menop%=1% then                   '  True Exit
  208.                 dialog$(1%)="Exit to DOS, are you sure that"
  209.                 dialog$(2%)="this is what you want to do ?"
  210.                 call Yes.No(yn$)
  211.                 if yn$="Y" then                  '  Yes, they're sure
  212.                     loop%=1%                      '  Exit the endless loop (paradox)
  213.                     call bit.close(3%)            '  Close the index
  214.                     call mark.file.closed(2%,512%)'  Write parameters
  215.                     close 2                       '  Truly closed
  216.                 end if
  217.             end if
  218.  
  219.         end if
  220.  
  221.     wend
  222.  
  223.     locate 24,1
  224.     print
  225.     print
  226.     print "NAMES returning you to DOS";
  227.  
  228.     end
  229.  
  230. rem $subtitle:'Read menu definitions from DATA statements'
  231. rem $page
  232. get.menu:
  233.     e.count%=0%
  234.     read mcount%
  235.     for mop%=1% to mcount%
  236.         e.count%=e.count%+1%
  237.         read ae.menu$(e.count%)
  238.     next mop%
  239.     for mop%=1% to mcount%
  240.         read sop%
  241.         for j%=1% to sop%
  242.             e.count%=e.count%+1%
  243.             read ae.menu$(e.count%)
  244.         next j%
  245.         ae.op%(mop%)=sop%
  246.     next mop%
  247.     return
  248.  
  249. disp.frame:                   ' Display text for selected record
  250.  
  251.     call qprint(nm$,9%,19%)
  252.     call qprint(tl$,11%,30%)
  253.     for j%=1% to 8%
  254.         call qprint(mid$(notes$,(j%-1%)*55%+1%,55%),j%+12%,13%)
  255.     next j%
  256.     return
  257.  
  258.  
  259.   sub names.frame static
  260.        call qprint("╒════════════════════════════════════════════════════════════╕",8,10)
  261.        call qprint("│Name:                                                       │",9,10)
  262.        call qprint("├────────────────────────────────────────────────────────────┤",10,10)
  263.        call qprint("│Telephone Number:                                           │",11,10)
  264.        call qprint("├────────────────────────────────────────────────────────────┤",12,10)
  265.        call qprint("│                                                            │",13,10)
  266.        call qprint("│                                                            │",14,10)
  267.        call qprint("│                                                            │",15,10)
  268.        call qprint("│                                                            │",16,10)
  269.        call qprint("│                                                            │",17,10)
  270.        call qprint("│                                                            │",18,10)
  271.        call qprint("│                                                            │",19,10)
  272.        call qprint("│                                                            │",20,10)
  273.        call qprint("╘═══════════════════════════NOTES════════════════════════════╛",21,10)
  274.   end sub ' names
  275.