home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 24
/
CD_ASCQ_24_0995.iso
/
vrac
/
homonlib.zip
/
EDITBOX.BAS
< prev
next >
Wrap
BASIC Source File
|
1995-04-13
|
5KB
|
132 lines
DEFINT A-Z
' $INCLUDE: 'PARM.INC'
' $INCLUDE: 'SETCURS.INC'
' $INCLUDE: 'TRUEFALS.INC'
DECLARE FUNCTION EditBox$ (msg$(), orig$, parm())
DECLARE FUNCTION EditBox2$ (msg$, orig$, parm())
'External procedures:
DECLARE SUB BoxCalc (t, l, b, r, tall, wide)
DECLARE FUNCTION EdStr$ (o$, parm())
DECLARE FUNCTION GetKey$ (parm())
DECLARE SUB PopBox (t, l, b, r, wide, msg$(), parm())
DECLARE SUB RestScreen (f$)
DECLARE SUB SaveScreen (f$)
DECLARE SUB SetView (t, b, parm())
DECLARE FUNCTION TempName$ (p$)
DECLARE FUNCTION VPage (p)
FUNCTION EditBox$ (msg$(), orig$, parm())
'****************************************************************************
'Basically, it's EdStr$() in a pop-up box. Send an array of text to show
' along with the string to be edited, and the return values are the same as
' EdStr$().
'
' parm(1) = top left row 0=Center
' parm(2) = top left column 0=Center
' parm(3) = box border type 1-4. See SUB Panes() for numeric boxtypes.
' parm(4) = message justification <0=Left 0=Center >0=Right
' parm(5) = maximum length of the string to be edited 1-77
' parm(6) = initial insert/overwrite mode (Use the SETCURS.INC constants)
' parm(7) = initial character position within the edit string.
' parm(8) = restrict input? (See EDSTR.INC)
'
'Due to the width of the box & shadow, EditBox$() effectively limits the
' maximum length of the EdStr$() to 77 characters.
'
'If a combination of any of the above parameters causes a portion of the box
' to exceed the screen boundaries, a run-time error will occur.
'
'See function EdStr$() for more detailed information.
'
'****************************************************************************
' *** Preliminary Calculations ***
REDIM temp(1 TO MAXPARM) 'Make a duplicate parm() array to
FOR x = MINPARM TO MAXPARM 'pass to EdStr$().
temp(x) = parm(x)
NEXT x
temp(3) = parm(5) 'Copy the appropriate parm() values
temp(4) = parm(6) 'to the temp array in the proper
temp(5) = parm(7) 'positions for EdStr$(). Everything
temp(10) = parm(8) 'else is zero.
wide = 0: tall = 0 'Find out how wide and tall to make
FOR x = LBOUND(msg$) TO UBOUND(msg$) 'the box. Use either the longest
l = LEN(msg$(x)) 'message or the maxlen of EdStr$().
IF l > wide THEN wide = l
tall = tall + 1
NEXT x
IF parm(5) > wide THEN wide = parm(5)
tall = tall + 2 'Allow for a blank line & EdStr$().
row1 = parm(1) 'Calculate where to place the box.
col1 = parm(2)
BoxCalc row1, col1, row2, col2, tall, wide
temp(1) = row2 - 1 'Calculate the row & column where the
IF parm(5) = wide THEN 'EdStr$() will be located.
temp(2) = col1 + 1
ELSE
temp(2) = col1 + 1 + ((wide - parm(5)) \ 2)
END IF
' *** Draw the Box ***
oldrow = CSRLIN 'Save the current cursor location
oldcol = POS(0)
savepage = VPage(0) 'Allocate a video page to save the
IF savepage = 0 THEN 'current screen on. If unable to get
savefile$ = TempName$("") 'one, we'll have to use the slower
SaveScreen savefile$ 'method of saving it to an actual
ELSE 'file.
PCOPY 0, savepage
END IF
PopBox row1, col1, row2, col2, wide, msg$(), parm()
' *** Let EdStr$() do its thing! ***
COLOR parm(FGWS), parm(BGWS)
EditBox$ = EdStr$(orig$, temp())
' *** Clean up after ourselves ***
ERASE temp 'Nuke the temporary array.
IF savepage = 0 THEN 'Restore the previous screen.
RestScreen savefile$
KILL savefile$
ELSE
PCOPY savepage, 0
x = VPage(savepage)
END IF
SetView -1, -1, parm() 'Restore the previous viewport.
COLOR parm(FGN), parm(BGN) 'Set the colors back to normal.
LOCATE oldrow, oldcol 'Put the cursor where it was.
END FUNCTION
FUNCTION EditBox2$ (msg$, orig$, parm())
'****************************************************************************
'Exactly the same as EditBox$(), but you pass a single text string as a
' message instead of an array. Just saving you a little coding.
'
'See EditBox$() for all the details.
'
'****************************************************************************
REDIM msg$(1 TO 1)
msg$(1) = msg$
EditBox2$ = EditBox$(msg$(), orig$, parm())
ERASE msg$
END FUNCTION