Ho rivisto il programma:
Uses graph, crt;
function inizio_graf:boolean;
var sg,ng:integer;
begin
sg:=detect; ng:=0;
initgraph(sg, ng, '');
inizio_graf:=graphresult = grOk;
end;
Procedure disegno(x,y:integer); // Disegna la figura a video
Begin
setColor(green);
Circle(x,y,13);
setFillStyle(1, red);
floodFill(x, y, green);
End;
procedure inizio(var immagine,vuoto:pointer); // Memorizza le fugure in immagine e vuoto
var dimensione:word;
begin
clearDevice; // pulizia del video
dimensione:=imageSize(0,0, 26,26); // Calcolo della memoria necessaria a memorizzare le figure
getMem(immagine, dimensione); // allocazione della memoria per immagine
getMem(vuoto, dimensione); // allocazione della memoria per vuoto
getImage(0,0, 26,26, vuoto^); // in vuoto memorizzo un rettangolo nero
disegno(13, 13);
getImage(0,0, 26,26, immagine^); // in immagine memorizzo il disegno
putImage(0, 0, vuoto^, normalPut); // in vuoto, è memorizzato un quadrato nero,
// quindi con questa istruzione pulisco lo schermo.
end;
procedure immagine(x,y:integer; figura:pointer);
begin
putImage(x, y, figura^, normalPut); // Genere l'immagine memorizzata in figura
// putImage lavora tramite puntatori, di conseguenza figura va indicata con ^ finale.
end;
Var ch:char;
x,y:integer;
palla,nero:pointer;
Begin
if inizio_graf then
begin
X:=400;
Y:=300;
inizio(palla, nero);
Repeat
If keypressed then
begin
Ch:=readkey;
if ch='w' then
begin
immagine(x, y, nero); // cancella la figura precedente
Y:=y - 20;
immagine(x, y, palla) // disegna l'immagine nella nuova posizione.
end;
if ch='s' then
begin
immagine(x, y, nero);
x:=x + 20;
immagine(x, y, palla);
end;
if ch='a' then
begin
immagine(x, y, nero);
x:=x - 20;
disegno(x+13, y+13); // Richiamo la procedura disegno
// per un confronto con immagine.
end;
if ch='z' then
begin
immagine(x, y, nero);
y:=y + 20;
immagine(x, y, palla);
end;
end;
Until upCase(ch)='Q';
closegraph;
freeMem(palla);
freeMem(nero);
// Alla fine del programma è necessario deallocare
// la memoria in palla e nero tramite la funzione freeMem.
end;
End.
