3. Текст програми.
{ Головна програма }
Program Kyrsak;
Uses CRT,SVGA,VideoTest ;
Label 1;
procedure Restore;
Begin
ClrScr;
textcolor(12);
writeln (' Information about videoadaptor ');
textcolor(14);
InfoVesa(true);
end;
procedure AboutBoxShow;
Var f: TEXT; s:string;
Begin
ClrScr;
assign(f,'About.txt');
reset(f);
while not EOF(f) do
while not Eoln(f) do
Begin
readln(f,s);
writeln(s);
End;
Close(f);
End;
Var
key:Char;

Begin
1:
ClrScr;
Restore;
textcolor(15);
writeln; writeln('Vuberit'' odun iz rezumiv :');
textcolor(4); writeln('1. Pro program;');textcolor(15);
textcolor(4); writeln('T. Testyvannja;'); textcolor(15);
textcolor(4); writeln('0. Vuhid.'); textcolor(15);
key:='`';
while key<>'0' do
Begin
key:=readkey;
if Key='1' then Begin AboutBoxShow; readkey; goto 1 End;
if key='0'then halt;
if (Key='t') or (Key='T') then
Begin
StartTestVideo;
Goto 1;
End;
End;
End.
{ Модуль розроблений, який визначає характеристики відеокарти }
Unit SVGA;
interface
Uses Crt,Dos;
Type
TVESAInfo = Record
ID : Array [0..3] of Char;
Ver : Word;
Name : PChar;
TotalMemory : Word;

