[PASCAL] zakończenie programu w dowolnym momencie

#1

Mam pytanie: jak zrobic, żeby można było wyjść z programu w dowolnym momencie , po naciśnięciu ESC ?

kombinowałem coś z while a=#27 do halt(0), ale nie wiem jak zrobić, żeby do a przypisywało każde naciśnięcie klawisza podczas pracy programu.

Z programu mogę wyjść po naciśnięciu ESC (procedura check ), ale ona się sprawdza dopiero po procedurze oknaxy ,

Jak zrobic, zebym mógł wyjść w dowolnym momencie procedury oknaxy?

macie jakieś inne pomysły?

poniżej kod programu o którym mówię:

program okna;


{$mode objfpc}{$H+}


uses

  crt,Classes, SysUtils;


type

 okn=record

  x:byte;

  y:byte;

  x1:byte;

  y1:byte;

 end;




procedure check;

var a:char;

begin

repeat;

 while keypressed do readkey;

 a:=readkey;

 if a=#27 then halt(0);

until a=#9;

end;



procedure okno(var t:okn);

begin

window(t.x,t.y,t.x1,t.y1);

end;




procedure oknaxy(var t1,t2,t3,t4:okn; var c1,c2,c3,c4:BYTE);

var

a,b,c:byte;

begin

window(10,2,80,40);

textcolor(14);

writeln('Podaj szerokosc okna:');

readln(a);

writeln('Podaj wysokosc okna:');

readln(b);

textcolor(6);

writeln('Podaj odstępy miedzy oknami:');

readln(c);

writeln;

writeln;

textcolor(15);

writeln('Oto dostepne kolory:');

textcolor(0);

write('BLACK (0)');

textcolor(1);

write('BLUE (1)');

textcolor(2);

write('GREEN (2)');

textcolor(3);

writeln('CYAN (3)');

textcolor(4);

write('RED (4)');

textcolor(5);

write('MAGENTA (5)');

textcolor(6);

write('BROWN (6)');

textcolor(7);

writeln('LIGHTGRAY (7)');

textcolor(8);

write('DARKGRAY (8)');

textcolor(9);

write('LIGHTBLUE (9)');

textcolor(10);

write('LIGHTGREEN (10)');

textcolor(11);

writeln('LIGHTCYAN (11)');

textcolor(12);

write('LIGHTRED (12)');

textcolor(13);

write('LIGHTMAGENTA (13)');

textcolor(14);

write('YELLOW (14)');

textcolor(15);

write('WHITE (15)');

writeln;

writeln;

writeln('wybierz kolor dla pierwszej ramki:');

read(c1);

writeln('wybierz kolor dla drugiej ramki:');

read(c2);

writeln('wybierz kolor dla trzeciej ramki:');

read(c3);

writeln('wybierz kolor dla czwartej ramki:');

read(c4);

t1.x:=2;

t1.y:=2;

t1.x1:=2+a;

t1.y1:=2+b;

t2.x:=2+a+c;

t2.y:=2;

t2.x1:=2+a+c+a;

t2.y1:=2+b;

t3.x:=2;

t3.y:=2+b+c;

t3.x1:=2+a;

t3.y1:=2+b+c+b;

t4.x:=2+a+c;

t4.y:=2+b+c;

t4.x1:=2+a+c+a;

t4.y1:=2+b+c+b;

end;




procedure ramki(var t:okn; var c:byte);

var i:byte;

begin

okno(t);

textcolor(c);

for i:=1 to t.x1-t.x do

begin

gotoxy(i,1);

write('#');

end;

for i:=1 to t.y1-t.y do

begin

 gotoxy(1,i);

 write('#');

 gotoxy(t.x1-t.x,i);

 write('#');

 end;

 for i:=1 to t.x1-t.x do

 begin

 gotoxy(i,t.y1-t.y);

 write('#');

 end;

 check;

 end;




procedure kasowanie(var t:okn);

var i:byte;

begin

 okno(t);

 for i:=1 to t.y1-t.y do

  delline;

end;




procedure logout;

begin

clrscr;

gotoxy(10,2);

textcolor(5);

writeln('DZIEKUJE ZA UWAGE');

delay(1500);

textcolor(14);

writeln('Copyright by przebar');

delay(500);

sound(523);

delay(250);

sound(659);

delay(250);

sound(784);

nosound;

halt(0);

end;






var

 t1,t2,t3,t4:okn;

 c1,c2,c3,c4:byte;


begin

clrscr;

oknaxy(t1,t2,t3,t4,c1,c2,c3,c4);


clrscr;

check;

ramki(t1,c1);

ramki(t2,c2);

ramki(t3,c3);

ramki(t4,c4);


kasowanie(t1);

check;

kasowanie(t2);

check;

kasowanie(t3);

check;

kasowanie(t4);


clrscr;

window(10,10,40,40);

gotoxy(15,15);

logout;

end.
#2

Możesz zrobić coś takiego, że do wczytywania z klawiatury nie będziesz używał read() (BTW powinieneś używać readln()) tylko własnej funkcji, która będzie sama wczyta co trzeba z klawiatury i sprawdzi, czy nie dostała Esc. Jeśli tak, to wywołuje halt(0), w przeciwnym wypadku zwraca co trzeba.

#3

Ta własna funkcja do wczytywania danych z klawiatury, której użycie proponował beevvy , może wyglądać np tak:

procedure MyReadln(var Liczba: Byte);

const Enter = 13;

      Esc = 27;


var Ch: Char;

      T: string;

      Kod: Integer;

begin

  T:= '';

  repeat

    Ch:= Readkey;

    if Ord(Ch) = Esc then Halt;

    if Ord(Ch) <> Enter then begin

      Write(Ch);

      T:= T + Ch;

    end;

  until Ord(Ch) = Enter;

  Val(T, Liczba, Kod);

  Writeln;

end;

Tak więc tam gdzie w programie używasz np. Readln(a) użyj MyReadln(a). Wtedy naciśnięcie klawisza ESC spowoduje wyjście z programu.

Mała uwaga: ta procedura służy tylko do wczytywania danych typu Byte. Próba wpisania liczby zmiennoprzecinkowej lub tekstu spowoduje błąd programu.

PS. Czy ten program działa tak, jak powinien? U mnie po uruchomieniu mogłem tylko podać dane wejściowe, a następnie nacisnąć klawisz ESC, aby zakończyć. Po usunięciu kilku wystąpień procedury check program narysował jedną ramkę i na tym koniec.

#4

niezły patent:D

dzięki wielkie - działa;)