320x200x256

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;
Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-ShareAlike 3.0 License