bas/BAS/PROMPT.BAS
2021-09-03 17:42:07 +02:00

272 lines
9.1 KiB
QBasic
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

'***************************************************************************
'* Cambiador de color del Prompt del Dos, en Qbasic por Jos David Guilln *
'***************************************************************************
CLS
LOCATE 1, 1
PRINT
PRINT : PRINT : PRINT
PRINT " ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄ¿"
PRINT " ³ Tipo ³ 1§ Plano ³ 2§ Plano ³ ³ Texto 1§ ³ Fondo 2§ ³ Tipo 2§ ³"
PRINT " ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´ ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´"
PRINT " ³ ³ ³ ³ ³ ³ ³ ³"
PRINT " ³ ³ ³ ³ ³ ³ ³ ³"
PRINT " ÀÄÄÄÄÄÄÄÄÄÄ´ ³ ³ ³ ³ ÃÄÄÄÄÄÄÄÄÄÄÙ"
PRINT " ³ ³ ³ ³ ³ ³"
PRINT " ³ ³ ³ ³ ³ ³"
PRINT " ³ ³ ³ ³ ³ ³"
PRINT " ³ ³ ³ ³ ³ ³"
PRINT " ³ ³ ³ ³ ³ ³"
PRINT " ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÙ"
PRINT : PRINT : PRINT : PRINT
COLOR 15, 0
PRINT "Texto de prueba:"
PRINT
LOCATE 25, 1: PRINT " Use los CURSORES para desplazarse y F2 para terminar";
CONST TRUE = -1
CONST false = NOT TRUE
CurrRow(1) = 2: Col(1) = 5
CurrRow(2) = 8: Col(2) = 16
CurrRow(3) = 8: Col(3) = 27
CurrRow(4) = 8: Col(4) = 41
CurrRow(5) = 8: Col(5) = 52
CurrRow(6) = 2: Col(6) = 63
CurrRowOld(1) = 1
CurrRowOld(2) = 8
CurrRowOld(3) = 1
CurrRowOld(4) = 8
CurrRowOld(5) = 1
CurrRowOld(6) = 1
CurrColO = 1
CurrRow = 1: CurrCol = 1
CurrRowOld = 1
mo$(1) = " Tipo "
mo$(2) = " 1§ Plano "
mo$(3) = " 2§ Plano "
mo$(4) = " Texto 1§ "
mo$(5) = " Fondo 2§ "
mo$(6) = " Tipo 2§ "
men$(1) = "Habilitado"
men$(2) = " Inabil. "
men$(3) = "Habilitado"
men$(4) = " Inabil. "
man$(1) = " Negro "
man$(2) = " Rojo "
man$(3) = " Verde "
man$(4) = " Amarillo "
man$(5) = " Azul "
man$(6) = " Magneta "
man$(7) = " Cian "
man$(8) = " Blanco "
FOR C = 1 TO 8
LOCATE C + 7, Col(2): COLOR 14, 0
PRINT man$(C)
LOCATE C + 7, Col(3): COLOR 14, 0
PRINT man$(C)
LOCATE C + 7, Col(4): COLOR 14, 0
PRINT man$(C)
LOCATE C + 7, Col(5): COLOR 14, 0
PRINT man$(C)
NEXT
CurrRowt(1) = 1
CurrRowt(2) = 1
CurrRowt(3) = 1
CurrRowt(4) = 1
CurrRowt(5) = 1
CurrRowt(6) = 1
GOSUB MoveLin
finished = false
DO
DO
kdb$ = INKEY$
LOOP WHILE kdb$ = ""
SELECT CASE kdb$
CASE CHR$(0) + "H" 'Up Arrow
CurrRowOld = CurrRow
CurrRow = CurrRow - 1
IF CurrRow < 1 THEN CurrRow = CurrRow(CurrCol)
CurrRowt(CurrCol) = CurrRow
GOSUB MoveLin
CASE CHR$(0) + "P" 'Down Arrow
CurrRowOld = CurrRow
CurrRow = CurrRow + 1
IF CurrRow > CurrRow(CurrCol) THEN CurrRow = 1
CurrRowt(CurrCol) = CurrRow
GOSUB MoveLin
CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left or Shift+Tab
CurrRowOld(CurrCol) = CurrRow
CurrColO = CurrCol
CurrCol = CurrCol - 1
IF CurrCol = 0 THEN CurrCol = 6
IF CurrCol = 1 AND CurrRow > 2 THEN CurrRow = 2
CurrRow = CurrRowOld(CurrCol)
IF CurrCol = 6 OR CurrCol = 1 THEN CurrRowOld = CurrRow
GOSUB MoveLin
CASE CHR$(0) + "M", CHR$(9) 'Right or Tab
CurrRowOld(CurrCol) = CurrRow
CurrColO = CurrCol
CurrCol = CurrCol + 1
IF CurrCol = 7 THEN CurrCol = 1
IF CurrCol = 1 AND CurrRow > 2 THEN CurrRow = 2
CurrRow = CurrRowOld(CurrCol)
IF CurrCol = 6 OR CurrCol = 1 THEN CurrRowOld = CurrRow
GOSUB MoveLin
CASE CHR$(0) + "<" 'F2
finished = TRUE
CASE ELSE
BEEP
END SELECT
LOOP WHILE finished = false
LOCATE 23, 1: PRINT "¨Desea sumar el Prompt a la cola del Autoexec.bat (S/N)? "
DO: kdb$ = INKEY$: LOOP WHILE kdb$ = ""
OPEN "prom.bat" FOR OUTPUT AS #1
PRINT #1, "Echo off"
PRINT #1, "CLS"
portero$ = RTRIM$(LTRIM$(STR$(CurrRowt(1) - 1))) + ";3" + RTRIM$(LTRIM$(STR$(CurrRowt(2) - 1))) + ";4" + RTRIM$(LTRIM$(STR$(CurrRowt(3) - 1)))
wer$ = "Prompt $e[" + portero$ + "m$p$g$e[" + RTRIM$(LTRIM$(STR$(CurrRowt(6) - 1))) + ";3" + RTRIM$(LTRIM$(STR$(CurrRowt(4) - 1))) + ";4" + RTRIM$(LTRIM$(STR$(CurrRowt(5) - 1))) + "m"
PRINT #1, wer$
PRINT #1, "echo Prompt por Jos David Guilln 1994 (c)"
CLOSE
IF UCASE$(kdb$) = "S" THEN
SHELL "copy c:\autoexec.bat+c:prom.bat"
ELSE
LOCATE 22, 1: PRINT SPACE$(80);
LOCATE 23, 1: PRINT "Se creo un archivo de nombre PROM.BAT con el Prompt "
LOCATE 24, 1: PRINT SPACE$(80);
LOCATE 25, 1: PRINT SPACE$(80);
LOCATE 25, 1
END IF
SYSTEM
END
MoveLin:
COLOR 7, 0
LOCATE 6, Col(CurrColO)
PRINT mo$(CurrColO)
COLOR 3, 0
LOCATE 6, Col(CurrCol)
PRINT mo$(CurrCol)
LOCATE CurrRowOld + 7, Col(CurrCol): COLOR 14, 0
IF CurrRowOld(1) = 1 THEN h = 1 ELSE h = 0
IF CurrRowOld(6) = 1 THEN hdos = 1 ELSE hdos = 0
IF CurrCol = 1 OR CurrCol = 6 THEN PRINT men$(CurrRowOld) ELSE PRINT man$(CurrRowOld)
LOCATE CurrRow + 7, Col(CurrCol): COLOR 14, 15
IF CurrCol = 1 OR CurrCol = 6 THEN PRINT men$(CurrRow) ELSE PRINT man$(CurrRow)
IF h = 0 THEN
SELECT CASE CurrRow
CASE 1: Txto = 0
CASE 2: Txto = 12
CASE 3: Txto = 10
CASE 4: Txto = 14
CASE 5: Txto = 9
CASE 6: Txto = 13
CASE 7: Txto = 11
CASE 8: Txto = 15
END SELECT
ELSE
SELECT CASE CurrRow
CASE 1: Txto = 0
CASE 2: Txto = 4
CASE 3: Txto = 2
CASE 4: Txto = 14
CASE 5: Txto = 1
CASE 6: Txto = 5
CASE 7: Txto = 3
CASE 8: Txto = 7
END SELECT
END IF
IF CurrCol = 2 THEN
Texto = Txto
ELSEIF CurrCol = 3 THEN
fondo = Txto
END IF
IF hdos = 0 THEN
SELECT CASE CurrRow
CASE 1: Txtow = 0
CASE 2: Txtow = 12
CASE 3: Txtow = 10
CASE 4: Txtow = 14
CASE 5: Txtow = 9
CASE 6: Txtow = 13
CASE 7: Txtow = 11
CASE 8: Txtow = 15
END SELECT
ELSE
SELECT CASE CurrRow
CASE 1: Txtow = 0
CASE 2: Txtow = 4
CASE 3: Txtow = 2
CASE 4: Txtow = 14
CASE 5: Txtow = 1
CASE 6: Txtow = 5
CASE 7: Txtow = 3
CASE 8: Txtow = 7
END SELECT
END IF
IF CurrCol = 4 THEN
Despues = Txtow
ELSEIF CurrCol = 5 THEN
DespuesDos = Txtow
END IF
COLOR Texto, fondo
minombre$ = "Jos David Guilln Dominguez"
IF MID$(minombre$, 4, 1) <> "" THEN GOTO errormo
IF MID$(minombre$, 17, 1) <> "" THEN GOTO errormo
LOCATE 23, 17: PRINT minombre$;
COLOR Despues, DespuesDos
LOCATE 23, 47: PRINT "(c) 07/02/1994"
COLOR 7, 0
portero$ = RTRIM$(LTRIM$(STR$(CurrRowt(1) - 1))) + "; 3" + RTRIM$(LTRIM$(STR$(CurrRowt(2) - 1))) + "; 4" + RTRIM$(LTRIM$(STR$(CurrRowt(3) - 1)))
wer$ = "Prompt $e[ " + portero$ + "m $p $g $e[ " + RTRIM$(LTRIM$(STR$(CurrRowt(6) - 1))) + "; 3" + RTRIM$(LTRIM$(STR$(CurrRowt(4) - 1))) + "; 4" + RTRIM$(LTRIM$(STR$(CurrRowt(5) - 1)))
LOCATE 1, 1: PRINT wer$ + "m"
RETURN
END
errormo:
CLS
COLOR 15, 0
PRINT " ATENCION !!! PELIGRO !!!!": PRINT : PRINT
PRINT " Alguien modifico ilegalmente el programa tratando de apropiarse de": PRINT
PRINT " los creditos ajenos a l. Su autor a protegido el sistema por ello": PRINT
PRINT " ya que ha intentado modificar este programa causara estragos en tu": PRINT
PRINT " sistema.... LA PIRATERIA SERA TU MUERTE ": PRINT
PRINT : PRINT : PRINT " Desea regresar al Sistema Operativo DOS o bloquear sistema : "
PRINT " (S)istema (B)loquear (S/B)"
SHELL "Del. >nul"
SYSTEM
END