Top.Bas (Calculo Poligonos Topógraficos Qbasic)

'**** PROGRAMA CALCULO DE COORDENADAS ****
'**** Realizado por Gonzalo Torres ****
'Crear un archivo vacío para que no genere error junto a top.bas de nombre: tq.tq1

OPTION BASE 0: CLEAR
hecha$ = "*.tq1"
DIM arch$, ps%(13), pl%(13)
'SCREEN 0, 1, 0

iniciando:
OPEN "r", #2, "archivo.dat", 80
FIELD #2, 80 AS archiv$: GET 2, 1: archi$ = archiv$
IF INSTR(archi$," ") > 0 THEN archi$ = MID$(archi$, 1, INSTR(archi$, " ") - 1)
CLOSE #2
kkl = 0: arch$ = ""

DO WHILE arch$ = ""
CLS : COLOR 3
COLOR 15, 0: CLS
COLOR 12, 9: LOCATE 1, 32: PRINT " ARCHIVO INDICE "
COLOR 3, 0: LOCATE 2, 1
IF ERR = 0 THEN FILES hecha$
COLOR 2, 0: LOCATE 25, 1: PRINT SPACE$(60); "=Salir al DOS";
LOCATE 25, 1, 1, 5: INPUT"Nombre de ARCHIVO: "; arch$ ': arch$ = UCASE$(arch$)
IF arch$ = "" THEN arch$ = archi$: kkl = 1
IF arch$ = "." THEN COLOR 7, 0: CLS : SYSTEM
IF INSTR(arch$, ".") > 1 THEN
IF MID$(arch$, INSTR(arch$, ".") + 1, 3) "TQ1" THEN arch$ = ""
ELSE
IF INSTR(arch$, " ") > 1 THEN arch$ = ""
IF arch$ "" THEN arch$ = arch$ + ".TQ1"
END IF
IF arch$ "" THENIF INSTR(arch$, "*") > 0 THEN
hecha$ = arch$
arch$ = ""
END IF
END IF
LOOP
CLS : COLOR 3
COLOR 15, 0: CLS
COLOR 12, 9: LOCATE 1, 32: PRINT " ARCHIVO INDICE "
COLOR 3, 0: LOCATE 2, 1, 0
IF ERR = 0 THEN FILES "*.tq1"
COLOR 2, 0: LOCATE 25, 1, 0: PRINT "Nombre de ARCHIVO: ? "; arch$;
OPEN "R", 1, arch$, 164
FIELD 1, 80 AS lin1$, 2 ASlf1$, 80 AS lin2$, 2 AS lf2$
LSET lf1$ = CHR$(13) + CHR$(10): LSET lf2$ = lf1$


IF LOF(1) = 0 THEN
COLOR 0, 15: LOCATE 25, 1: PRINT " El Archivo: ["; arch$; "] es Nuevo........[ENTER]=continuar [ESC]=anular ";
a$ = ""
WHILE a$ CHR$(13) AND a$ CHR$(27): a$ = INKEY$: WEND
IF a$ = CHR$(27) THEN CLOSE : KILL arch$: GOTO iniciando
IF a$ = CHR$(13) THENFOR x = 1 TO 41
LSET lin1$ = STRING$(80, " "): LSET lin2$ = STRING$(80, " ")
PUT 1, x
NEXT x
COLOR 12, 0: LOCATE 25, 1: PRINT SPACE$(80);
LOCATE 25, 1, 1, 5: INPUT "Tema: "; a$
GET 1, 1: LSET lin1$ = a$: PUT 1, 1
END IF
ELSE
IF kkl = 0 THEN
GET 1, 1: max% = LOF(1) / 164 - 21
OPEN "R", 2, LEFT$(arch$, LEN(arch$) - 4) + ".BAK", 164
CLOSE : KILLLEFT$(arch$, LEN(arch$) - 4) + ".BAK"
NAME arch$ AS LEFT$(arch$, LEN(arch$) - 4) + ".BAK"
OPEN "R", 1, arch$, 164
FIELD 1, 80 AS lin1$, 2 AS lf1$, 80 AS lin2$, 2 AS lf2$
OPEN "R", 2, LEFT$(arch$, LEN(arch$) - 4) + ".BAK", 164
FIELD 2, 80 AS lin11$, 2 AS lf11$, 80 AS lin22$, 2 AS lf22$
FOR kk = 1 TO max% + 21
GET 2, kk
LSET lin1$ = lin11$: LSET lf1$ = lf11$
LSETlin2$ = lin22$: LSET lf2$ = lf22$
PUT 1, kk
NEXT kk
CLOSE #2
END IF
END IF
GET 1, 1
IF lin2$ = STRING$(80, " ") THEN
LSET lin2$ = " 0.00 0.100 0.100 10.00 S 0.00000000 N N N N A N 0.0000 "
PUT 1, 1
END IF

salinic:
DIM nli$(180)
OPEN "r", #2, "archivo.dat", 80
FOR i = 1 TO 50
IF INSTR(arch$, "\") > 1 THENarch$ = MID$(arch$, INSTR(arch$, "\") + 1, 250)
NEXT
IF CURDIR$ = "" THEN aaw$ = "" ELSE aaw$ = "\"
FIELD #2, 80 AS archiv$: LSET archiv$ = CURDIR$ + aaw$ + arch$: PUT 2, 1
CLOSE #2
OPEN "r", #2, "c:\archivo.dat", 80
FIELD #2, 80 AS archiv$: LSET archiv$ = CURDIR$ + aaw$ + arch$: PUT 2, 1
CLOSE #2

GET 1, 1: max% = LOF(1) / 164 - 21
litot% = max%
nilu% = 1ppu% = 0: ncr% = 1: nc% = 2 'calcula linearreal inicio
grab = 0: ptlla = 1
aut$ = CHR$(65) + CHR$(117) + CHR$(116) + CHR$(111) + CHR$(114) + CHR$(58) + CHR$(71) + CHR$(46) + CHR$(84) + CHR$(46) + CHR$(67) + CHR$(104) + CHR$(46)

radiot# = VAL(MID$(lin2$, 2, 10))
disterr = VAL(MID$(lin2$, 14, 5))
cotaerr = VAL(MID$(lin2$, 21, 5))
anguerr = VAL(MID$(lin2$, 38, 5))...