home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / PINBSRC.ZIP / PLANES / GRABNEW.PAS < prev    next >
Pascal/Delphi Source File  |  1995-06-10  |  3KB  |  105 lines
  1. program SPRITE_GRABBLER_NEW_VERSION;
  2. uses dos,crt,printer;
  3. {$I _NORMVGA.PAS}
  4. var name:string[80];
  5.     datei1:file of byte;
  6.     x,y,x1,y1:integer;
  7.     z,z1,z2:word;
  8.     ok:boolean;
  9.     ch:char;
  10.     savemode:byte;
  11.  
  12. procedure rectangle(rx1,ry1,rx2,ry2:word);
  13. var ri:word;
  14. begin
  15.   for ri:=rx1 to rx2 do put_pixel(ri,ry1,get_pixel(ri,ry1) xor 20);
  16.   for ri:=rx1 to rx2 do put_pixel(ri,ry2,get_pixel(ri,ry2) xor 20);
  17.   for ri:=ry1 to ry2 do put_pixel(rx1,ri,get_pixel(rx1,ri) xor 20);
  18.   for ri:=ry1 to ry2 do put_pixel(rx2,ri,get_pixel(rx2,ri) xor 20);
  19. end;
  20.  
  21.  
  22. begin
  23.    write('Dateiname:');
  24.    readln(name);
  25.    write('Save in Mode-X format [Y]');
  26.    ch:=readkey;
  27.    if (ch=chr(13)) or (upcase(ch)='Y') then savemode:=1 else savemode:=0;
  28.    video_mode($13);
  29.    load_vga(name);
  30.    x:=160;
  31.    y:=136;
  32.    x1:=160+56;
  33.    y1:=136+47; {}
  34.  
  35. {     x:=80;
  36.      y:=136;
  37.      x1:=80+56;
  38.      y1:=136+47;{}
  39.  
  40.   ok:=false;
  41.   rectangle(x,y,x1,y1);
  42.   repeat
  43.     repeat
  44.     until KeyPressed;
  45.     rectangle(x,y,x1,y1);
  46.     ch:=readkey;
  47.     if ch='8' then y1:=y1-4;
  48.     if ch='2' then y1:=y1+4;
  49.     if ch='4' then x1:=x1-8;
  50.     if ch='6' then x1:=x1+8;
  51.     if ch='5' then ok:=true;
  52.     if ch='s' then y:=y-4;
  53.     if ch='x' then y:=y+4;
  54.     if ch='y' then x:=x-8;
  55.     if ch='c' then x:=x+8;
  56.  
  57.     if x1<0 then x1:=0;
  58.     if y1<0 then y1:=0;
  59.     if x1>319 then x1:=319;
  60.     if y1>199 then y1:=199;
  61.  
  62.     rectangle(x,y,x1,y1);
  63.   until ok;
  64.     rectangle(x,y,x1,y1);
  65.  
  66.   write(lst,name,' ');
  67.   if savemode=1 then writeln(lst,'MODE-X') else writeln(lst,'NORMAL');
  68.   writeln(lst,'VON: ',x,' ',y,' BIS: ',x1,' ',y1);
  69.   writeln(lst,'XAusdehnung: ',x1-x);
  70.   writeln(lst,'YAusdehnung: ',y1-y+1);
  71.  
  72.   if savemode=1 then begin
  73.     assign(datei1,name+'.gfx');
  74.     rewrite(datei1);
  75.     for z2:=0 to 3 do begin
  76.       for z:=y to y1 do begin
  77.         for z1:=x+1 to x1 do begin
  78.           write(datei1,mem[$a000:z*320+z1+z2]);
  79.           inc(z1,3);
  80.         end;
  81.       end;
  82.     end;
  83.     close(datei1);
  84.   end;
  85.  
  86.   if savemode=0 then begin
  87.     assign(datei1,name+'.gfx');
  88.     rewrite(datei1);
  89.     for z:=y to y1 do begin
  90.       for z1:=x+1 to x1 do begin
  91.         write(datei1,mem[$a000:z*320+z1]);
  92.       end;
  93.     end;
  94.     close(datei1);
  95.   end;
  96.   video_mode(3);
  97.   write(name,' ');
  98.   if savemode=1 then writeln('MODE-X') else writeln('NORMAL');
  99.   writeln('VON: ',x,' ',y,' BIS: ',x1,' ',y1);
  100.   writeln('XAusdehnung: ',x1-x);
  101.   writeln('YAusdehnung: ',y1-y+1);
  102.   repeat until keypressed;
  103.   ch:=readkey;
  104. end.
  105.