Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
A 15-30 minute VFP Brain Teaser
Message
From
04/09/2006 18:31:00
Hilmar Zonneveld
Independent Consultant
Cochabamba, Bolivia
 
 
To
04/09/2006 17:55:23
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Miscellaneous
Thread ID:
01150789
Message ID:
01150796
Views:
21
The getlet() function can be greatly shortened. All the IFs can be combined into a single expression, by using the chr() function to convert from number to character. For example, "A" = chr(64 + 1), "B" = chr(64 + 2), etc.

>
>*!  A 15-30 Minute VFP9 Brain Teaser!
>*!
>*!  We recently compiled some code that up until version 9.0 had been
>*!  running fine.  It was initially developed in 2.6 DOS(!) and adapted to run in
>*!  both DOS and Windows and worked fine up through VFP6.  However, with VFP9
>*!  running XP it developed a symptom we are sure is an easy catch for somebody
>*!  with just a little more VFP9 experience than us!
>*!
>*!  The following program sets up and displays a menu on the screen.  If you use
>*!  the up and down arrows it works fine.  If you hit the letter it works fine.
>*!  However, if you use the mouse, the menu blanks out when the pointer 'flys-over'
>*!  the menu buttons.  They are still active and you can select them but something
>*!  is either not refreshing, or blanking out the screen.
>*!
>*!  We initially tested it on Server 2003 and it works fine with VFP9.  You just
>*!  get this behavior with XP.  It is probably a default property that has to be
>*!  set but we can not seem to find it.
>*!
>*!  Any Help would be appreciated!!!
>*!
>*!*****************************************************************************
>*!
>*!      Procedure: MENUTEST.PRG
>*!
>*!*****************************************************************************
>
>*
>*  Set up variables and values
>*
>
>set procedure to menutest
>public secok, retval, nf, nf1, word, colstr
>
>set color to rgb(0,0,0,192,192,192)
>modify window screen font 'courier', 8
>
>dimension mnu(15)
>store 'rgb(0,0,0,255,255,255),rgb(0,0,0,192,192,192)' to colstr
>store 'W' to word
>clear
>
>*
>*  Create menu testing loop
>*
>
>do while .t.
>
>   *
>   *  Clear out and load menu array, set up parameter values.
>   *
>
>   do clrmenu
>
>   store 'Login To System       ' to mnu(1)
>   store 'File Maintenance Menu ' to mnu(2)
>   store 'Reporting Menus       ' to mnu(3)
>   store 'Software Tech Support ' to mnu(4)
>   store 'Administrator Menu    ' to mnu(5)
>   store 'Utilities Menu        ' to mnu(6)
>   store 'Graphic/Logo Selection' to mnu(7)
>   store 'Quit This Screen      ' to mnu(8)
>   store 8 to numel
>   store 2 to xcoord
>   store 2 to ycoord
>   store ' Master Menu ' to mtitle
>
>   *
>   *  Call the menu program and accept the next value back into variable NF
>   *
>
>   do cmenu with xcoord, ycoord, numel, mtitle, mnu
>
>   store substr(mchoice,1,1) to nf
>
>   wait window '   Choice is '+nf+'   '
>
>   *
>   *  Quit if Q is selected
>   *
>
>   if nf = 'Q'
>      return
>   endif nf = 'Q'
>
>enddo while .t.
>
>*!*****************************************************************************
>*!
>*!      Procedure: CMENU
>*!
>*!*****************************************************************************
>
>procedure cmenu
>
>parameter xcoord, ycoord, numel, mtitle, mnu
>
>public mchoice, mchoice1
>store 1 to zctr
>store 0 to longest
>
>*
>* Identify longest element in the array
>*
>
>do while zctr <= numel
>
>   if len(rtrim(mnu(zctr))) > longest
>      store len(rtrim(mnu(zctr))) to longest
>   endif len(rtrim(mnu(zctr))) > longest
>
>   zctr = zctr + 1
>
>enddo while zctr <= numel
>
>*
>* Define the window
>*
>
>if ycoord > 12
>   adder = -9
>else
>   adder = 0
>endif ycoord<10
>
>zxadd = val(str((numel * 1.25)+1,5,0))
>
>zysub = val(str(longest *.2,5,0))
>
>define window menuwin;
>   from xcoord,ycoord+adder;
>   to xcoord+3+zxadd,ycoord+longest+adder-zysub+11;
>   title mtitle;
>   color &colstr;
>   system;
>   float;
>   font 'Arial'
>
>activate window menuwin
>
>if word = 'W'
>
>   *
>   * Activate first menu option
>   *
>
>   store 'N' to mchoice1
>   store '*' to base
>   store ' ' to addl1
>   store ' ' to addl2
>   store 1 to zctr
>
>   *
>   * Display the menu elements
>   *
>   store 1 to zctr
>
>   do while zctr <= numel
>
>      @ zctr,2 say mnu(zctr)
>      zctr = zctr + 1
>
>   enddo while zctr <= numel
>
>   store 1 to zctr
>
>   do while zctr <= numel .and. zctr <= 8
>
>      store substr(mnu(zctr),1,1) to zxc
>      store addl1+'\<&zxc;' to addl1
>      zctr = zctr + 1
>
>   enddo while zctr <= numel
>
>   do while zctr <= numel .and. zctr <= 16
>
>      store substr(mnu(zctr),1,1) to zxc
>      store addl2+'\<&zxc;' to addl2
>
>      zctr = zctr + 1
>
>   enddo while zctr <= numel
>
>   store len(addl1) to ad1
>   store len(addl2) to ad2
>
>   store base+substr(addl1,1,ad1-1) to mprompt1
>   store base+substr(addl2,1,ad2-1) to mprompt2
>
>   @ 1,longest+7 get mchoice1 function mprompt1 size 1, 5 color &colstr font 'arial' style 'bi'
>
>   if numel > 8
>      @ 9,longest+7 get mchoice1 function mprompt2 size 1, 5 color &colstr font 'arial' style 'bi'
>   endif numel > 8
>
>   read
>
>   *
>   * Deactivate and release the window
>   *
>
>   deactivate window menuwin
>
>   release window menuwin
>
>   store substr(mchoice1,1,1) to mchoice
>
>   return
>
>endif word = 'W'
>
>store 1 to cursel
>store 0 to invar
>
>do while .t.
>
>   *
>   * Display the menu elements
>   *
>
>   store 1 to zctr
>
>   do while zctr <= numel
>
>      @ zctr,2 say mnu(zctr)
>      zctr = zctr + 1
>
>   enddo while zctr <= numel
>
>   *
>   * Deactivate old choice
>   *
>
>   @ cursel,2 say padr(mnu(cursel),longest,' ')
>
>   *
>   * Manipulate up and down arrows
>   *
>
>   if invar = 5
>      cursel = cursel - 1
>      if cursel = 0
>         store numel to cursel
>      endif cursel = 0
>   endif invar = 5
>
>   if invar = 24
>      cursel = cursel + 1
>      if cursel = numel + 1
>         store 1 to cursel
>      endif cursel = numel + 1
>   endif invar = 24
>
>   *
>   * Convert any other input to a letter
>   *
>
>   store ' ' to lookup
>   do getlet
>
>   *
>   * Check to see if a valid letter
>   *
>
>   store 'N' to validlet
>
>   if lookup <> ' '
>
>      store 1 to zctr
>
>      do while zctr <= numel
>
>         if lookup = substr(mnu(zctr),1,1)
>            store 'Y' to validlet
>            exit
>         endif lookup = substr(mnu(zctr),1,1)
>
>         zctr = zctr + 1
>
>      enddo while zctr <= numel
>
>   endif lookup <> ' '
>
>   *
>   * If valid, change cursel to corresponding option
>   *
>
>   if validlet = 'Y'
>      store zctr to cursel
>   endif validlet = 'Y'
>
>   *
>   * Highlight activated choice
>   *
>
>   @ cursel,2 say padr(mnu(cursel),longest,' ') color i
>
>   if invar = 13
>      exit
>   endif invar = 13
>
>   invar = inkey(0,'H')
>
>enddo .t.
>
>*
>* Deactivate and release the window
>*
>
>deactivate window menuwin
>
>release window menuwin
>
>store substr(mnu(cursel),1,1) to mchoice
>
>return
>
>*!*****************************************************************************
>*!
>*!      Procedure: GETLET
>*!
>*!*****************************************************************************
>
>procedure getlet
>
>if invar = 97 .or. invar = 65
>   store 'A' to lookup
>endif invar = 97 .or. invar = 65
>
>if invar = 98 .or. invar = 66
>   store 'B' to lookup
>endif invar = 98 .or. invar = 66
>
>if invar = 99 .or. invar = 67
>   store 'C' to lookup
>endif invar = 99 .or. invar = 67
>
>if invar = 100 .or. invar = 68
>   store 'D' to lookup
>endif invar = 100 .or. invar = 68
>
>if invar = 101 .or. invar = 69
>   store 'E' to lookup
>endif invar = 101 .or. invar = 69
>
>if invar = 102 .or. invar = 70
>   store 'F' to lookup
>endif invar = 102 .or. invar = 70
>
>if invar = 103 .or. invar = 71
>   store 'G' to lookup
>endif invar = 103 .or. invar = 71
>
>if invar = 104 .or. invar = 72
>   store 'H' to lookup
>endif invar = 104 .or. invar = 72
>
>if invar = 105 .or. invar = 73
>   store 'I' to lookup
>endif invar = 105 .or. invar = 73
>
>if invar = 106 .or. invar = 74
>   store 'J' to lookup
>endif invar = 106 .or. invar = 74
>
>if invar = 107 .or. invar = 75
>   store 'K' to lookup
>endif invar = 107 .or. invar = 75
>
>if invar = 108 .or. invar = 76
>   store 'L' to lookup
>endif invar = 108 .or. invar = 76
>
>if invar = 109 .or. invar = 77
>   store 'M' to lookup
>endif invar = 109 .or. invar = 77
>
>if invar = 110 .or. invar = 78
>   store 'N' to lookup
>endif invar = 110 .or. invar = 78
>
>if invar = 111 .or. invar = 79
>   store 'O' to lookup
>endif invar = 111 .or. invar = 79
>
>if invar = 112 .or. invar = 80
>   store 'P' to lookup
>endif invar = 112 .or. invar = 80
>
>if invar = 113 .or. invar = 81
>   store 'Q' to lookup
>endif invar = 113 .or. invar = 81
>
>if invar = 114 .or. invar = 82
>   store 'R' to lookup
>endif invar = 114 .or. invar = 82
>
>if invar = 115 .or. invar = 83
>   store 'S' to lookup
>endif invar = 115 .or. invar = 83
>
>if invar = 116 .or. invar = 84
>   store 'T' to lookup
>endif invar = 116 .or. invar = 84
>
>if invar = 117 .or. invar = 85
>   store 'U' to lookup
>endif invar = 117 .or. invar = 85
>
>if invar = 118 .or. invar = 86
>   store 'V' to lookup
>endif invar = 118 .or. invar = 86
>
>if invar = 119 .or. invar = 87
>   store 'W' to lookup
>endif invar = 119 .or. invar = 87
>
>if invar = 120 .or. invar = 88
>   store 'X' to lookup
>endif invar = 120 .or. invar = 88
>
>if invar = 121 .or. invar = 89
>   store 'Y' to lookup
>endif invar = 121 .or. invar = 89
>
>if invar = 122 .or. invar = 90
>   store 'Z' to lookup
>endif invar = 122 .or. invar = 90
>
>if invar >= 48 .and. invar <=57
>   store str(invar-48,1,0) to lookup
>endif invar >= 48 .and. invar <=57
>
>return
>
>*!*****************************************************************************
>*!
>*!      Procedure: CLRMENU
>*!
>*!*****************************************************************************
>
>procedure clrmenu
>
>store 1 to ctr
>
>do while ctr <= 15
>
>   store '                         ' to mnu(ctr)
>   store ctr + 1 to ctr
>
>enddo while ctr <= 30
>
>return
>
>
Difference in opinions hath cost many millions of lives: for instance, whether flesh be bread, or bread be flesh; whether whistling be a vice or a virtue; whether it be better to kiss a post, or throw it into the fire... (from Gulliver's Travels)
Previous
Reply
Map
View

Click here to load this message in the networking platform