home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
PINBSRC.ZIP
/
PLANES
/
GRABBLER.BAK
< prev
next >
Wrap
Text File
|
1996-02-02
|
3KB
|
125 lines
{ Needs BGI256.BGI! }
program SPRITE_GRABBLER;
uses graph,dos,crt,printer;
TYPE ByteArray = array[0..64000] of byte;
var name:string[80];
datei:file;
datei1,datei2,datei3,datei4:file of byte;
zeiger:word;
platz1:pointer;
kill:byte;
groesse:word;
platz:^Bytearray;
treiber, modus:integer;
Palette: file of byte;
Color: Word;
x,y,x1,y1:integer;
z,z1:word;
pixel:string;
pixe:word;
code:integer;
lag:file;
ok:boolean;
ch:char;
red,green,blue:byte;
result:integer;
begin
write('Dateiname:');
readln(name);
kill:=0;
result := installuserdriver( 'BGI256', nil);
modus:=0;
initgraph(result,modus,'');
assign(datei,name+'.VGA');
reset(datei,1);
groesse:=imagesize(0,0,319,199);
getmem(platz1,groesse);
blockread(datei,platz1^,groesse);
close(datei);
putimage(0,0,platz1^,0);
x1:=160;
y1:=136;
x:=160+56;
y:=136+47; {}
{ x1:=80;
y1:=136;
x:=80+56;
y:=136+47;{}
ok:=false;
setwritemode(xorput);
rectangle(x1,y1,x,y);
repeat
repeat
until KeyPressed;
setwritemode(xorput);
rectangle(x1,y1,x,y);
ch:=readkey;
if ch='8' then y:=y-4;
if ch='2' then y:=y+4;
if ch='4' then x:=x-8;
if ch='6' then x:=x+8;
if ch='5' then ok:=true;
if ch='s' then y1:=y1-4;
if ch='x' then y1:=y1+4;
if ch='y' then x1:=x1-8;
if ch='c' then x1:=x1+8;
if x<0 then x:=0;
if y<0 then y:=0;
if x>319 then x:=319;
if y>199 then y:=199;
{ x1:=x-32;
y1:=y-74;}
rectangle(x1,y1,x,y);
until ok;
rectangle(x1,y1,x,y);
{ assign(lag,'larry11.SPR');
rewrite(lag,1);}
{ groesse:=imagesize(x1,y1,x,y);
getmem(platz,groesse);
getimage(x1,y1,x,y,platz^);
putimage(x1,y1,platz^,copyput);}
write(lst,name,' ',(x-x1));
write(lst,' ',(y-y1+1));
writeln(lst,' X:',x1,'-',x,' Y:',y1,'-',y);
assign(datei1,name+'_r.1');
assign(datei2,name+'_r.2');
assign(datei3,name+'_r.3');
assign(datei4,name+'_r.4');
rewrite(datei1);
rewrite(datei2);
rewrite(datei3);
rewrite(datei4);
for z:=y1 to y do
begin
for z1:=x1+1 to x do
begin
write(datei1,mem[$a000:z*320+z1]);
write(datei2,mem[$a000:z*320+z1+1]);
write(datei3,mem[$a000:z*320+z1+2]);
write(datei4,mem[$a000:z*320+z1+3]);
mem[$a000:z*320+z1]:=255;
mem[$a000:z*320+z1+1]:=255;
mem[$a000:z*320+z1+2]:=255;
mem[$a000:z*320+z1+3]:=255;
inc(z1,3);
end;
end;
close(datei1);
close(datei2);
close(datei3);
close(datei4);
closegraph;
{ blockwrite(lag,platz^,groesse);}
{close(lag);}
end.