Power-Programmierung/CD1.mdf/xbase/library/clipper/patches/menu.prg

Text File | 1991-01-28 | 17.0 KB | 502 lines

/*
 AUTHOR.....:ELMER O. LAUDENSLAGER, III
 PROGRAM....:MENU.PRG
 DATE.......:NOVEMBER 25, 1990
 PURPOSE....:CREATE PULL DOWN MENU BAR TYPE OF MENU STRUCTURE
 MODIFIED...:01/28/91
   WHY......:ADDED MUCHO COMMENTS TO THIS FILE WHILE THE PROGRAM IS
            :STILL FRESH IN MY MIND.  ALSO, SUBMISSION TO PC MAGAZINE
            :WILL BE IN THE MAIL SHORTLY. (AS WELL AS TO NANTUCKET)

 This is my method of creating pull down menus for use in Nantucket's
 Clipper 5.0  Note: these routines will not work with Clipper '87 or
 previous versions of Clipper or with dBASE III + without the extensive
 modification of this code. Do not delete the #INCLUDE 'Box.ch'
 line or this procedure will not compile!

 This is a brief description of what happens and how it works.  When the
 program starts, it sets up the color scheme that I like to use.  You may
 edit it to your satisfaction.  The first thing I do is draw the title with
 the draw_title() procedure.  This can be your client's company logo if you
 like.  It can be a complex, or as simple as you choose.  The next thing
 that happens is that the menus are initialized with the init_menus()
 procedure.  In the menu initialization procedures, the top bar, is created,
 the coordinates of all pull down boxes are created, and the x,y coordinates
 are obtained.

 All this program does is create a large DO WHILE..ENDDO with an EXIT out
 of the endless loop.  A complex case structure is processed from the
 information obtained from the use of a PROMPT statement and an ACHOICE call.
 The menu bar utilizes the PROMPT statement and the pull down menus uses the
 ACHOICE function.  The reason for using the ACHOICE function for the pull
 down menus is for the case that I have many selections under 1 heading.
 (It's possible, but not probable.)

 When the target is found, another procedure is called executing routines
 from that choice.  It may look complex (and it was an interesting application
 of brain power), it is functional!!!

 Why did I go to the trouble of creating this??? Well, I was getting bored
 with the simple up/down processing of menus.  Also, the world is going
 GUI (Graphical User Interface) and this is my (albeit pitiful) attempt to
 bring some of that kind of functionality to my customers programs.

 This code is functional.  This code works as it is contained herein.

*/

#INCLUDE 'Box.ch'
SET CURSOR OFF
SET CONFIRM OFF
SET SCOREBOARD OFF
SET BELL OFF
SET WRAP ON
PUBLIC normal, inverse, intense, black_white
PUBLIC flash_intense, get_color, save_main_area
if iscolor()
   normal = 'w/b,b/w,,b,+w/b'
   inverse = 'b/w'
   intense = '+w/b,b/w,,b,+w/b'
   flash_intense = '*+w/b,b/w,,b,*+w/b'
   black_white = 'w/n,n/w,,n,+w/n'
   get_color = 'W/B,GR+/N'
else
   normal = 'w/n,n/w,,n,+w/n'
   inverse = 'n/w'
   intense = '+w/n,n/w,,n,+w/n'
   flash_intense = '*+w/n,n/w,,n,*+w/n'
   black_white = 'w/n,n/w,,n,+w/n'
   get_color = '+w/n,n/w,,n,+w/n'
endif

draw_title()
init_menus()
main_ans = 1

DO WHILE .T.
   SETCOLOR(normal)
   main_ans = Menu_Bar(main_ans)            //Get the left & right choice
   sub_ans  = Choice(main_ans)              //Get the up & down choice
   sub_ans_process( sub_ans, @main_ans)     //Process the answers
   save_main_area = savescreen(00,00,24,79) //Save the entire screen
   if sub_ans <= 0                          //sub_ans will be <= 0 for
      loop                                  //the left or right arrow in
   endif                                    //or the ESC key from the
   do case                                  //processing of information from
                                            //the ACHOICE entries

      case main_ans = 0 .or. main_ans = len(menu_names)+1 // the quit array
      if sub_ans = 1
         exit
      endif

      case main_ans = 1
      do case
         case sub_ans = 1
            //help() // call your help routines here
            keyboard chr(13)
      end case

