320x200x256
Table of Contents
|
Przydatne stałe
const
GetMaxX=319; {wartość maksymalna x - od 0 do 319 = 320 punktów}
GetMaxY=199; {wartość maksymalna y - od 0 do 199 = 200 punktów}
GetMaxColor=255; {wartość maksymalna c - od 0 do 255 = 256 kolorów}[[/code]]
Inicjalizacja i powrót
Inicjacja trybu graficznego 320x200x256
procedure init13h; assembler;
asm
mov ah, 00h; {do górnej połówki rejestru AX liczba 0}
mov al, 13h; {do dolnej połówki rejestru AX liczba 13h (dziesiętnie 19)}
int 10h; {wywołujemy przerwanie karty graficznej}
end;
Powrót do trybu tekstowego
procedure init03h; assembler;
asm
mov ah, 00h;
mov al, 03h;
int 10h;
end;
Pojedynczy piksel
Procedura zapalająca punkt na ekranie
procedure PutPixel (x, y: word; c: byte); assembler;
asm
mov ah, 0Ch;
mov al, c; {kolor piksela}
mov cx, x; {koordynata pozioma piksela}
mov dx, y; {koordynata pionowa piksela}
int 10h;
end;
Funkcja odczytująca punkt
function GetPixel(X,Y : Integer) : Byte;
begin
GetPixel:=MEM[$A000:Y*320+x];
end;
Rysowanie linii prostej
procedure Line(x1,y1,x2,y2,Kolor : integer);
var c,i : integer;
sx,sy,y,x : real;
begin
if x2<x1 then
begin
c:=x1;
x1:=x2;
x2:=c;
end;
if y2<y1 then
begin
c:=y2;
y2:=y1;
y1:=c;
end;
if (x2-x1)>(y2-y1) then
begin
sy:=(y2-y1)/(x2-x1);
y:=y1;
for i:=x1 to x2 do
begin
putpixel(i,round(y),Kolor);
y:=y+sy;
end;
end else
begin
sx:=(x2-x1)/(y2-y1);
x:=x1;
for i:=y1 to y2 do
begin
putpixel(round(x),i,Kolor);
x:=x+sx;
end;
end;
end;
Rysowanie linii poziomej
procedure LineH (x1, x2, y : Word; Color : Byte); assembler;
asm
mov cx, x2
sub cx, x1
add cx, 1
mov ax, y
mov di, ax
shl ax, 8
shl di, 6
add di, ax
add di, x1
mov ax, 0a000h
mov es, ax
mov al, Color
cld
rep stosb
end;
Rysowanie linii pionowej
procedure LineV (y1, y2, x : Word; Color : Byte); assembler;
asm
mov cx, y2
sub cx, y1
add cx, 1
mov ax, y1
mov di, ax
shl ax, 8
shl di, 6
add di, ax
add di, x
mov ax, 0a000h
mov es, ax
mov al, Color
@rysuj_linie:
mov es:[di], al
add di, 320
loop @rysuj_linie
end;
Prostokąt…
pusty
procedure Rectangle (x1, y1, x2, y2 : Word; Color : Byte);
begin
LineH (x1, x2, y1, Color);
LineH (x1, x2, y2, Color);
LineV (y1, y2, x1, Color);
LineV (y1, y2, x2, Color);
end;
pełny
procedure Bar (x1, y1, x2, y2 : Word; Color : Byte);
var
I : Word;
begin
for I := y1 to y2 do
LineH (x1, x2, I, Color);
end;
Wypełniony z ramką
procedure FillRectangle (x1, y1, x2, y2 : Word; Color : Byte; FillColor : Byte);
begin
Rectangle (x1, y1, x2, y2, Color);
Bar (Succ(x1), Succ(y1), Pred(x2), Pred(y2), FillColor);
end;
Podobne strony
Podobne Strony
Table of Contents
|
wersja strony: 6, ostatnia edycja: 21 Jul 2009 07:28