{X+} (* Zapinam extended syntax, to mi umozni napsat
primo Readkey. Spravne bych mel psat CH:=READKEY *)
USES Crt;
CONST VGA = a000; (* Pocatek videopameti *)
{----------------------------------------------------------------}
Procedure SetMCGA; { Tato procedura zapne mod 320x200x256. }
BEGIN
asm
mov ax,0013h
int 10h
end;
END;
{----------------------------------------------------------------}
Procedure SetText; { Zapnuti textoveho modu. }
BEGIN
asm
mov ax,0003h
int 10h
end;
END;
{----------------------------------------------------------------}
Procedure Cls (Col : Byte);
{ Maze obrazovku zadanou barvou. }
BEGIN
Fillchar (Mem [a000:0],64000,col);
END;
{----------------------------------------------------------------}
Procedure INTPutpixel (X,Y : Integer; Col : Byte);
{ Kresleni bodu pomoci preruseni. }
BEGIN
asm
mov ah,0Ch
mov al,[col]
mov cx,[x]
mov dx,[y]
mov bx,[1]
int 10h
end;
END;
{----------------------------------------------------------------}
Procedure TestINTPutpixel;
{ Zaplni obrazovku nahodnymi body pomoci INTPutpixel. }
VAR loop1,loop2 : Integer;
BEGIN
For loop1:=0 to 319 do
For loop2:=0 to 199 do
INTPutpixel (loop1,loop2,Random (256));
Readkey;
Cls (0);
END;
{----------------------------------------------------------------}
Procedure MEMPutpixel (X,Y : Integer; Col : Byte);
{ Kresleni bodu primym zapisem do videopameti. }
BEGIN
Mem [VGA:X+(Y*320)]:=Col;
END;
{----------------------------------------------------------------}
Procedure TestMEMPutpixel;
{ Nahodne zaplneni obrazovky pomoci MEMPutpixel. }
VAR loop1,loop2 : Integer;
BEGIN
For loop1:=0 to 319 do
For loop2:=0 to 199 do
MEMPutpixel (loop1,loop2,Random (256));
Readkey;
Cls (0);
END;
{----------------------------------------------------------------}
BEGIN (* HLAVNI PROGRAM *)
ClrScr;
Writeln ('Pockam na klavesu, smazu obrazovku, pockam na kl.,');
Write ('smazu znova obrazovku, ale jinou barvou,');
Write ('pockam na klavesu,');
Writeln ('naplnim obrazovku nahodnym vzorkem. 1) pomoci INT,');
Write ('2) primym zapisem do videopameti.');
Write ('Mezi obema pockam na');
Writeln ('klavesu. Na zaver znovu zapnu textovy mod.');
Writeln; Writeln;
Write ('Zmackni klavesu a jedem ...');
Readkey;
SetMCGA;
CLS (32);
Readkey;
CLS (90);
Readkey;
TestINTPutpixel;
TestMEMPutpixel;
SetText;
END.
výheň