home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
dba0187.zip
/
MAKEMENU.PRG
< prev
next >
Wrap
Text File
|
1986-12-05
|
8KB
|
244 lines
* Program..: MAKEMENU.PRG
* Author...: Lane Coddington.
* Date.....: August 18, 1986
* Notice...: Copyright 1986, Lane Coddington Consulting.
* Notes....: Makes a menu centered top to bottom and side to side.
* For dBASE III Plus or Clipper.
* Called By: The dot prompt.
*********************************************************************
CLEAR
CLEAR ALL
SET TALK OFF
SET BELL OFF
SET SAFETY OFF
SET STATUS OFF
* Change this prompt if you want.
askprompt = [Please choose an option]
******************************
* Section 1. Get the text for the menu.
title = [ Make a Centered Menu ]
@ 1,(79 - LEN(title))/2 GET title
CLEAR GETS
* Get the four letter name of the menu.
prgname = SPACE(4)
@ 3,25 SAY [Name of menu and program] GET prgname PICTURE [@!]
READ
IF LEN(TRIM(prgname)) = 0
RETURN
ENDIF
prgname = TRIM(prgname) + [MENU]
memfile = prgname + [.MEM]
prgfile = prgname + [.PRG]
* Find out if a memory file for this menu already exists.
IF FILE(memfile)
RESTORE FROM &memfile ADDITIVE
ELSE
* Initialize all memvars -- title and all lines.
menutitle = SPACE(55)
counter = [01]
DO WHILE counter <= [18]
menuline&counter = SPACE(60)
counter = RIGHT(STR(101 + VAL(counter),3),2)
ENDDO
menulimits = SPACE(19)
menutempla = SPACE(1)
menushape = SPACE(1)
ENDIF
* Get the title, all of the lines of the menu, READ limits,
* PICTURE template, and the type of box border.
CLEAR
@ 1, 5 SAY [Menu Title] GET menutitle
counter = [01]
DO WHILE counter <= [18]
@ (VAL(counter) + 2), 5 SAY [menuline&counter] GET menuline&counter
counter = RIGHT(STR(101 + VAL(counter),3),2)
ENDDO
@ 21, 5 SAY [ Allowable limits for the READ];
GET menulimits PICTURE [@!]
@ 22, 5 SAY [ Template for the PICTURE (9 or !)];
GET menutempla PICTURE [!]
@ 23, 5 SAY [Box Border (1 = Solid, 2 = Double, 3 = Single)];
GET menushape PICTURE [9]
READ
@ 24, 5 SAY [Please wait. . .]
* Save all of the lines to a memory file for future editing.
SAVE ALL LIKE menu* TO &memfile
******************************
* Section 2. Calculate row and column coordinates and prepare
* box borders.
* Make the title a little longer and assume it is the longest line.
menutitle = [ ] + TRIM(menutitle) + [ ]
maxlength = LEN(menutitle) + 3
* Go through all menu lines to find the longest line and the
* total number of lines.
counter = [01]
DO WHILE counter <= [18]
menuline&counter = TRIM(menuline&counter)
IF LEN(menuline&counter) > maxlength
maxlength = LEN(menuline&counter)
ENDIF
IF LEN(menuline&counter) > 0
maxline = VAL(counter)
ENDIF
counter = RIGHT(STR(101 + VAL(counter),3),2)
ENDDO
* See if the prompt is longer than or equal to any of the lines.
IF LEN(askprompt) >= maxlength
askprompt = [ ] + askprompt
maxlength = LEN(askprompt) + 2
ENDIF
* Increase the width of the box by one to leave a left margin of 1.
maxlength = maxlength + 1
* Figure out the left margin, top line, and bottom line.
lcolumn = INT((79 - maxlength)/2)
topline = INT((24 - maxline)/2) - 3
botline = topline + maxline + 5
* Pad each menu line with the appropriate number of blank spaces.
counter = [01]
DO WHILE VAL(counter) <= maxline
menuline&counter =;
STUFF(SPACE(maxlength),2,LEN(menuline&counter),menuline&counter)
counter = RIGHT(STR(101 + VAL(counter),3),2)
ENDDO
* Figure out where to put the GET and pad the prompt
* with blank spaces
extraspace = maxlength - LEN(askprompt)
position = lcolumn + LEN(askprompt) + INT(extraspace/2) + 1
askprompt = STUFF(SPACE(extraspace),INT(extraspace/2),0,askprompt)
* Prepare the box.
DO CASE
CASE menushape = [1] && Solid Line.
topside = CHR(222) + REPLICATE(CHR(223),maxlength) + CHR(221)
rightside = CHR(221)
bottomside = CHR(222) + REPLICATE(CHR(220),maxlength) + CHR(221)
leftside = CHR(222)
CASE menushape = [2] && Double Line.
topside = CHR(201) + REPLICATE(CHR(205),maxlength) + CHR(187)
rightside = CHR(186)
bottomside = CHR(200) + REPLICATE(CHR(205),maxlength) + CHR(188)
leftside = CHR(186)
OTHERWISE && Single Line.
topside = CHR(218) + REPLICATE(CHR(196),maxlength) + CHR(191)
rightside = CHR(179)
bottomside = CHR(192) + REPLICATE(CHR(196),maxlength) + CHR(217)
leftside = CHR(179)
ENDCASE
******************************
* Section 3. Make the program.
SET ALTERNATE TO &prgfile
* Put up a header, clear screen and initialize internal memvars.
SET ALTERNATE ON
? [* Program..: ] + prgfile
? [* Author...: Your Name.]
? [* Date.....: ] + CMONTH(DATE()) + [ ] + STR(DAY(DATE()),2) +;
[, ] + STR(YEAR(DATE()),4)
? [* Notice...: Your Copyright or other notice.]
? [* Notes....: ]
? [* Called By: ]
? [* Local....: menutitle, botline]
? [* Incoming.: which_act,C - a memvar to hold the user's response.]
? [* clipper, L - a PUBLIC memvar to indicate whether]
? [* program is compiled.]
? [* Outgoing.: which_act $"] + TRIM(menulimits) + ["]
? [*****************************************************************]
? [PARAMETERS which_act]
? [CLEAR]
? [menutitle = "] + menutitle + ["]
? [botline = ] + STR(botline,2)
?
SET ALTERNATE OFF
* Make the top three lines of the menu.
* Center the title in reverse video.
SET ALTERNATE ON
? [@ ] + STR(topline,2) + [,] + STR(lcolumn,2) + [ SAY "] +;
topside + ["]
? [@ ] + STR(topline + 1,2) + [,] + STR(lcolumn,2) + [ SAY "] +;
leftside + SPACE(maxlength) + rightside + ["]
? [@ ] + STR(topline + 1,2) + [,] +;
STR(lcolumn + 1 + ((maxlength - LEN(menutitle))/2),2) +;
[ GET menutitle]
? [@ ] + STR(topline + 2,2) + [,] + STR(lcolumn,2) + [ SAY "] +;
leftside + SPACE(maxlength) + rightside + ["]
SET ALTERNATE OFF
* Put together each line of the menu body.
counter = [01]
DO WHILE VAL(counter) <= maxline
SET ALTERNATE ON
? [@ ] + STR(topline + 2 + VAL(counter),2) + [,] + STR(lcolumn,2) +;
[ SAY "] + leftside + menuline&counter + rightside + ["]
SET ALTERNATE OFF
counter = RIGHT(STR(101 + VAL(counter),3),2)
ENDDO
* Make the bottom 3 lines including the ask prompt centered.
SET ALTERNATE ON
? [@ ] + STR(botline - 2,2) + [,] + STR(lcolumn,2) + [ SAY "] +;
leftside + SPACE(maxlength) + rightside + ["]
? [@ ] + STR(botline - 1,2) + [,] + STR(lcolumn,2) + [ SAY "] +;
leftside + askprompt + rightside + ["]
? [@ ] + STR(botline,2) + [,] + STR(lcolumn,2) + [ SAY "] +;
bottomside + ["]
SET ALTERNATE OFF
* Finish up with a loop to get the user's response and erase the box.
SET ALTERNATE ON
? [CLEAR GETS]
?
? [* Get the user's desire.]
? [DO WHILE .T.]
? [ which_act = " "]
? [ @ ] + STR(botline - 1,2) + [,] + STR(position,2) +;
[ GET which_act PICTURE "] + menutempla + ["]
? [ READ]
? [ IF which_act $"] + TRIM(menulimits) + ["]
? [ EXIT]
? [ ENDIF]
? [ ?? CHR(7)]
? [ENDDO]
?
? [* Erase the box.]
? [IF clipper]
? [ * Erase the box one line at a time from the bottom.]
? [ DO WHILE botline >= ] + STR(topline,2)
? [ @ botline,] + STR(lcolumn,2) + [ SAY SPACE(] +;
STR(maxlength + 2,2) + [)]
? [ botline = botline - 1]
? [ ENDDO]
? [ELSE]
? [ CLEAR]
? [ENDIF]
? [* EOF: ] + prgfile
SET ALTERNATE OFF
CLOSE ALTERNATE
******************************
* Section 4. Test it five times.
PUBLIC clipper
test_count = 1
which_act = [ ]
DO WHILE test_count <= 5
DO &prgfile WITH which_act
test_count = test_count + 1
ENDDO
* EOF: MAKEMENU.PRG