*! 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