/*
 This is the first pull down menu selection.  What you do is have a
 procedure here that will get called when the selection is chosen.  If
 you refer to the init_menus() procedure, you will note that there are
 three choices in the menu_1 array.  They coorespond to sub_ans 1 thru
 sub_ans 3.  The same holds true for all of the other choices in the
 top bar.  There is a corresponding case (main_ans) for each choice
 across the top for each of the sub_ans gotten.  That's all there is to it!
*/

      case main_ans = 2
      do case
         case sub_ans = 1
            //proc() 1 here
         case sub_ans = 2
            //proc() 2 here
         case sub_ans = 3
            //proc() 3 here
      end case
      keyboard chr(13)

      case main_ans = 3
      do case
         case sub_ans = 1

         case sub_ans = 2

         case sub_ans = 3

         case sub_ans = 4

         case sub_ans = 5

         case sub_ans = 6

      end case
      keyboard chr(13)

      case main_ans = 4
      do case
         case sub_ans = 1

         case sub_ans = 2

      end case
      keyboard chr(13)

      case main_ans = 5
      do case
         case sub_ans = 1

         case sub_ans = 2

      end case
      keyboard chr(13)

      case main_ans = 6
      do case
         case sub_ans = 1

         case sub_ans = 2

      end case
      keyboard chr(13)

   end case
   restscreen(00,00,24,79,save_main_area)
ENDDO

SETCOLOR(BLACK_WHITE)
CLEAR SCREEN
SET CURSOR ON
RETURN

/*
 Whew!  If you have gotten thru this whole program and understand what I am
 trying to accomplish, Have one on me!!
 Elmer O. Laudenslager, III
*/


***************************************
* Procedures necessary for pull down  *
* menus.                              *
***************************************

***************************************
procedure init_menus()
***************************************
local x,y,z

/*
 The public statements below define zero length arrays to the menu_names
 array, the menu_X thru menu_X arrays, and the pos_X thru pos_X arrays.
 There must be 1 array in the form of menu_1 thru menu_X for each element
 in the menu_names array.  The same is true for the pos array.
*/

public menu_names[0]                             //array of menu names
public menu_1[0], menu_2[0], menu_3[0]           //arrays containing menu choices
public menu_4[0], menu_5[0], menu_6[0]
public pos_1[4], pos_2[4],pos_3[4],pos_quit[4]   //arrays containing coordinates for each pull down menu
public pos_4[4], pos_5[4],pos_6[4]
public quit[1]                                   //define quit array
quit[1] = ' Exit the Application '               //give quit element 1 a value
public top_menu                                  //public top_menu
top_menu = ''
// initialize all menu arrays.  make sure that there is 1 menu_name entry
// for each menu listed above.

aadd(menu_names,' Help ')    //initialize menu names array
aadd(menu_names,' First ')   //be sure that each name has a space
aadd(menu_names,' Second ')  //at both the beginning and end
aadd(menu_names,' Third ')   //for proper menuing spacing.
aadd(menu_names,' 4th ')     //If you keep each menu title unique,
aadd(menu_names,' 5th ')     //you can then use the first letter to select.
aadd(menu_1,'Help Index')            //initialize menu_1 choices
aadd(menu_2,'First')                 //initialize menu_2
aadd(menu_2,'Second')
aadd(menu_2,'Third')
aadd(menu_3,'1st Item')              //initialize menu_3
aadd(menu_3,'2nd Item')
aadd(menu_3,'3rd Item')
aadd(menu_3,'4th Item')
aadd(menu_3,'5th Item')
aadd(menu_3,'6th Item')
aadd(menu_4,'First Item in Menu 4')  //initialize menu_4
aadd(menu_4,'Second Item in Menu 4')
aadd(menu_5,'1st in 5')              //initialize menu_5
aadd(menu_5,'2nd in 5')
aadd(menu_6,'first in 6')            //initialize menu_6
aadd(menu_6,'first in 7')

for x = 1 to len(menu_names)           //create the top_menu value out of
   top_menu = top_menu + menu_names[x] //the menu_names array. Be sure that
next                                   //watch the size of your names.  You
                                       //only have 73 characters.  See below.

y = left(top_menu+space(73),73)
top_menu = y + 'Quit'                  //add the Quit to the top_menu, note,
                                       //top_menu will be truncated to 73
                                       //characters

/*
 Define positions of upper left corner.  If you want to move the menu
 down a couple of lines, change the top line to be different than 2.
*/

pos_1[1] = 2
pos_2[1] = 2
pos_3[1] = 2
pos_4[1] = 2
pos_5[1] = 2
pos_6[1] = 2

/*
 The code in this next block will define the starting position across the
 top of the menu bar for the box.  Note:  if you get too close to the right
 side of the screen, you should check into how the Quit box coordinates are
 handled.
*/

pos_1[2] = centr(top_menu)
pos_2[2] = centr(top_menu) + len(menu_names[1])
pos_3[2] = centr(top_menu) + len(menu_names[1]) + len(menu_names[2])
pos_4[2] = centr(top_menu) + len(menu_names[1]) + len(menu_names[2]) + len(menu_names[3])
pos_5[2] = centr(top_menu) + len(menu_names[1]) + len(menu_names[2]) + len(menu_names[3]) + len(menu_names[4])
pos_6[2] = centr(top_menu) + len(menu_names[1]) + len(menu_names[2]) + len(menu_names[3]) + len(menu_names[4]) + len(menu_names[5])

