Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
A 15-30 minute VFP Brain Teaser
Message
From
04/09/2006 17:55:23
 
 
To
All
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Title:
A 15-30 minute VFP Brain Teaser
Miscellaneous
Thread ID:
01150789
Message ID:
01150789
Views:
82
*!  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
Next
Reply
Map
View

Click here to load this message in the networking platform