'===========================================================================
' Subject: DOS '97                           Date: 08-16-97 (20:21)       
' Author:  Chris McKenzie                    Code: QB, QBasic, PDS        
' Origin:  mckenze@earthlink.net           Packet: DOS.ABC
'===========================================================================
'                  úù--ÄÄÂÄ---ùú
'                  D O S   9 7
'                  úù--ÄÄÁÄ---ùú
'Sorry for the mess...never took a programming class.
'---------------------------------------------------
'                  How it works
'---------------------------------------------------
'  Dos 97 is a Menu system.  Like in Visual Basic
'  first you have to specify how many buttons you
'  want.  Then select a caption for each button..
'  Then a command.  Pretty straight forward sofar
'  Now,  to bring up the menu, move your mouse to
'  the very right of the screen and... "Boing!" .
'  If you selected one of your commands as a  Dos
'  command then it might prompt  you  with  pars.
'  You should now how to do that.  Anyway I tried
'  to make it as striaght foreward, powerful, and
'  easy as possible.
'
'  Questions, comments, want to be on the mailing list
'     m c k e n z e @ e a r t h l i n k . n e t
'
'
DEFINT A-Z
DECLARE SUB button (xstart%, ystart%, text$, place%)
DECLARE SUB buttondown (bttn%, state%, action%)
DECLARE SUB buttonup (bttn%)
DECLARE SUB mouse (cx, dx, bx)
DECLARE SUB mousepointer (SW)
DIM SHARED max, lstring
ON ERROR GOTO handler
COLOR 15, 0
CLS
INPUT ; "How many buttons do you want"; max
DIM SHARED caption$(max, 3), buttons(max, 5), variable$

FOR x% = 1 TO max
 CLS
 COLOR 15
 PRINT "What is the caption for button"; x%; "/"; max
 LOCATE 2, 38
 PRINT "ÇÄÄMaximum LengthÄÄ"
 COLOR 12
 LOCATE 2, 1
 LINE INPUT caption$(x%, 1)
 IF LEN(caption$(x%, 1)) > 37 THEN
  COLOR 4
  PRINT "ERROR!!ERROR!!ERROR!!ERROR!!ERROR!!ERROR!!ERROR!!ERROR!!ERROR!!ERROR!!"
  COLOR 14
  PRINT "You're caption: "; caption$(x%, 1); " was too long."
  caption$(x%, 1) = MID$(caption$(x%, 1), 1, 37)
  PRINT "It has been reduced to: "; caption$(x%, 1)
  COLOR 4
  PRINT "ERROR!!ERROR!!ERROR!!ERROR!!ERROR!!ERROR!!ERROR!!ERROR!!ERROR!!ERROR!!"
 END IF
 COLOR 15
 PRINT "What's the command for button "; CHR$(34); caption$(x%, 1); CHR$(34); "?"
 PRINT "Here are you're current Options"
 PRINT "1.) Change Caption"
 PRINT "2.) Print a desired text string."
 PRINT "3.) Run a desired program. (it might not have enough ram.)"
 PRINT "4.) Perform a certain Dos command"
 PRINT "5.) Quit the program."
 COLOR 12
 INPUT buttons(x%, 5)
 COLOR 15
 SELECT CASE buttons(x%, 5)
  CASE 1
   PRINT "Change Caption to..."
  CASE 2
   PRINT "Print what text string..."
  CASE 3
   PRINT "Run what program..."
  CASE 4
   PRINT "Note, put in percent sign where you want the variable to be inserted."
   PRINT "Command?"
  END SELECT
  IF buttons(x%, 5) < 5 THEN
   COLOR 12
   LINE INPUT caption$(x%, 2)
  END IF
NEXT x%

FOR x% = 1 TO max
 cstring = LEN(caption$(x%, 1))
 IF cstring > lstring THEN lstring = cstring
NEXT x%

DIM SHARED a(9)
DIM SHARED replace(1 TO 5000)
freebutton = 1
DEF SEG = VARSEG(a(0))

FOR I = 0 TO 17
 READ R
 POKE VARPTR(a(0)) + I, R
NEXT I
DATA &HB8,&H00,&H00   :
DATA &H55             :
DATA &H8B,&HEC        :
DATA &HCD,&H33        :
DATA &H92             :
DATA &H8B,&H5E,&H06   :
DATA &H89,&H07        :
DATA &H5D             :
DATA &HCA,&H02,&H00   :

SCREEN 12
LOCATE 1, 1
 text$ = "Dos 97"
 PRINT text$

FOR x% = LEN(text$) * 8 TO 0 STEP -1
 FOR y% = 0 TO 12
  IF POINT(x%, y%) = 15 THEN
   LINE (3 * x%, 2 * y% + 450)-(3 * x% + 1, 2 * y% + 450), 8, BF
  END IF
  NEXT y%
NEXT x%

