Курсовая работа по информатике



бет6/7
Дата22.06.2022
өлшемі201,5 Kb.
#146948
түріКурсовая
1   2   3   4   5   6   7
Байланысты:
kursovik
ответы по гигиене
UNIT VGA13h;
INTERFACE
Type
PScreen = ^TScreen;
TScreen = Array [0..199,0..319] of Byte;
Const
ScreenHeight = 200;
ScreenWidth = 320;
GetMaxY = ScreenHeight-1;
GetMaxX = ScreenWidth-1;
MidX = GetMaxX div 2;
MidY = GetMaxY div 2;
PageSize = ScreenHeight*ScreenWidth;
QuarterSize = PageSize div 4;
VideoSegment:Word = 0;
Base1:Word = 0;
Base2:Word = 0;
Page1:PScreen = NIL;
Page2:PScreen = NIL;
Function DetectVGA:Boolean;
Procedure SetGraphMode;
Procedure SetTextMode;
Procedure MakePixelSquare;
Procedure CopyBase(Source,Destin:Word);
Procedure ClearBase(Base:Word);
Procedure FillBase(Base,Ofs,Count:Word;Color:Longint);
Procedure MoveBase(Source,Destin,Count:Word);
Procedure TileBase(Base,Ofs,Count:Word;Tile:Pointer;Len:Word);
Procedure PutPixel(Base:Word;x,y:Integer;Color:Byte);
Function GetPixel(Base:Word;x,y:Integer):Byte;
Procedure Line(Base:Word;x1,y1,x2,y2:Integer;Color:Byte);
Procedure VLine(Base:Word;x,y1,y2:Integer;Color:Byte);
Procedure HLine(Base:Word;y,x1,x2:Integer;Color:Byte);
Procedure Bar(Base:Word;x1,y1,x2,y2:Integer;Color:Byte);
Procedure Polygon(Base:Word;x1,y1,x2,y2,x3,y3,x4,y4:Integer;c:Byte);
Function InitVirtualPage:Boolean;
Procedure DoneVirtualPage;
IMPLEMENTATION
Var
VirtualPage:Pointer;

{$L VGA13H.OBJ}


Function DetectVGA; external;
Procedure SetGraphMode; external;
Procedure SetTextMode; external;
Procedure MakePixelSquare; external;
Procedure CopyBase; external;
Procedure ClearBase; external;
Procedure FillBase; external;
Procedure MoveBase; external;
Procedure TileBase; external;
Procedure PutPixel; external;
Function GetPixel; external;
Procedure HLine; external;
Procedure VLine; external;

Procedure Polygon;


Var
xpos:array [0..199,0..1] of Word;
mny,mxy,y:Integer;
i:Word;
s1,s2,s3,s4:Shortint;
begin
mny:=y1;
if y2if y3if y4mxy:=y1;
if y2>mxy then mxy:=y2;
if y3>mxy then mxy:=y3;
if y4>mxy then mxy:=y4;
s1:=byte(y1s2:=byte(y2s3:=byte(y3s4:=byte(y4y:=y1;
if y1<>y2 then
Repeat
xpos[y,byte(y1y:=y+s1;
Until y=y2+s1
else xpos[y,byte(y1y:=y2;
if y2<>y3 then
Repeat
xpos[y,byte(y2y:=y+s2;
Until y=y3+s2
else xpos[y,byte(y2y:=y3;
if y3<>y4 then
Repeat
xpos[y,byte(y3y:=y+s3;
Until y=y4+s3
else xpos[y,byte(y3y:=y4;
if y4<>y1 then
Repeat
xpos[y,byte(y4y:=y+s4;
Until y=y1+s4
else xpos[y,byte(y1for y:=mny to mxy do HLine(Base,y,xpos[y,0],xpos[y,1],c);
end;
Procedure Line;
Var
dx,dy,sx,sy,d,d1,d2,x,y,i:Integer;
begin
dx:=Abs(x2-x1);
dy:=Abs(y2-y1);
if x2>=x1 then sx:=+1 else sx:=-1;
if y2>=y1 then sy:=+1 else sy:=-1;
Mem[Base:(y1 shl 8)+(y1 shl 6)+x1]:=Color;
if dy<=dx then
begin
d:=(dy shl 1)-dx;
d1:=dy shl 1;
d2:=(dy-dx) shl 1;
x:=x1+sx;
y:=y1;
for i:=1 to dx do
begin
if d>0 then
begin
d:=d+d2;
y:=y+sy;
end else d:=d+d1;
Mem[Base:(y shl 8)+(y shl 6)+x]:=Color;
x:=x+sx;
end;
end
else begin
d:=(dx shl 1)-dy;
d1:=dx shl 1;
d2:=(dx-dy) shl 1;
x:=x1;
y:=y1+sy;
for i:=1 to dy do
begin
if d>0 then
begin
d:=d+d2;
x:=x+sx;
end else d:=d+d1;
Mem[Base:(y shl 8)+(y shl 6)+x]:=Color;
y:=y+sy;
end;
end;
end;
Procedure Bar;
Var
Row,Column:Integer;
begin
for Row:=y1 to y2 do
for Column:=x1 to x2 do
Mem[Base:(Row shl 8)+(Row shl 6)+Column]:=Color;
end;
Function InitVirtualPage;
Var
Temp:Longint;
begin
VirtualPage:=NIL;
Base2:=0;
Page2:=NIL;
InitVirtualPage:=false;
GetMem(VirtualPage,PageSize+15);
Temp:=(Longint(Seg(VirtualPage^)) shl 4)+Longint(Ofs(VirtualPage^));
if Temp and $F<>0 then Temp:=(Temp shr 4)+1 else Temp:=Temp shr 4;
Base2:=Temp;
Page2:=Ptr(Base2,0);
ClearBase(Base2);
InitVirtualPage:=true;
end;
Procedure DoneVirtualPage;
begin
FreeMem(VirtualPage,PageSize+15);
VirtualPage:=NIL;
Base2:=0;
Page2:=NIL;
end;
{==================================================================}
BEGIN
VideoSegment:=SegA000;
Base1:=VideoSegment;
Page1:=Ptr(Base1,0);
InitVirtualPage;
END.




Достарыңызбен бөлісу:
1   2   3   4   5   6   7




©engime.org 2024
әкімшілігінің қараңыз

    Басты бет