/*
 This next block gets the length of the menu choices array.  If the number
 of options in a menu is greater than 7, then the ACHOICE function will
 handle scrolling of the options in the pull down box.  You can change the
 bottom line (10) to a higher or lower limit but be aware that you must
 also change the value of 7 up and down by the same amount that you change
 the value of 10.
*/

pos_1[3] = iif(len(menu_1) > 7,10,len(menu_1)+3)
pos_2[3] = iif(len(menu_2) > 7,10,len(menu_2)+3)
pos_3[3] = iif(len(menu_3) > 7,10,len(menu_3)+3)
pos_4[3] = iif(len(menu_4) > 7,10,len(menu_4)+3)
pos_5[3] = iif(len(menu_5) > 7,10,len(menu_5)+3)
pos_6[3] = iif(len(menu_6) > 7,10,len(menu_6)+3)

/*
 And finally, the fourth coordinate that is necessary for the ACHOICE as well
 as other functions is obtained.
*/

z = 0
for x = 1 to len(menu_1)
   if z < len(menu_1[x])
      z = len(menu_1[x])
   endif
next
pos_1[4] = z + pos_1[2] + 1

z = 0
for x = 1 to len(menu_2)
   if z < len(menu_2[x])
      z = len(menu_2[x])
   endif
next
pos_2[4] = z + pos_2[2] + 1

z = 0
for x = 1 to len(menu_3)
   if z < len(menu_3[x])
      z = len(menu_3[x])
   endif
next
pos_3[4] = z + pos_3[2] + 1

z = 0
for x = 1 to len(menu_4)
   if z < len(menu_4[x])
      z = len(menu_4[x])
   endif
next
pos_4[4] = z + pos_4[2] + 1

z = 0
for x = 1 to len(menu_5)
   if z < len(menu_5[x])
      z = len(menu_5[x])
   endif
next
pos_5[4] = z + pos_5[2] + 1

z = 0
for x = 1 to len(menu_6)
   if z < len(menu_6[x])
      z = len(menu_6[x])
   endif
next
pos_6[4] = z + pos_6[2] + 1

// A note on positioning.  If the number of options across the menu bar
// becomes too numerous or lengthy, you may have to adopt the "Quit"
// sequence for the menu positioning.

// position the Quit array.  will always be here

pos_quit[2] = 78 - (len(quit[1]) + 1)
pos_quit[1] = 2
pos_quit[4] = 78
pos_quit[3] = iif(len(quit) > 7,10,len(quit)+3)
return

***************************************
function Menu_Bar( mch )
***************************************
local _main_choice
_main_choice = mch
@ 00,00,02,79 box B_DOUBLE
@ 01,centr(top_menu) say top_menu
   set message to 22 center
   @ 01, centr(top_menu) PROMPT menu_names[1] message '' //Prompt for the first menu choice.  \
   @ 01, col()           PROMPT menu_names[2] message '' //Prompt for menu 2.                  | Note, all of the messages
   @ 01, col()           PROMPT menu_names[3] message '' //Prompt for menu 3.                  | must be the same size.
   @ 01, col()           PROMPT menu_names[4] message '' //Prompt for menu 4.                  | If they are not, you will
   @ 01, col()           PROMPT menu_names[5] message '' //Prompt for menu 5.                  | have smaller ones over-
   @ 01, col()           PROMPT menu_names[6] message '' //Prompt for menu 6.             | lapping portions of the
   @ 01, 73              PROMPT ' Quit '      message '' //Prompt for the exit.               /  longer ones.

   menu to _main_choice                           //Get menu choice

return _main_choice

***************************************
function choice( _main_choice )
***************************************
local choice, scr_save
//
// a case statement will bee needed for each of the options across the
// menu bar. you will have to manually add or delete a case as necessary.
//

