'=========================================================================== ' Subject: TEXT WINDOW DESIGNER Date: 06-28-96 (09:08) ' Author: Edward Blake Code: QB, PDS ' Origin: eblake2@quebectel.com Packet: TEXT.ABC '=========================================================================== ' 1995-96 Edward Blake (14 years old), QuickBasic Windowing designer ' Programming tool for creating a acceptable text based Windowing Interface ' looks quite primitive a the side of other, more sophisticated tools ' But can always make a good interface, Keeps everything in RAM until ' You want to save your work to a .BAS file, push ESC to go to the menu ' DECLARE SUB EXITP () DECLARE SUB NEW () DECLARE SUB SAVE () DECLARE FUNCTION ZDIGIT$ (A%) DECLARE SUB MOUSE (A!) DECLARE SUB BACKCLRED (ACTT!) DECLARE SUB FORECLRED (ACTT!) DECLARE SUB PROPERTY (ACTTOOL!) DECLARE SUB TOOLBAR (X3!, Y3!) DECLARE SUB MENU () DECLARE SUB RECONSTRUCT () DECLARE SUB BCKGND () DECLARE SUB WIN (X1 AS INTEGER, Y1 AS INTEGER, X2 AS INTEGER, Y2 AS INTEGER, A$) ' $INCLUDE: 'QB.BI' TYPE OBJECT X1 AS INTEGER Y1 AS INTEGER X2 AS INTEGER Y2 AS INTEGER BACKCLR AS INTEGER FORECLR AS INTEGER CAPTION AS STRING * 32 END TYPE DIM INDEX AS INTEGER DIM REGS AS RegType DIM OBJ(300) AS OBJECT CLS BCKGND COLOR 15, 1 REGS.ax = 10 REGS.bx = 0 REGS.cx = &HFFFF REGS.dx = &H4700 INTERRUPT 51, REGS, REGS REGS.ax = 1 REGS.bx = 0 REGS.cx = 1 REGS.dx = 1 INTERRUPT 51, REGS, REGS DO I$ = INKEY$ REGS.ax = 3 INTERRUPT 51, REGS, REGS IF REGS.bx = 1 THEN IF PD = 0 THEN PD = 1 LSTX% = INT((80 / 640) * REGS.cx) + 1 LSTY% = INT((25 / 200) * REGS.dx) + 1 END IF IF PD = 1 THEN WIN LSTX%, LSTY%, INT((80 / 640) * REGS.cx) + 1, INT((25 / 200) * REGS.dx) + 1, "" END IF END IF IF REGS.bx = 0 THEN LSPD = PD PD = 0 IF LSPD = 1 THEN WIN LSTX%, LSTY%, INT((80 / 640) * REGS.cx) + 1, INT((25 / 200) * REGS.dx) + 1, "Untitled" IF LSTX% <> INT((80 / 640) * REGS.cx) + 1 THEN IF LSTY% <> INT((25 / 200) * REGS.dx) + 1 THEN OBJ(INDEX).X1 = LSTX% OBJ(INDEX).Y1 = LSTY% OBJ(INDEX).X2 = INT((80 / 640) * REGS.cx) + 1 OBJ(INDEX).Y2 = INT((25 / 200) * REGS.dx) + 1 OBJ(INDEX).BACKCLR = 1 OBJ(INDEX).FORECLR = 15 OBJ(INDEX).CAPTION = "Untitled" INDEX = INDEX + 1 LSTX% = 0'INT((80 / 640) * REGS.cx) + 1 LSTY% = 0'INT((25 / 200) * REGS.dx) + 1 LSTPH = 0 RECONSTRUCT END IF END IF LSTPH = 0 END IF END IF IF REGS.bx = 0 THEN IF LSTX% = INT((80 / 640) * REGS.cx) + 1 THEN IF LSTY% = INT((25 / 200) * REGS.dx) + 1 THEN IF LSTPH = 0 THEN ' ' PLACE ROUTINES HERE THE USER CLICKS (NOT DRAG) ' TOOLBAR INT((80 / 640) * REGS.cx) + 1, INT((25 / 200) * REGS.dx) + 1 RECONSTRUCT LSTPH = 1 END IF END IF END IF END IF IF I$ = CHR$(13) OR I$ = CHR$(27) OR I$ = CHR$(9) THEN MENU LOOP SUB BACKCLRED (ACTT) SHARED OBJ() AS OBJECT, INDEX AS INTEGER DIM REGS AS RegType COLOR 0, 15 LOCATE 9, 18: PRINT "<" + ZDIGIT$(OBJ(ACTT).BACKCLR) + ">" Z% = OBJ(ACTT).BACKCLR DO I$ = INKEY$ IF I$ = CHR$(0) + CHR$(77) THEN Z% = Z% + 1 IF I$ = CHR$(0) + CHR$(75) THEN Z% = Z% - 1 IF Z% > 15 THEN Z% = 15 IF Z% < 0 THEN Z% = 0 OBJ(ACTT).BACKCLR = Z% LOCATE 9, 18: PRINT "<" + ZDIGIT(Z%) + ">" IF I$ = CHR$(13) THEN COLOR 15, 1 LOCATE 9, 18: PRINT " " + ZDIGIT(Z%) + " " EXIT SUB END IF IF I$ = CHR$(27) THEN COLOR 15, 1 LOCATE 9, 18: PRINT " " + ZDIGIT(Z%) + " " EXIT SUB END IF LOOP END SUB SUB BCKGND FOR I = 1 TO 24 LOCATE I, 1: PRINT STRING$(80, 177); NEXT I LOCATE 25, 1: PRINT STRING$(80, 177); END SUB SUB EXITP MOUSE 2 COLOR 7, 0 CLS SYSTEM END SUB SUB FORECLRED (ACTT) SHARED OBJ() AS OBJECT, INDEX AS INTEGER DIM REGS AS RegType COLOR 0, 15 LOCATE 10, 18: PRINT "<" + ZDIGIT$(OBJ(ACTT).FORECLR) + ">" Z% = OBJ(ACTT).FORECLR DO I$ = INKEY$ IF I$ = CHR$(0) + CHR$(77) THEN Z% = Z% + 1 IF I$ = CHR$(0) + CHR$(75) THEN Z% = Z% - 1 IF Z% > 15 THEN Z% = 15 IF Z% < 0 THEN Z% = 0 OBJ(ACTT).FORECLR = Z% LOCATE 10, 18: PRINT "<" + ZDIGIT(Z%) + ">" IF I$ = CHR$(13) THEN COLOR 15, 1 LOCATE 10, 18: PRINT " " + ZDIGIT(Z%) + " " EXIT SUB END IF IF I$ = CHR$(27) THEN COLOR 15, 1 LOCATE 10, 18: PRINT " " + ZDIGIT(Z%) + " " EXIT SUB END IF LOOP END SUB SUB MENU DIM REGS AS RegType COLOR 15, 1 WIN 1, 1, 40, 25, "" COLOR 0, 15 LOCATE 1, 2: PRINT " QB Fixed Window Design " COLOR 15, 1 LOCATE 2, 2: PRINT " New " LOCATE 3, 2: PRINT " Save in QuickBasic " LOCATE 4, 2: PRINT " Exit " LOCATE 5, 1: PRINT "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´" LOCATE 6, 2: PRINT " " LOCATE 7, 2: PRINT " " LOCATE 8, 2: PRINT " " LOCATE 9, 2: PRINT " " LOCATE 10, 2: PRINT " " LOCATE 11, 2: PRINT " " LOCATE 12, 2: PRINT " " LOCATE 13, 2: PRINT " " LOCATE 14, 2: PRINT " " DO REGS.ax = 3 INTERRUPT 51, REGS, REGS X4 = INT((80 / 640) * REGS.cx) + 1 Y4 = INT((25 / 200) * REGS.dx) + 1 IF REGS.bx = 1 THEN IF X4 < 40 THEN IF Y4 = 2 THEN NEW IF Y4 = 3 THEN SAVE IF Y4 = 4 THEN EXITP END IF END IF IF X4 > 40 THEN EXIT SUB END IF LOOP END SUB SUB MOUSE (A) DIM REGS AS RegType REGS.ax = A INTERRUPT 51, REGS, REGS END SUB SUB NEW SHARED OBJ() AS OBJECT, INDEX AS INTEGER FOR I = 0 TO 300 OBJ(I).X1 = 0 OBJ(I).Y1 = 0 OBJ(I).X2 = 0 OBJ(I).Y2 = 0 OBJ(I).BACKCLR = 0 OBJ(I).FORECLR = 0 OBJ(I).CAPTION = "" NEXT I INDEX = 0 END SUB SUB PROPERTY (ACTTOOL) SHARED OBJ() AS OBJECT, INDEX AS INTEGER DIM REGS AS RegType COLOR 15, 1 WIN 3, 6, 60, 15, "" COLOR 0, 15 LOCATE 6, 4: PRINT "Property " COLOR 15, 1 LOCATE 8, 6: PRINT " ÚÄÄÄÄ¿" LOCATE 9, 6: PRINT "Back Color ³ ³" LOCATE 10, 6: PRINT "Fore Color ³ ³" LOCATE 11, 6: PRINT " ÀÄÄÄÄÙ" LOCATE 12, 6: PRINT " ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" LOCATE 13, 6: PRINT "Caption ³ ³" LOCATE 14, 6: PRINT " ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" LOCATE 9, 19: PRINT ZDIGIT$(OBJ(ACTTOOL).BACKCLR) LOCATE 10, 19: PRINT ZDIGIT$(OBJ(ACTTOOL).FORECLR) LOCATE 13, 18: PRINT LEFT$(OBJ(ACTTOOL).CAPTION, 39) DO REGS.ax = 3 INTERRUPT 51, REGS, REGS X4 = INT((80 / 640) * REGS.cx) + 1 Y4 = INT((25 / 200) * REGS.dx) + 1 IF REGS.bx = 1 THEN IF X4 > 17 AND X4 < 57 AND Y4 > 12 AND Y4 < 14 THEN LOCATE 13, 18: INPUT "", OBJ(ACTTOOL).CAPTION END IF IF X4 > 5 AND X4 < 22 AND Y4 > 8 AND Y4 < 11 THEN IF Y4 = 9 THEN BACKCLRED ACTTOOL IF Y4 = 10 THEN FORECLRED ACTTOOL END IF IF Y4 < 6 OR Y4 > 15 OR X4 < 7 OR X4 > 60 THEN EXIT SUB END IF LOOP END SUB SUB RECONSTRUCT SHARED OBJ() AS OBJECT COLOR 7, 0 CLS BCKGND FOR I = 0 TO 300 IF OBJ(I).X1 = 0 THEN EXIT FOR COLOR OBJ(I).FORECLR, OBJ(I).BACKCLR WIN OBJ(I).X1, OBJ(I).Y1, OBJ(I).X2, OBJ(I).Y2, RTRIM$(OBJ(I).CAPTION) NEXT I MOUSE 1 END SUB SUB SAVE SHARED OBJ() AS OBJECT COLOR 0, 7 LOCATE 5, 6: PRINT " Save as QuickBasic 4.5 File " COLOR 15, 1 LOCATE 6, 2: PRINT "FileName: " LOCATE 7, 2: PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" LOCATE 8, 2: PRINT "³ ³" LOCATE 9, 2: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" LOCATE 8, 3: INPUT "", A$ IF A$ = "" THEN EXIT SUB OPEN A$ FOR OUTPUT AS #1 PRINT #1, "DECLARE SUB BCKGND ()" PRINT #1, "DECLARE SUB WIN (X1 AS INTEGER, Y1 AS INTEGER, X2 AS INTEGER, Y2 AS INTEGER, A$)" PRINT #1, "DECLARE SUB WININTRO()" PRINT #1, "SUB WININTRO" FOR I% = 0 TO 300 X = I% IF OBJ(X).X1 = 0 THEN EXIT FOR PRINT #1, "COLOR " + STR$(OBJ(X).FORECLR) + "," + STR$(OBJ(X).BACKCLR) PRINT #1, "WIN "; STR$(OBJ(X).X1); ","; STR$(OBJ(X).Y1); ","; STR$(OBJ(X).X2); ","; STR$(OBJ(X).Y2); ","; CHR$(34); RTRIM$(OBJ(X).CAPTION); CHR$(34) NEXT I% PRINT #1, "END SUB" PRINT #1, "SUB WIN (X1 AS INTEGER, Y1 AS INTEGER, X2 AS INTEGER, Y2 AS INTEGER, A$)" PRINT #1, "FOR I% = Y1% + 1 TO Y2% - 1" PRINT #1, "LOCATE I%, X1 + 1: PRINT STRING$(X2 - X1, 32);" PRINT #1, "Next I%" PRINT #1, "LOCATE Y1, X1 + 1: PRINT STRING$(X2 - X1, 196);" PRINT #1, "LOCATE Y2, X1 + 1: PRINT STRING$(X2 - X1, 196);" PRINT #1, "FOR I = Y1 + 1 TO Y2 - 1" PRINT #1, "LOCATE I, X1: PRINT CHR$(179);" PRINT #1, "LOCATE I, X2: PRINT CHR$(179);" PRINT #1, "NEXT I" PRINT #1, "LOCATE Y1, X1: PRINT CHR$(218);" PRINT #1, "LOCATE Y1, X2: PRINT CHR$(191);" PRINT #1, "LOCATE Y2, X1: PRINT CHR$(192);" PRINT #1, "LOCATE Y2, X2: PRINT CHR$(217);" PRINT #1, "IF A$ <> " + CHR$(34) + CHR$(34) + " THEN" PRINT #1, "LOCATE Y1, X1 + 1: PRINT A$;" PRINT #1, "END IF" PRINT #1, "END SUB" PRINT #1, "SUB BCKGND" PRINT #1, "FOR I = 1 TO 24" PRINT #1, "LOCATE I, 1: PRINT STRING$(80, 177);" PRINT #1, "NEXT I" PRINT #1, "LOCATE 25, 1: PRINT STRING$(80, 177);" PRINT #1, "END SUB" CLOSE #1 COLOR 15, 1 LOCATE 5, 6: PRINT " " LOCATE 6, 2: PRINT " " LOCATE 7, 2: PRINT " " LOCATE 8, 2: PRINT " " LOCATE 9, 2: PRINT " " END SUB SUB TOOLBAR (X3, Y3) SHARED OBJ() AS OBJECT, INDEX AS INTEGER DIM REGS AS RegType FOR I = 0 TO 300 IF OBJ(I).X1 = 0 THEN EXIT FOR IF OBJ(I).X1 <= X3 THEN IF OBJ(I).Y1 <= Y3 THEN IF OBJ(I).X2 >= X3 THEN IF OBJ(I).Y2 >= Y3 THEN ACTTOOL = I TOOLFOUND = 1 LOCATE 1, 1: PRINT I END IF END IF END IF END IF NEXT I IF TOOLFOUND = 0 THEN EXIT SUB COLOR 0, 15 WIN OBJ(ACTTOOL).X1, OBJ(ACTTOOL).Y1, OBJ(ACTTOOL).X2, OBJ(ACTTOOL).Y2, RTRIM$(OBJ(ACTTOOL).CAPTION) COLOR 15, 1 WIN 3, 2, 24, 7, "ToolBar" LOCATE 3, 4: PRINT LEFT$(OBJ(ACTOOL).CAPTION, 12); " ("; ACTTOOL; ")" LOCATE 4, 3: PRINT "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´" LOCATE 5, 4: PRINT "Delete " LOCATE 6, 4: PRINT "Property " DO REGS.ax = 3 INTERRUPT 51, REGS, REGS 'INT((80 / 640) * REGS.cx) + 1 'INT((25 / 200) * REGS.dx) + 1 X4 = INT((80 / 640) * REGS.cx) + 1 Y4 = INT((25 / 200) * REGS.dx) + 1 IF REGS.bx = 1 THEN IF X4 > 3 AND Y4 > 4 AND X4 < 24 AND Y4 < 8 THEN IF Y4 = 5 THEN COLOR 0, 15 LOCATE 5, 4: PRINT "Delete " FOR I = ACTTOOL + 1 TO 300 OBJ(I - 1).X1 = OBJ(I).X1 OBJ(I - 1).Y1 = OBJ(I).Y1 OBJ(I - 1).X2 = OBJ(I).X2 OBJ(I - 1).Y2 = OBJ(I).Y2 OBJ(I - 1).BACKCLR = OBJ(I).BACKCLR OBJ(I - 1).FORECLR = OBJ(I).FORECLR OBJ(I - 1).CAPTION = OBJ(I).CAPTION NEXT I INDEX = INDEX - 1 EXIT SUB END IF IF Y4 = 6 THEN COLOR 0, 15 LOCATE 6, 4: PRINT "Property " PROPERTY ACTTOOL EXIT SUB END IF END IF IF X4 < 3 OR Y4 < 2 OR X4 > 24 OR Y4 > 8 THEN EXIT SUB END IF END IF LOOP END SUB SUB WIN (X1 AS INTEGER, Y1 AS INTEGER, X2 AS INTEGER, Y2 AS INTEGER, A$) IF X1 > X2 THEN SWAP X1, X2 END IF IF Y1 > Y2 THEN SWAP Y1, Y2 END IF IF X2 - X1 = 0 THEN EXIT SUB END IF IF Y2 - Y1 = 0 THEN EXIT SUB END IF FOR I% = Y1% + 1 TO Y2% - 1 LOCATE I%, X1 + 1: PRINT STRING$(X2 - X1, 32); NEXT I% LOCATE Y1, X1 + 1: PRINT STRING$(X2 - X1, 196); LOCATE Y2, X1 + 1: PRINT STRING$(X2 - X1, 196); FOR I = Y1 + 1 TO Y2 - 1 LOCATE I, X1: PRINT CHR$(179); LOCATE I, X2: PRINT CHR$(179); NEXT I LOCATE Y1, X1: PRINT CHR$(218); LOCATE Y1, X2: PRINT CHR$(191); LOCATE Y2, X1: PRINT CHR$(192); LOCATE Y2, X2: PRINT CHR$(217); IF A$ <> "" THEN LOCATE Y1, X1 + 1: PRINT A$; END IF END SUB FUNCTION ZDIGIT$ (A%) IF A% < 10 THEN ZDIGIT$ = "0" + RTRIM$(LTRIM$(STR$(A%))) IF A% >= 10 THEN ZDIGIT$ = RTRIM$(LTRIM$(STR$(A%))) END FUNCTION