End;
var Buf:TVESAInfo;
nam:Pchar;
i,j:integer;
k:byte;
Name: string;
function InfoVESA(writ: boolean) : boolean;
implementation
function InfoVESA(writ: boolean): boolean;
Var r:word;
begin
asm
mov ax,4f00h
mov di,offset buf
int 10h
mov k,ah
End;
If writ= true Then Begin
if (k=0) then
Begin
InfoVesa:=true;
write(' ');
for i:=0 to 3 do write(buf.id[i]);
WriteLn (' ver ', buf.Ver shr 8, '.', buf.Ver and 255);
textcolor(11);
write('Imja vurobnuka : ');
textcolor(14);
nam:=buf.name;
while (nam^<>#0) do begin write(nam^);name:=name+nam^; inc(nam); end;
textcolor(11);
writeln;
write('Objem pamjati : ');
textcolor(14);
write(buf.totalmemory*64, ' Kb');
asm
mov ax,4F03h
int 10h
mov r,bx
end;
End
else begin InfoVesa:=false; write('Error : Vash videokarta ne pidtrumyje rezhumy'); halt;end;
End;
End;
End.
{ Модуль для тестування вiдеокарти }
Unit VideoTest;
interface
Uses crt,dos;
Var l_x,l_y,l_c:integer; x,y:integer; v:byte; xx:real;
procedure StartTestVideo;
implementation
procedure SetTextMode;assembler;
asm
mov ax,0003h
int 10h
end;
Procedure SetVESAMode (Mode : Word);assembler;
asm
mov ax,4F02h
mov bx,mode
int 10h
End;
procedure Pix(x,y: integer; v:byte);assembler;
asm
mov ah,0Ch
mov bh,0
mov DX,x
mov cx,y
mov al,v
int 10h
End;
procedure NewPage; assembler;
asm
mov ax,4F02h
mov bx,101h
int 10h
End;
procedure NewPageVisual(i:word; d:integer);assembler;
Var j:word;
asm
xor bx,bx
xor dx,dx
mov ax,4f07h
int 10h
mov j,0
@star:
mov dx,j
mov ax, 4F07h
int 10h
inc j
mov ax,i
push d
call delay
cmp j,ax
jnz @star
End;
procedure LineWH(k,l_c,l_y:integer;c:word);
Begin
for l_x:=0 to k do
Begin
l_c:=l_c+1;
l_y:=l_y+1;
pix(l_y,l_c,c);
End;
End;
procedure LineH(x,y,x1,y1:integer; c:word);assembler;
asm
@start:
push y
push x
push c
call pix
inc x
mov cx,x1
cmp x,cx
jnz @start
End;
procedure LineW(x,y,x1,y1:integer; c:word);assembler;
asm
@start:
push y
push x
push c
call pix
inc y
mov cx,y1
cmp y,cx
jnz @start
End;
procedure Graph_sin;
Const a=0; b=2*pi; h=0.1; h1=5; x0=4; y0=400; m=50;
Var x1,y1:integer; x,y:real;
function f(x:real):real;
Begin
f:=ln(x+1);
end;
function f1(x:real):real;
Begin
f1:=sin(x);
end;
function f2(x:real):real;
Begin
f2:=cos(x);
end;
Begin
LineH(10,y0,310,y0,2);
LineW(15,330,15,450,2);
x:=a; x1:=x0+trunc(M*x);
y:=f(x); y1:=y0-trunc(m*y);
while x<=b do
begin
y:=f(x); y1:=y0-trunc(M*y);
Pix(y1,x1,7);
y:=f1(x); y1:=y0-trunc(M*y);
Pix(y1,x1,9);
y:=f2(x); y1:=y0-trunc(M*y);
Pix(y1,x1,12);
x1:=x1+h1;
x:=x+h;
End;
End;
procedure Circle(x,y,r:word);
Var i,x1,y1:integer; xx:real;
Begin
for I:=0 to r do
Begin
x1:=x+trunc(r*sin(xx));
y1:=y-trunc(r*cos(xx));
xx:=xx+0.1;
Pix(y1,x1,15);
End;
End;
procedure Objekt(x,y:word; c: byte);
Begin
LineH(x,y,x+100,y,c);
LineW(x,y,x,y+100,c);
LineH(x,y+100,x+100,y+100,c);
LineW(x+100,y,x+100,y+100,c);
LineWH(50,x+100,y+100,c);
LineWH(50,x+100,y,c);
LineWH(50,x,y+100,c);
LineH(x+50,y+150,x+150,y+150,c);
LineW(x+150,y+50,x+150,y+150,c);
LineWH(50,x,y,c);
LineH(x+50,y+50,x+150,y+50,c);
LineW(x+50,y+50,x+50,y+150,c);
End;
procedure StartTestVideo;
var
i,j:integer;
Begin
SetVESAMode ($101);
LineH(0,0,635,0,15);
LineW(0,0,0,475,15);
LineW(635,0,635,475,15);
LineH(0,475,635,475,15);
LineH(1,258,634,258,4);
LineW(316,1,316,474,4);
{-----Kub-------}
Objekt(390,50,15);
{----Grafix-----}
Graph_sin;
Circle(470,380,75);
{------Palitra_____}
for i:=10 to 309 do
for j:=1 to 256 do
Pix(j,i,j-1);
Readkey;
{----- 3D Kyb -----}
NewPageVisual(480,10);
NewPage;
repeat
Objekt(x,y,0);
xx:=xx+0.04;
x:=265+trunc(150*cos(xx));
y:=150-trunc(150*sin(xx));
Objekt(x,y,2);
delay(100);
until keypressed;
SetTextMode;
readkey;
End;
End.
4. Блок схеми.


5. Результат роботи програми.
Запустивши програму на екрані зявляється :

В лівій – верхній частині вікна показується інформація про відеоадаптор, тобто: версія VESA, назва виробника, версія продукту, та обєм памяті.
Нажавши “1”, програма виводить інформацію про автора програми.


Нажавши “T” поченається тестуватися відеокарта, тобто виводить графіку на екран. Кінцевий результат повинен бути :

Після чого поченає по кругу рухатися квадрат поки не нажати будь яку клавішу.
ВИСНОВОК:
У даній курсовій роботі я розробив програму для визначення основних характеристик та тестування відеоадаптора на мові програмування паскаль, з використанням вставок мови асемблер
Список використаної літератури
1. В. Ф. Шаньгин, Л. М. Поддубная “Програмированиє на язике ПАСКАЛЬ” М.: “Висшая школа”, 1991р.
С.Зубков – “Assembler дял DOS, Windows и UNIX”, М.: 2006р.
Зубков С. В. Assembler для DOS, Windows u Unix. Москва, 1999.
Абель П. Язык ассемблера для IBM PC и программирувание. – М.: Высшая школа, 1992.
Рудаков П. И., Финогенов К. Г. Язык ассемблера: уроки программирование. – М.: Диалог – Мифи, 2001.
Методичні вказівки до лабораторних робіт з курсу “Проблемно-орієнтовані мови програмування ”.