home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
XLIBPAS.ZIP
/
DEMO5.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-10-19
|
4KB
|
121 lines
{*************************************************************************
DEMO 5
Demonstrates Planar Bitmap Clipping Functions
C Version : Themie Gouthas - Pascal Version : Tristan Tarrant
**************************************************************************}
Program Demo5;
Uses
Crt, Xlib;
Const
turtle : array[0..601] of byte = (
20,30,
8,14, 0, 0, 0, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
8, 2,14, 0, 0, 0, 0, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
8, 2, 2, 0, 0, 0, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
8, 0, 2,14, 0, 0,14,14,14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
8, 0, 2, 5, 0, 4, 4, 4, 4,14,14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
8, 0, 2, 2, 4, 4, 0, 4, 4, 0, 4,14, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 2, 4, 4, 4, 0, 4, 4, 0, 4, 4,14, 0, 0, 0, 0, 0, 0, 0,
0, 0, 2, 4, 4, 4, 0, 0, 0, 0, 4, 4,14, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 4, 0, 4, 4, 4, 0, 0, 0, 4, 0, 0, 2, 2, 0, 0, 0,
0, 0, 0, 4, 0, 4, 4, 4, 0, 4, 4, 4, 0,14, 0, 0, 2, 2, 0, 0,
0, 0, 0, 4, 4, 0, 0, 0, 4, 4, 0, 4, 0, 4, 2, 2, 2, 2, 0, 0,
0, 0, 0, 4, 4, 4, 0, 4, 4, 0, 4, 4, 0, 4,14, 2, 2, 2, 0, 0,
0, 0, 0, 4, 4, 4, 0, 0, 0, 4, 4, 0, 4, 0, 0, 2, 2, 0, 0, 0,
0, 0, 0, 2, 4, 4, 4, 4, 4, 4, 4, 0, 4, 4,14, 2, 0, 0, 0, 0,
0, 0, 2, 2, 0, 4, 4, 4, 4, 0, 0, 4, 4, 4, 4, 0, 0, 0, 0, 0,
2, 2, 2, 2, 4, 0, 0, 4, 4, 0, 4, 4, 0, 4,14, 0, 0, 0, 0, 0,
0, 2, 2, 0, 4, 4, 4, 0, 0, 4, 4, 0, 4, 0, 2, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 4, 4, 0, 4, 4, 4, 0, 4, 4, 2,14, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 4, 4, 4, 4, 4, 0, 4, 0, 2, 2,14,14, 0, 0,
0, 0, 0, 0, 0, 0, 0, 4, 4, 0, 0, 4, 4, 2, 2, 2, 2, 2,14, 0,
0, 0, 0, 0, 0, 0, 0, 4, 4, 4, 4, 4, 2, 2, 2, 2, 2, 5,14, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 2, 2, 0, 0, 2, 2, 2, 0, 2,14,
0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 2, 0, 0, 0, 0, 2, 2, 2,14,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 2, 0, 0, 0, 0, 2, 2, 2,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 0, 0, 0, 0, 0, 2, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
);
Var
i,j : integer;
vbm : pointer;
procedure error( s : string );
begin
xtextmode;
writeln( s );
halt(0);
end;
Type
AlignmentHeader = record
size : word;
ImageWidth, ImageHeight : byte;
ImagePtr, MaskPtr : word;
end;
procedure main;
var
i,j,k,handle,size,compsize : integer;
bm : pointer;
tempbuff : AlignmentHeader;
begin
xsetmode(XMODE360x240,360);
xtextinit;
xsetfont(1);
xprintf(0,0,0,14,'This is a demo of PBM clipping.');
readkey;
getmem(bm,602);
xbmtopbm(turtle,bm^);
xsetcliprect(4,5,50,150);
xline(0,TopClip-1,320,TopClip-1,23,0);
xline(0,BottomClip+1,320,BottomClip+1,23,0);
xline(LeftClip shl 2-1,0,LeftClip shl 2-1,200,23,0);
xline(RightClip shl 2+4,0,RightClip shl 2+4,200,23,0);
for k:=0 to 7 do
for j:=1 to (ScrnPhysicalHeight-1) div 30 do
for i:=0 to (ScrnPhysicalPixelWidth-20) div 20 do
xputpbm(i*20+k+1,(j-1)*30,0,bm^);
xline(0,TopClip-1,320,TopClip-1,23,0);
xline(0,BottomClip+1,320,BottomClip+1,23,0);
xline(LeftClip shl 2-1,0,LeftClip shl 2-1,200,23,0);
xline(RightClip shl 2+4,0,RightClip shl 2+4,200,23,0);
xrectfill(LeftClip shl 2,TopClip,RightClip shl 2+3,BottomClip,0,0);
xprintf(0,BottomClip+4,0,14,' Now the clipping...');
readkey;
for k:=0 to 7 do
for j:=1 to (ScrnPhysicalHeight-1) div 30 do
for i:=0 to (ScrnPhysicalPixelWidth-20) div 20 do
xputpbmclipxy(i*20+k+1,(j-1)*30,0,bm^);
for k:=0 to 7 do
for j:=1 to (ScrnPhysicalHeight-1) div 30 do
for i:=0 to (ScrnPhysicalPixelWidth-20) div 20 do
xputpbmclipxy(i*20+7+1,(j-1)*30+k,0,bm^);
for k:=0 to 7 do
for j:=1 to (ScrnPhysicalHeight-1) div 30 do
for i:=0 to (ScrnPhysicalPixelWidth-20) div 20 do
xputpbmclipxy(i*20+k+1,(j-1)*30+7,0,bm^);
for k:=0 to 7 do
for j:=1 to (ScrnPhysicalHeight-1) div 30 do
for i:=0 to (ScrnPhysicalPixelWidth-20) div 20 do
xputpbmclipxy(i*20+1,(j-1)*30+k,0,bm^);
readkey;
xtextmode;
writeln(LeftClip,TopClip,RightClip,BottomClip);
end;
begin
main;
end.