LOCATE 1, 1
PRINT "      "
CALL mousepointer(0)
CALL mousepointer(1)
CALL mousepointer(3)
status$ = "out"
DO WHILE k$ <> CHR$(27)
 CALL mouse(dx, cx, bx)
 k$ = INKEY$
 IF dx > 448 AND cx < 143 AND bx = 1 THEN GOSUB ee
 FOR but% = 1 TO max
  IF cx < 622 - lstring * 8 AND status$ = "out" THEN
   CALL mousepointer(2)
   status$ = "in"
   FOR x% = 622 - lstring * 8 TO 639 STEP 1
    LINE (x%, 0)-(639, 479), 8, BF
    LINE (x%, 0)-(639, 0), 7
    LINE (x%, 0)-(x%, 479), 7
    LINE (x% - 1, 0)-(x% - 1, 479), 0
   NEXT x%
   CALL mousepointer(1)
   CALL mousepointer(3)
  ELSE
   IF cx > 635 AND status$ = "in" THEN
   CALL mousepointer(2)
    FOR x% = 639 TO 622 - lstring * 8 STEP -5
     LINE (x%, 0)-(639, 479), 8, BF
    LINE (x%, 0)-(639, 0), 7
    LINE (x%, 0)-(x%, 479), 7
    NEXT x%
    FOR x% = 1 TO max
     button 627 - lstring * 8, (x% * 25) - 20, caption$(x%, 1), x%
    NEXT x%
    status$ = "out"
   CALL mousepointer(1)
   CALL mousepointer(3)
   END IF
    IF status$ = "out" THEN
    IF (cx > buttons(but%, 1) AND cx < buttons(but%, 3)) AND (dx > buttons(but%, 2) AND dx < buttons(but%, 4)) THEN
      buttondown but%, bx, buttons(but%, 5)
    ELSE
      buttonup but%
    END IF
    END IF
   END IF
 NEXT but%
LOOP
SYSTEM
handler:
PRINT "Abnormal Termination. ON CASE ERR"; ERR
SYSTEM
RESUME
ee:
LOCATE 1, 1
COLOR 8
text$ = "Dos 97"
PRINT text$
FOR d% = 1 TO 3
SELECT CASE d%
CASE 1
c% = 8
CASE 2
c% = 7
CASE 3
c% = 15
END SELECT
FOR a% = 1 TO 3
FOR B% = 1 TO 2
FOR x% = LEN(text$) * 8 TO 0 STEP -1
FOR y% = 0 TO 12
IF POINT(x%, y%) = 8 THEN
LINE (3 * x%, 2 * y% + 450)-(3 * x% + a%, 2 * y% + 450 + B%), c%, BF
END IF
NEXT y%
NEXT x%
NEXT B%
NEXT a%
NEXT d%
COLOR 15
LOCATE 1, 1
COLOR 7
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
PRINT "ÃÄÄ´Programmed by Chris McKenzieÃÄÄ´"
PRINT "ÃÄÄ´     For Digital Reality    ÃÄÄ´"
PRINT "ÃÄÄ´ The future...of the future ÃÄÄ´"
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
RETURN

'Try these dos commands:
'  Caption     ³       Command
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
'  "Shell"     ³       Command      
'"Find Files"  ³  dir /s /b /w /p c:\%

SUB button (xstart, ystart, text$, place)
GET (0, 0)-(LEN(text$) * 8, 15), replace
LOCATE 1, 1
PRINT text$

FOR y% = 0 TO 15
 FOR x% = 0 TO LEN(text$) * 8
  IF POINT(x%, y%) = 15 THEN
   PSET (x% + xstart + 5, y% + ystart + 3), 7
  END IF
 NEXT x%
NEXT y%

PUT (0, 0), replace, PSET
buttons(place, 1) = xstart
buttons(place, 2) = ystart
buttons(place, 3) = LEN(text$) * 8 + 8 + xstart
buttons(place, 4) = ystart + 20
END SUB

SUB buttondown (bttn, state%, action)
caption$(bttn, 3) = "down"
FOR y% = buttons(bttn, 2) + 1 TO buttons(bttn, 4) - 1
 FOR x% = buttons(bttn, 1) + 1 TO buttons(bttn, 3) - 1
  IF POINT(x%, y%) = 7 THEN
   PSET (x%, y%), 15
  END IF
 NEXT x%
NEXT y%

IF state% = 0 THEN
 LINE (buttons(bttn, 1), buttons(bttn, 2))-(buttons(bttn, 1), buttons(bttn, 4) - 1), 15
 LINE (buttons(bttn, 1), buttons(bttn, 2))-(buttons(bttn, 3) - 1, buttons(bttn, 2)), 15
 LINE (buttons(bttn, 1), buttons(bttn, 4))-(buttons(bttn, 3), buttons(bttn, 4)), 0
 LINE (buttons(bttn, 3), buttons(bttn, 2))-(buttons(bttn, 3), buttons(bttn, 4)), 0