//
// what is happening on each of the items in the case is that the box
// area is first saved.  next the box "B_DOUBLE_SINGLE" is drawn,
// then the achoice function is called. finally, the saved area is
// restored.
//
do case
   case _main_choice = len(menu_names) + 1 .or. _main_choice = 0
      scr_save = savescreen(pos_quit[1],pos_quit[2],pos_quit[3],pos_quit[4])
      @ pos_quit[1], pos_quit[2], pos_quit[3], pos_quit[4] box B_DOUBLE_SINGLE
      choice = achoice(pos_quit[1]+1, pos_quit[2]+1, pos_quit[3]-1,pos_quit[4]-1,quit)
      restscreen(pos_quit[1],pos_quit[2],pos_quit[3],pos_quit[4],scr_save)

   case _main_choice = 1
      scr_save = savescreen(pos_1[1],pos_1[2],pos_1[3],pos_1[4])
      @ pos_1[1], pos_1[2], pos_1[3], pos_1[4] box B_DOUBLE_SINGLE
      choice = achoice(pos_1[1]+1, pos_1[2]+1, pos_1[3]-1,pos_1[4]-1,menu_1)
      restscreen(pos_1[1],pos_1[2],pos_1[3],pos_1[4],scr_save)

   case _main_choice = 2
      scr_save = savescreen(pos_2[1],pos_2[2],pos_2[3],pos_2[4])
      @ pos_2[1], pos_2[2], pos_2[3], pos_2[4] box B_DOUBLE_SINGLE
      choice = achoice(pos_2[1]+1, pos_2[2]+1, pos_2[3]-1,pos_2[4]-1,menu_2)
      restscreen(pos_2[1],pos_2[2],pos_2[3],pos_2[4],scr_save)

   case _main_choice = 3
      scr_save = savescreen(pos_3[1],pos_3[2],pos_3[3],pos_3[4])
      @ pos_3[1], pos_3[2], pos_3[3], pos_3[4] box B_DOUBLE_SINGLE
      choice = achoice(pos_3[1]+1, pos_3[2]+1, pos_3[3]-1,pos_3[4]-1,menu_3)
      restscreen(pos_3[1],pos_3[2],pos_3[3],pos_3[4],scr_save)

   case _main_choice = 4
      scr_save = savescreen(pos_4[1],pos_4[2],pos_4[3],pos_4[4])
      @ pos_4[1], pos_4[2], pos_4[3], pos_4[4] box B_DOUBLE_SINGLE
      choice = achoice(pos_4[1]+1, pos_4[2]+1, pos_4[3]-1,pos_4[4]-1,menu_4)
      restscreen(pos_4[1],pos_4[2],pos_4[3],pos_4[4],scr_save)

   case _main_choice = 5
      scr_save = savescreen(pos_5[1],pos_5[2],pos_5[3],pos_5[4])
      @ pos_5[1], pos_5[2], pos_5[3], pos_5[4] box B_DOUBLE_SINGLE
      choice = achoice(pos_5[1]+1, pos_5[2]+1, pos_5[3]-1,pos_5[4]-1,menu_5)
      restscreen(pos_5[1],pos_5[2],pos_5[3],pos_5[4],scr_save)

   case _main_choice = 6
      scr_save = savescreen(pos_6[1],pos_6[2],pos_6[3],pos_6[4])
      @ pos_6[1], pos_6[2], pos_6[3], pos_6[4] box B_DOUBLE_SINGLE
      choice = achoice(pos_6[1]+1, pos_6[2]+1, pos_6[3]-1,pos_6[4]-1,menu_6)
      restscreen(pos_6[1],pos_6[2],pos_6[3],pos_6[4],scr_save)
end case

//
// should the user press the left or right arrow or the esc key, the
// case statement below will either return a -1 or -2 for arrow key,
// 0 for the esc key, or the actual choice.
//

do case
   case lastkey() = 19
      return -1

   case lastkey() = 4
      return -2

   case lastkey() = 27
      return 0

   otherwise
      return choice
end case
return

***********************
procedure draw_title( )
***********************
   SETCOLOR(normal)
   CLEAR SCREEN
   @ 10, 00 SAY '═══════════════════════════════════════════════════════════════════════════════'
   @ 14, 00 SAY '───────────────────────────────────────────────────────────────────────────────'
   @ 00,00,02,79 BOX B_DOUBLE
   msg = 'Y O U R   C O M P A N Y   N A M E   H E R E'
   setcolor(intense)
   @ 12, CENTR(msg) SAY msg
   msg = 'Your Company Name'
   @ 16, CENTR(msg) SAY msg
   msg = 'Your Street Address'
   @ 17, CENTR(msg) SAY msg
   msg = 'Your City, State, Zip'
   @ 18, CENTR(msg) SAY msg
return

*****************************************************
procedure sub_ans_process( sub_choice, main_choice  )
*****************************************************
/*
   if the left or right arrow was pressed, this procedure will increment
   or decrement the main_choice and stuff the keyboard with the return
   key so that the next pull down menu will go into effect.
*/

   do case
      case sub_choice = -1
         main_choice = main_choice - 1
         if main_choice = 0
            main_choice = len(menu_names) + 1
         endif
         keyboard chr(13)

      case sub_choice = -2
         main_choice = main_choice + 1
         if main_choice = len(menu_names) + 2
            main_choice = 1
         endif
         keyboard chr(13)
   end case
return

**************
FUNCTION centr
**************
PARAMETERS in_string, in_length
IF TYPE('in_length') = 'U'
  in_length = 80
ENDI
RETURN INT((in_length - LEN(in_string))/2)