Category : BASIC Source Code
Archive   : QBDIALOG.ZIP
Filename : DIALOG.BAS
' Editor function that I have found and modified
' I would like to give credit to Tom Hanlin for his
' efforts in pblcone
' and credit to the orignal author of the edit function that i have
' used and modified.
' This program will show you how to create dialog box's using
' pbclone
' I hope that this is usefull and would appericate any suggestions
DECLARE SUB ScrRest (Array%(), Page%, Fast%)
DECLARE SUB ScrSave (Array%(), Page%, Fast%)
DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
DECLARE SUB WindowMan2 (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, FSt$, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
DECLARE SUB WindowMan3 (ParmList%(), Title$)
DECLARE SUB WindowMan4 (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Attr%, Page%, Fast%)
declare SUB editor (text$, Row%, Leftcol%, Rightcol%, Fore%, Back%, keycode%)
dim array%(2000)
scrsave array%(),0,0
' first box and window
TopRow%=9: LeftCol%=20: BottomRow%=11: RightCol%=60: Frame%=2: Fore%=4: Back%=7: Grow%=0: Shade%=0: TFore%=0: Title$="": Page%=0: Fast%=-1
WindowManager TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%
' second box and window
TopRow%=10: LeftCol%=35: BottomRow%=10: RightCol%=58: Frame%=1: Fore%=4: Back%=7: Grow%=0: Shade%=0: TFore%=0: Title$="": Page%=0: Fast%=-1
WindowManager TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%
' lets get user input into the dialog box
Text$="Inital Value"
row%=10
'Leftcol%=36 'modify these if you want to edit a smaller window
'Rightcol%=45
color fore%,back%:locate row%,leftcol%-15:print "User Input";
editor text$, Row%, Leftcol%, Rightcol%, Fore%, Back%, keycode% 'call the editor function
scrrest array%(),0,0 ' restore the screen
locate 1,1
print "You entered ";text$
end
SUB editor (text$, Row%, Leftcol%, Rightcol%, Fore%, Back%, keycode%)
'----- Find the cursor's size in Scan Lines
DEF SEG = 0 'Peek at low memory to see
IF PEEK(&H463) = &HB4 THEN 'what type of monitor we have
CsrSize = 12 'Monochrome uses 13 scan lines
ELSE ' (numbered 0 to 12)
CsrSize = 7 'Color uses 8 (0 to 7)
END IF
edit$ = SPACE$(rightcol% - Leftcol% + 1) 'Make a temporary string for
LSET edit$ = text$ ' editing
TxtPos = POS(0) - Leftcol% + 1 'Get the cursor's location to
IF TxtPos < 1 THEN TxtPos = 1 ' see where to begin editing
IF TxtPos > LEN(edit$) THEN TxtPos = LEN(edit$)
color Fore%,Back%
LOCATE Row%, Leftcol% 'Print the editing string
PRINT edit$;
'----- Main loop for handling key presses
DO
LOCATE Row%, Leftcol% + TxtPos - 1, 1 'Locate the cursor, turn it on
DO 'Wait for a key press
ky$ = INKEY$
LOOP UNTIL LEN(ky$)
IF LEN(ky$) = 1 THEN 'Make a key code from Ky$
keycode = ASC(ky$) 'Single character key
ELSE
keycode = -ASC(RIGHT$(ky$, 1)) 'Extended keys are negative
END IF
'----- Branch according to the key pressed
SELECT CASE keycode
'----- Backspace
CASE 8
IF TxtPos > 1 THEN 'not pass left margin
TxtPos = TxtPos - 1 'Back up the text pointer
LOCATE , Leftcol% + TxtPos - 1, 0 'Locate 1 to the left
IF TxtPos > 0 THEN 'Still within the field?
IF Insert THEN 'Truncate the string
MID$(edit$, TxtPos) = MID$(edit$, TxtPos + 1) + " "
ELSE 'Blank the letter
MID$(edit$, TxtPos) = " "
END IF
PRINT MID$(edit$, TxtPos); 'Print the new part of text
END IF
ELSE
SOUND 1000, 2
END IF
'----- Escape
CASE 27
EXIT DO 'Bail out
'----- Letter keys
CASE 32 TO 254
LOCATE , , 0 'Turn the cursor off
IF Insert THEN 'Expand the text string
MID$(edit$, TxtPos) = ky$ + MID$(edit$, TxtPos)
PRINT MID$(edit$, TxtPos); 'Print the expanded part
ELSE
MID$(edit$, TxtPos) = ky$ 'Put the new letter in string
PRINT ky$; 'Print the letter
END IF
IF TxtPos < LEN(edit$) THEN ' not movement pass rightmost char
TxtPos = TxtPos + 1 'Increment the text pointer
END IF
'----- Left arrow
CASE -75
IF TxtPos > 1 THEN 'will not allow movement left of Leftcol%
TxtPos = TxtPos - 1 'Decrement the text pointer
ELSE
SOUND 1000, 2
END IF
'----- Right arrow
CASE -77
IF TxtPos < LEN(edit$) THEN ' not movement pass rightmost char
TxtPos = TxtPos + 1 'Increment the text pointer
ELSE
SOUND 1000, 2
END IF
'----- Home
CASE -71
TxtPos = 1 'Move text pointer to 1
'----- End
CASE -79
FOR N = LEN(edit$) TO 1 STEP -1 'Look backwards for non-blank
IF MID$(edit$, N, 1) <> " " THEN EXIT FOR
NEXT
TxtPos = N + 1 'Set pointer to last char +1
IF TxtPos > LEN(edit$) THEN TxtPos = LEN(edit$)
'----- Insert key
CASE -82
Insert = NOT Insert 'Toggle the Insert state
IF Insert THEN 'Adjust the cursor size
LOCATE , , , CsrSize \ 2, CsrSize
ELSE
LOCATE , , , CsrSize - 1, CsrSize
END IF
'----- Delete
CASE -83 'Truncate the text
MID$(edit$, TxtPos) = MID$(edit$, TxtPos + 1) + " "
LOCATE , , 0 'Print the truncated part
PRINT MID$(edit$, TxtPos);
CASE ELSE 'All other keys,
EXIT DO ' bail out
END SELECT
'LOOP UNTIL TxtPos < 1 OR TxtPos > LEN(Edit$) 'If cursor is out of field,
' quit editing
LOOP UNTIL keycode = 13 'quit exiting on cr
text$ = RTRIM$(edit$) 'Trim the right side of text
' LOCATE , (Leftcol% - 1): PRINT " ";
' LOCATE , (rightcol% + 1): PRINT " ";
END SUB
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/