home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / pascal / sprite21 / scales.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-08  |  2.4 KB  |  91 lines
  1. program ScaleSprite;
  2. uses graph,crt,library,bgidriv;
  3. const spritesize = 30;
  4. TYPE SpriteInfo = RECORD
  5.        name : STRING[40];
  6.        loc : ARRAY[0..SpriteSize-1,0..SpriteSize-1] OF SHORTINT;
  7.      END;
  8.  
  9. var sprite : spriteinfo;
  10.     n,gd,gm,er : integer;
  11.     spritefile : file of spriteinfo;
  12.  
  13. procedure LoadSprite(fn,spr : string; x,y : word);
  14. VAR count,h,k,x1,y1,x2,y2 : WORD;
  15. BEGIN
  16.   spr := uppercase(spr);
  17.   if pos('.',fn) = 0 then fn := fn + '.SCF';
  18.   ASSIGN(SpriteFile,fn);
  19.   {$I-} RESET(SpriteFile); {$I+}
  20.   IF IORESULT <> 0 THEN
  21.     fatalerror('Sprite file not found - '+UpperCase(fn));
  22.   count := 0;
  23.   RESET(SpriteFile);
  24.   WHILE NOT EOF(SpriteFile) DO
  25.   BEGIN
  26.     READ(SpriteFile,Sprite);
  27.     INC(count);
  28.   END;
  29.   IF count > 1 THEN
  30.   BEGIN
  31.     RESET(SpriteFile);
  32.     WHILE (spr<>Sprite.name) AND (NOT EOF(SpriteFile)) DO
  33.       READ(SpriteFile,Sprite);
  34.     IF spr <> Sprite.name THEN
  35.       fatalerror('Sprite not found - '+UpperCase(fn)+' | '+UpperCase(spr));
  36.     {$I-} CLOSE(SpriteFile); {$I+}
  37.   END ELSE
  38.   BEGIN
  39.     RESET(SpriteFile);
  40.     READ(SpriteFile,Sprite);
  41.     CLOSE(SpriteFile);
  42.   END;
  43.   FOR h := 0 TO 29 DO
  44.     FOR k := 0 TO 29 DO
  45.     BEGIN
  46.       IF sprite.loc[h,k] = -1 THEN sprite.loc[h,k] := 0;
  47.       PUTPIXEL(x+h,y+k,sprite.loc[h,k]);
  48.     END;
  49. END;  { LoadSprite }
  50.  
  51. procedure scale_sprite(spr : spriteinfo; fillstyle : word; x,y : word;
  52.             scale : shortint);
  53. var h,k,l,m : shortint;
  54. begin
  55.   for h := 0 to 29 do
  56.     for k := 0 to 29 do
  57.     begin
  58.       setfillstyle(fillstyle,sprite.loc[h,k]);
  59.       bar(x+h*scale,y+k*scale,x+h*scale+scale,y+k*scale+scale);
  60.     end;
  61. end;
  62.  
  63. procedure erase_scale(spr : spriteinfo; x,y : word; scale : shortint);
  64. var h,k,l,m : shortint;
  65. begin
  66.   for h := 0 to 29 do
  67.     for k := 0 to 29 do
  68.     if sprite.loc[h,k] <> 0 then
  69.     begin
  70.       setfillstyle(solidfill,0);
  71.       bar(x+h*scale,y+k*scale,x+h*scale+scale,y+k*scale+scale);
  72.     end;
  73. end;
  74.  
  75. var x : shortint;
  76. begin
  77.   if registerbgidriver(@egavgadriverproc) < 0 then
  78.     fatal('Graphics driver not found');
  79.   detectgraph(gd,gm);
  80.   if gd <> vga then fatal('VGA required');
  81.   gd := vga; gm := vgahi;
  82.   initgraph(gd,gm,'');
  83.   if graphresult <> 0 then fatal('Graphics driver failure!');
  84.   loadsprite('test','',10,10);
  85.   for n := 1 to 10 do
  86.     scale_sprite(sprite,solidfill,100,0,n+1);
  87.   readkey;
  88.   closegraph;
  89.   textmode(co80);
  90. end.
  91.