ELSE
 LINE (buttons(bttn, 1), buttons(bttn, 2))-(buttons(bttn, 1), buttons(bttn, 4) - 1), 0
 LINE (buttons(bttn, 1), buttons(bttn, 2))-(buttons(bttn, 3) - 1, buttons(bttn, 2)), 0
 LINE (buttons(bttn, 1), buttons(bttn, 4))-(buttons(bttn, 3), buttons(bttn, 4)), 15
 LINE (buttons(bttn, 3), buttons(bttn, 2))-(buttons(bttn, 3), buttons(bttn, 4)), 15
 SELECT CASE action
  CASE 1
   LINE (buttons(bttn, 1), buttons(bttn, 2))-(buttons(bttn, 3), buttons(bttn, 4)), 8, BF
   caption$(bttn, 1) = caption$(bttn, 2)
   button buttons(bttn, 1), buttons(bttn, 2), caption$(bttn, 2), bttn
   lstringold = lstring
   lstring = 0
    FOR x% = 1 TO max
     cstring = LEN(caption$(x%, 1))
     IF cstring > lstring THEN lstring = cstring
    NEXT x%
    FOR x% = 622 - lstringold * 8 TO 622 - lstring * 8 STEP 1
     LINE (x%, 0)-(639, 479), 8, BF
     LINE (x%, 0)-(639, 0), 7
     LINE (x%, 0)-(x%, 479), 7
     LINE (x% - 1, 0)-(x% - 1, 479), 0
     NEXT x%
  CASE 2
   LOCATE 1, 1
   PRINT caption$(bttn, 2)
  CASE 3
   RUN caption$(bttn, 2)
  CASE 4
   comand$ = "                                           "
   MID$(comand$, 1) = caption$(bttn, 2)
   place = INSTR(1, comand$, "%")
    IF place > 0 THEN
     LINE (0, 0)-(621 - lstring * 8, 45), 7, BF
     LINE (1, 1)-(621 - lstring * 8, 45), 8, B
     LINE (x%, 0)-(639, 0), 7
     LINE (x%, 0)-(x%, 479), 7
     LINE (1, 1)-(621 - lstring * 8, 45), 8, BF
     LINE (127, 15)-(290, 31), 8, BF
     LINE (128, 16)-(291, 32), 15, BF
     LINE (128, 16)-(290, 31), 0, BF
     LOCATE 2, 5
     PRINT "Parameters:"
      FOR x% = 32 TO 119
       FOR y% = 16 TO 31
        IF POINT(x%, y%) = 0 THEN PSET (x%, y%), 8
       NEXT y%
      NEXT x%
     LOCATE 2, 17
     LINE INPUT parameters$
     secondhalf$ = MID$(comand$, place, LEN(comand$) - place)
     MID$(comand$, place) = parameters$
     secondhalf$ = MID$(secondhalf$, 2, LEN(secondhalf$) - 1)
     comand$ = MID$(comand$, 1, place - 1)
     comand$ = comand$ + parameters$ + secondhalf$
    ELSE
     MID$(comand$, LEN(caption$(bttn, 2)) + 2) = parameters$
    END IF
    LOCATE 4, 1
    COLOR 13
    PRINT "Command:"; comand$
    COLOR 15
    SHELL comand$
   CASE 5
    SYSTEM
  END SELECT
 END IF
END SUB

SUB buttonup (bttn)
IF caption$(bttn, 3) = "down" THEN
 caption$(bttn, 3) = "up"
 FOR y% = buttons(bttn, 2) + 1 TO buttons(bttn, 4) - 1
  FOR x% = buttons(bttn, 1) + 1 TO buttons(bttn, 3) - 1
  IF POINT(x%, y%) = 15 THEN
   PSET (x%, y%), 7
  END IF
  NEXT x%
 NEXT y%
END IF
 LINE (buttons(bttn, 1), buttons(bttn, 2))-(buttons(bttn, 3), buttons(bttn, 4)), 8, B
END SUB

SUB mouse (cx, dx, bx)
           POKE VARPTR(a(4)), &H92           'Swap code,Get CX setup
          CALL absolute(cx, VARPTR(a(0)))     'Run Code
              cx = cx
           POKE VARPTR(a(4)), &H91           'Swap code,Get DX setup
          CALL absolute(dx, VARPTR(a(0)))     'Run Code
              dx = dx
           POKE VARPTR(a(4)), &H93           'Swap code,Get BX setup
          CALL absolute(bx, VARPTR(a(0)))     'Run Code
END SUB

SUB mousepointer (SW)
         
           POKE VARPTR(a(0)) + 1, SW         'Swap code,Set AX = (SW)
          CALL absolute(c, VARPTR(a(0)))     'Run Code

                                          'Note:
                                             'SW = 0-reset
                                             'SW = 1-on
                                             'SW = 2-off
                                             'SW = 3-coordinates


END SUB