{
*****************************************************************************
* *
* Programador..........: Pedro Miguel de Andrade Tarrinho *
* Idade................: 16 anos *
* Morada...............: R. Jos Rodrigues da Silva Jnior N 401 *
* 2 ESQ. Frente - 4470 VERMOIM - MAIA *
* Telefone.............: 02 9486220 *
* Ano de escolaridade..: 10 ano na Escola Secundria da Maia *
* Data - Inicio........: 10-03-94 *
* Data - Fim ..........: 27-03-94 *
* Linguagem............: PASCAL 6 *
* *
* *
*****************************************************************************
}
Program sistema (input,output);
uses crt,dos;
type vect=array [1..10] of real;
const
enter:char=chr(13);
esc:char=chr(27);
setapcima:Char= chr(72);
setapbaixo:Char= chr(80);
var
OPCOES :ARRAY [1..10] OF STRING;
vARIAVEL:STRING;
MOUSE,metodo,pi,vezes,nequa,MATRIZ,ok,i,j,sair,C,OPCA,NOPCA:integer;
saire,mouse1,sai,ik,ink,inki,tecla:char;
TOTAL:REAL;
coefi:array [0..4, 0..4] of real;
term:array [1..5] of real;
x:vect;
vector:array [1..5] of string;
procedure cor (letra,fundo:integer);
begin
textcolor (letra);
textbackground (fundo);
end;
procedure som (altura,tempo:integer);
begin
sound (altura);
delay (tempo);
nosound
end;
procedure AUTOR;
begin
cor (9, 1);
GOTOXY (59,1);
write ('Pedro Tarrinho--1994');
end;
procedure Boxd (l1, c1, l2, c2, C:integer);
VAR LAI,LAJ:INTEGER;
begin
cor (0,0);
FOR LAi := l1 + 1 TO l2 + 1 do begin
FOR LAj := c1 + 2 TO c2 + 2 do begin
GOTOXY (LAJ,LAi);
write ('');
end;
end;
cor (C,0);
FOR LAi := l1 TO l2 do begin
FOR LAj := c1 TO c2 do begin
GOTOXY (LAJ,LAi);
write ('');
end;
end;
AUTOR;
end;
procedure box1 (l1, c1, l2, c2, corp, corf:integer);
VAR LAI,LAJ:INTEGER;
begin
cor (corp, corf);
GOTOXY (C1,l1);
write ('');
GOTOXY (C2,l1);
write ('');
GOTOXY (C1,l2);
write ('');
GOTOXY (C2,l2);
write ('');
FOR LAi := c1 + 1 TO c2 - 1 do begin
GOTOXY (LAI,l1);
write ('');
GOTOXY (LAI,l2);
write ('');
end;
FOR LAi := l1 + 1 TO l2 - 1 do begin
GOTOXY (c1,LAI);
write ('');
GOTOXY (c2,LAI);
write ('');
end;
AUTOR;
end;
PROCEDURE LIMPAR(LINHA,COLUNA,LINHA2,COLUNA2,CORE:INTEGER);
VAR LAI,JAI:INTEGER;
BEGIN
COR(CORE,0);
FOR LAI:=LINHA TO LINHA2 DO
BEGIN
FOR JAI:=COLUNA TO COLUNA2 DO
BEGIN
GOTOXY(JAI,LAI);
WRITE('');
END;
END;
END;
procedure ENTRAda ;
var
faz:integer;
begin
repeat
enter := CHR(13);
cor (3, 1); clrscr;
GOTOXY (3,6); write (' ');
GOTOXY (3,7); write (' ');
GOTOXY (3,8); write (' Este programa tem como objectivo resolver um sistema ');
GOTOXY (3,9); write (' de N equaes pelo mtodo de Seidel ');
GOTOXY (3,10); write (' ');
GOTOXY (3,11); write (' ATENO: A DIAGONAL TEM QUE SER DOMINANTE ');
GOTOXY (3,12); write (' ');
GOTOXY (3,13); write (' BY PEDRO MIGUEL DE ANDRADE TARRINHO ');
GOTOXY (3,14); write (' ');
GOTOXY (3,15); write (' ');
GOTOXY (3,16); write (' ');
cor (19, 1); GOTOXY (22,15);
write (' PRIMA PARA CONTINUAR ');
cor (3, 1); GOTOXY (3,17);
ik:=readkey;
UNTIL IK = enter;
end;
procedure metodo1;
begin
if nequa >= 1 then
begin
gOtoxy(10,15);
write('X1=',x[1]:10:8,'');
end;
if nequa >= 2 then
begin
gOtoxy(30,15);
write('X2=',x[2]:10:8,'');
end;
if nequa >= 3 then
begin
gOtoxy(50,15);
write('X3=',x[3]:10:8,'');
end;
if nequa >= 4 then
begin
gOtoxy(10,17);
write('X4=',x[4]:10:8,'');
end;
if nequa >= 5 then
begin
gOtoxy(30,17);
write('X5=',x[5]:10:8,'');
end;
delay (250);
end;
procedure metodo2;
begin
pi:=pi+1;
if pi=vezes+10 then
begin
METODO1;
END;
end;
procedure quadro;
begin
gotoxy(10,15);
write (' ( 1 ) - Visualizao progressiva dos resultados ');
gotoxy(10,17);
write (' ( 2 ) - Visualizao imediata dos resultados ');
end;
procedure chaveta (nequa:integer);
var
inicio:integer;
begin
inicio:=6;
COR (3,0);
if (nequa = 2) OR (NEQUA=3)then
BEGIN
GOTOXY(inicio,6);
WRITE ('');
GOTOXY(inicio-1,7);
WRITE ('');
GOTOXY(inicio,8);
WRITE ('');
END;
if (nequa = 4) OR (NEQUA = 5) then
BEGIN
GOTOXY(inicio,6);
WRITE ('');
GOTOXY(inicio,7);
WRITE ('');
GOTOXY(inicio-1,8);
WRITE ('');
GOTOXY(inicio,9);
WRITE ('');
GOTOXY(inicio,10);
WRITE ('');
END;
end;
procedure lugar (junta:integer);
var
kai:integer;
talvez:integer;
begin
talvez:=0;
if nequa mod 2 = 0 then
if nequa/2 <= junta then talvez:=1;
for kai:=0 to nequa-1 do
begin
GOTOXY(8+(kai*9),6+JUNTA+talvez);
WRITE (coefi[JUNTA][KAI]:4:1,'X',kai+1,' + ');
end;
end;
procedure lugar_term (junta:integer);
var
talvez:integer;
contador:integer;
begin
talvez:=0;
if nequa mod 2 = 0 then
begin
if nequa/2 <= junta then talvez:=1;
end;
for contador:=1 to nequa do
begin
if nequa = contador then
begin
gotoxy(6+(3*contador)+((NEQUA)*6),6+junta+talvez);
WRITE ('=',term[JUNTA+1]:4:1);
end;
end;
end;
procedure print_equa;
begin
COR (3,0);
if (nequa = 2) OR (NEQUA=3)then
BEGIN
lugar(0);
lugar_term(0);
lugar(1);
lugar_term(1);
if nequa = 3 then
begin
lugar(2);
lugar_term(2);
end;
END;
if (nequa = 4) OR (NEQUA = 5) then
BEGIN
lugar (0);
lugar_term(0);
lugar (1);
lugar_term(1);
lugar (2);
lugar_term(2);
lugar (3);
lugar_term(3);
if nequa = 5 then
begin
lugar (4);
lugar_term(4);
end;
END;
end;
PROCEDURE PERGUNTA (VAR RESULTA:INTEGER; LINHA,COLUNA,CORF,CORT,TAMANHO:INTEGER; TEXTO:STRING);
VAR LAI:INTEGER;
BEGIN
COR(CORT,CORF);
FOR LAI:=1 TO 18 DO
BEGIN
GOTOXY(COLUNA+TAMANHO+LAI,LINHA);
WRITE ('');
END;
GOTOXY(COLUNA,LINHA);
WRITE (TEXTO);
GOTOXY(coluna+tamanho+2,linha);
READLN(VARIAVEL);
VAL(VARIAVEL,RESULTA,C);
END;
PROCEDURE PERGUNTA1 (VAR RESULTA:REAL; LINHA,COLUNA,CORF,CORT,TAMANHO,QUAL:INTEGER);
VAR LAI:INTEGER;
BEGIN
COR(CORT,CORF);
FOR LAI:=1 TO TAMANHO-10 DO
BEGIN
GOTOXY(COLUNA+TAMANHO+LAI,LINHA);
WRITE ('');
END;
GOTOXY(COLUNA,LINHA);
IF QUAL = 1 THEN WRITE (' Qual o [ ',j+1,' ] [ ',i+1,' ] coeficiente ? ');
IF QUAL = 2 THEN
BEGIN
GOTOXY(TAMANHO+COLUNA+9,LINHA);
WRITE ('');
GOTOXY(COLUNA,LINHA);
WRITE ('Qual o ',i+1,' termo independente ? ');
END;
GOTOXY(coluna+tamanho+2,linha);
READLN(VARIAVEL);
VAL(VARIAVEL,RESULTA,C);
END;
PROCEDURE REGRA ;
VAR
COE:ARRAY [1..20] OF REAL;
hai,PI:INTEGER;
begin
FOR PI:=1 TO 5 DO
BEGIN
COE[PI]:=0;
eND;
COE[1]:=(ABS(coefi[0][1])+ABS(coefi[0][2])+ABS(coefi[0][3])+ABS(coefi[0][4]));
COE[2]:=(ABS(coefi[1][0])+ABS(coefi[1][2])+ABS(coefi[1][3])+ABS(coefi[1][4]));
COE[3]:=(ABS(coefi[2][1])+ABS(coefi[2][0])+ABS(coefi[2][3])+ABS(coefi[2][4]));
COE[4]:=(ABS(coefi[3][1])+ABS(coefi[3][2])+ABS(coefi[3][0])+ABS(coefi[3][4]));
COE[5]:=(ABS(coefi[4][1])+ABS(coefi[4][2])+ABS(coefi[4][3])+ABS(coefi[4][0]));
for hai:=0 to 4 do begin
IF (MATRIZ=hai) and (ok=0) THEN
IF (abs(coefi[hai][hai]) <= COE[hai+1]) or (coefi[hai][hai] = 0) THEN
BEGIN
GOTOXY (10,23);
WRITELN('O [',hai+1,'] COEFICIENTE TEM QUE SER MAIOR QUE A SOMA DOS OUTROS ');
J:=J-1;
END;
END;
END;
procedure aproxima (var x:vect);
VAR
CE:ARRAY [1..5] OF REAL;
TAI:INTEGER;
begin
FOR TAI:=1 TO 5 DO
BEGIN
CE[TAI]:=0;
X[TAI]:=0
END;
TAi:=0;
repeat
tai:=tai+1;
GOTOXY (5,25);
write (' Prima (S) para sair ou (N) para resolver mais sistemas ');
ink:=enter;
if keypressed then ink:=readkey;
ink:=upcase(ink);
IF NEQUA >= 1 THEN x[1]:=(term[1]-coefi[0][1]*x[2]-coefi[0][2]*(x[3])-coefi[0][3]*(x[4])-coefi[0][4]*(x[5])-CE[1])/coefi[0][0];
IF NEQUA >= 2 THEN x[2]:=(term[2]-coefi[1][0]*x[1]-coefi[1][2]*(x[3])-coefi[1][3]*(x[4])-coefi[1][4]*(x[5])-CE[2])/coefi[1][1];
IF NEQUA >= 3 THEN x[3]:=(term[3]-coefi[2][0]*x[1]-coefi[2][1]*(x[2])-coefi[2][3]*(x[4])-coefi[2][4]*(x[5])-CE[3])/coefi[2][2];
IF NEQUA >= 4 THEN x[4]:=(term[4]-coefi[3][0]*x[1]-coefi[3][1]*(x[2])-coefi[3][2]*(x[3])-coefi[3][4]*(x[5])-CE[4])/coefi[3][3];
IF NEQUA >= 5 THEN x[5]:=(term[5]-coefi[4][0]*x[1]-coefi[4][1]*(x[2])-coefi[4][2]*(x[3])-coefi[4][3]*(x[4])-CE[5])/coefi[4][4];
if metodo=1 then metodo1;
if metodo=2 then metodo2;
saire := ink;
until (ink='S') or (ink='N');
end;
PROCEDURE MENU1;
VAR LAI:INTEGER;
BEGIN
cor (0,1);
clrscr;
boxd (6,20,21,62,3);
box1 (6,20,21,62,1,3);
OPCA := 1 ; {OPAO ACTUAL}
NOPCA := 10; {N TOTAL DE OPOES}
GOTOXY(32,3);
WRITE ('SISTEMA V. 1.0');
FOR LAI := 1 TO 10 DO BEGIN
cor (3,0);
gotoxy (25,8+LAi);
WRITE (opcoes[LAi]);
END;
cor (7,0);
gotoxy (25,8+OPCA);
WRITE (opcoes[opca]);
cor (8,9);
gotoxy (14,24);
write ('O cursor move-se com a seta para cima e a seta para baixo ');
gotoxy (28,25);
write ('Prima para Validar');
END;
BEGIN
OPCOES[1] := 'RESOLUO DE UM SISTEMA';
OPCOES[2] := '';
OPCOES[3] := '';
OPCOES[4] := '';
OPCOES[5] := 'CRDITOS';
OPCOES[6] := '';
OPCOES[7] := '';
OPCOES[8] := '';
OPCOES[9] := 'SAIR PARA O DOS';
OPCOES[10] := '';
clrscr;
entrada;
repeat
MENU1;
repeat
gotoxy (58,8+OPCA);
repeat
inki := readkey ;
until (inki = setapcima) or (inki= setapbaixo) or (inki=enter) or (inki=esc);
cor (3,0);
gotoxy (25,8+OPCA);
WRITE (opcoes[opca]);
if inki = setapcima then
if opca = 1 then opca := nopca -1 else opca := opca - 4;
if inki = setapbaixo then
if opca = nopca -1 then opca := 1 else opca := opca + 4;
cor (7,0);
gotoxy (25,8+OPCA);
WRITE (opcoes[opca]);
until (inki = enter) or (inki=esc);
if (opca = 1) and (inki=enter) then
BEGIN
repeat
cor(0,3);
clrscr;
boxd (2,2,24,77,3);
box1 (2,2,24,77,1,3);
boxd (19,5,21,72,3);
box1 (19,5,21,72,1,3);
cor (15, 3);
GOTOXY (1,1);
write (' Este programa resolve sistemas pelo mtodo de SEIDEL ');
cor (15, 0);
GOTOXY (5,25);
write (' Prima para Validar ou para apagar o ltimo carater .');
pi:=10;
vezes:=500;
REPEAT
PERGUNTA (NEQUA,20,6,0,3,47, 'Quantas equaes tem o sistema (max. 5/min. 2)? ');
UNTIL (nEQUA >=2) AND (NEQUA <= 5);
chaveta (nequa);
for J:=0 to 4 do
begin
for I:=0 to 4 do
begin
COEFI[I][J]:=0;
x[i+1]:=0;
term[i+1]:=0;
end;
end;
for i:=0 to nequa-1 do
begin
j:=0;
REPEAT
OK:=-1;
SAIR:=0;
PERGUNTA1 (coefi[i][j], 20,6,0,3,35,1 );
TOTAL:=TOTAL+coefi[i][j];;
IF J>=I THEN OK:=0;
MATRIZ:=I;
REGRA ;
J:=J+1;
print_equa;
UNTIL J=NEQUA;
GOTOXY (9,23);
WRITELN('');
PERGUNTA1 (term[i+1], 20,6,0,3,32,2 );
print_equa;
end;
LIMPAR(15,5,22,76,3);
quadro;
boxd (19,4,21,72,3);
box1 (19,4,21,72,1,3);
repeat
COR(3,0);
GOTOXY (70,18);
WRITELN('');
cor(3,1);
gotoxy(5,20);
write('Qual o mtodo a ser utilizado para a impresso dos resultados ? ');
readln(variavel);
val(variavel,metodo,c);
until (metodo>=1) and (metodo <=2);
LIMPAR(15,4,22,76,3);
aproxima(x);
until saire='S';
end;
if (opca = 5) and (inki=enter) then
BEGIN
cor (15,1);
clrscr;
boxd (5,10,20,70,3);
box1 (5,10,20,70,1,3);
autor;
gotoxy (26,21);
write ('Prima para Continuar');
COR (0, 7);
gotoxy (15,9);
write ('Programador...: Pedro Miguel de Andrade Tarrinho ');
gotoxy (15,11);
write ('Data - Inicio.: 10-03-94');
gotoxy (15,13);
write ('Data - Fim ...: 27-03-94');
gotoxy (15,15);
write ('Linguagem.....: PASCAL 6');
tecla:=esc;
gotoxy(80,25);
cor (1,1);
repeat
if keypressed then tecla:=readkey;
until tecla=enter;
END;
if ((opca = 9) and (inki=enter)) or (inki=esc) then begin
repeat
gotoxy(30,19);
write('Quer mesmo sair (S/N)? ');
ink:=READKEY;
ink:=upcase(ink);
until (ink = 'S') or (ink = 'N');
if ink = 'S' then
begin
clrscr;
boxd (10,15,19,65,3);
box1 (10,15,19,65,1,3);
gotoxy(18,13);
write (' Espero que este programa o tenha ajudado ');
gotoxy(18,16);
write (' By PEDRO TARRINHO ');
delay (4000);
cor (7,0);
clrscr;
exit;
end;
cor (0,7);
gotoxy(28,19);
write(' ');
end;
until vezes=-1;
end.