home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Windows Spiele / SOS-WIN_SPIELE.ISO / support / progs / iconman.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-01  |  3.8 KB  |  140 lines
  1. UNIT ICONMAN;
  2.  
  3.  
  4. INTERFACE
  5.  
  6. USES DOS,Graph;
  7.  
  8. VAR
  9.   FLoadResult   : INTEGER;
  10.   ICreateResult : INTEGER;
  11.  
  12. PROCEDURE OpenIconSystem;
  13. PROCEDURE CloseIconSystem;
  14. PROCEDURE LoadIconFile(Filename : STRING);
  15. PROCEDURE SaveIconFile(Filename : STRING);
  16. PROCEDURE DisplayIcon(Ino : INTEGER; Ix,Iy : INTEGER);
  17. PROCEDURE GetNumberOfIcons(VAR NoIco : INTEGER);
  18. PROCEDURE CreateIcon(Ino : INTEGER; Ix,Iy : INTEGER);
  19. PROCEDURE ReplaceIcon(Ino : INTEGER; Ix,Iy : INTEGER);
  20. PROCEDURE SetIconCount(MaxIco : INTEGER);
  21.  
  22.  
  23. IMPLEMENTATION
  24.  
  25. CONST
  26.   Icon_Size : WORD    = 518;  { Number of bytes per 32x32 bit icon. }
  27.   Max_Icons : INTEGER = 32;   { Maximum number of icons per file.   }
  28.  
  29. TYPE
  30.   Icon_Record = RECORD        { Makes up Icon_Stack array. }
  31.   Icon_Pointer : POINTER;
  32.   END;
  33.  
  34. VAR
  35.   Loop         : INTEGER;
  36.   Number_Icons : BYTE;        { Number of icons in current file. }
  37.   F1           : FILE;
  38.   Current_File : STRING;      { Name of current file. }
  39.   result       : WORD;
  40.   HeapTop      : ^WORD;       { Marks bottom of reserved }
  41.                               { space for Icon_Stack.    }
  42.  
  43.   Icon_Stack   : ARRAY[1..32] OF Icon_Record; { Holds 32 icons }
  44.  
  45. PROCEDURE OpenIconSystem;
  46. BEGIN
  47.   FOR loop:=1 TO Max_Icons DO
  48.     GetMem(Icon_Stack[Loop].Icon_Pointer, Icon_Size);  { Reserve memory for }
  49.                                                        { all 32 icons       }
  50. END;
  51.  
  52. PROCEDURE CloseIconSystem;
  53. BEGIN
  54.  FOR loop:=1 TO Max_Icons DO
  55.   BEGIN
  56.     FreeMem(Icon_Stack[Loop].Icon_Pointer,Icon_Size);  { Restore memory taken }
  57.   END;                                                 { by all 32 icons      }
  58. END;
  59.  
  60. PROCEDURE LoadIconFile(FileName : STRING);
  61. BEGIN
  62.   Assign(f1,FileName);
  63.   FileMode:=0;
  64.   {$I-}
  65.   Reset(f1,1);                   { Reposition file pointer & record len = 1 }
  66.   FloadResult:=IOResult;
  67.   IF FLoadResult=0 THEN
  68.   BEGIN
  69.     Current_File:=FileName;
  70.     BlockRead(f1,Number_Icons,1,result);     { Read number of icons in file }
  71.     FOR Loop:=1 TO Max_Icons DO
  72.     BEGIN
  73.       BlockRead(f1,Icon_Stack[Loop].Icon_Pointer^,Icon_Size,result);    { Read Icon }
  74.     END;
  75.     Close(f1);
  76.   END
  77.   ELSE
  78.     Number_Icons:=0;
  79. END;
  80.  
  81. PROCEDURE SaveIconFile(FileName : STRING);
  82. BEGIN
  83.   Assign(f1,FileName);
  84.   Rewrite(f1,1);                                  { Clear file & set record size to 1 }
  85.   BlockWrite(f1,Number_Icons,1,result);           { Write Icon number }
  86.   FOR loop:=1 TO Max_Icons Do
  87.   BEGIN
  88.     BlockWrite(f1,Icon_Stack[Loop].Icon_Pointer^,Icon_Size,result);  { Save Icon }
  89.   END;
  90.   Close(f1);
  91. END;
  92.  
  93. PROCEDURE DisplayIcon(Ino : INTEGER; Ix,Iy : INTEGER);
  94. BEGIN
  95.   IF (Ino<=Number_Icons) AND (Ino>=1) THEN
  96.   PutImage(Ix,Iy,Icon_Stack[Ino].Icon_Pointer^, CopyPut);
  97. END;
  98.  
  99. PROCEDURE GetNumberOfIcons(VAR NoIco : INTEGER);
  100. BEGIN
  101.   NoIco:=Number_Icons;
  102. END;
  103.  
  104. PROCEDURE CreateIcon(Ino : INTEGER; Ix,Iy : INTEGER);
  105. BEGIN
  106.   ICreateResult:=0; { Ok }
  107.   IF (Ino<=(Number_Icons+1)) AND (Ino<=Max_Icons) AND (Ix+31<=639)
  108.   AND (Iy+31<=479) THEN
  109.   BEGIN
  110.     Getimage(Ix,Iy,Ix+31,Iy+31,Icon_Stack[Ino].Icon_Pointer^);
  111.     IF (Number_Icons<Max_Icons) THEN INC(Number_Icons);
  112.   END
  113.   ELSE
  114.   BEGIN
  115.     IF (Ino>=(Number_Icons+1)) OR (Ino>Max_Icons) THEN ICreateResult:=1;  { Invalid Icon }
  116.     IF (Ix+31>639) OR (Iy+31>479) THEN ICreateResult:=2;     { Part of the icon would be }
  117.   END;                                                       { grabbed from off screen   }
  118. END;
  119.  
  120. PROCEDURE ReplaceIcon(Ino : INTEGER; Ix,Iy : INTEGER);
  121. BEGIN
  122.   IF (Ino<=(Number_Icons)) AND (Ix+31<=639)
  123.   AND (Iy+31<=479) THEN
  124.   BEGIN
  125.     Getimage(Ix,Iy,Ix+31,Iy+31,Icon_Stack[Ino].Icon_Pointer^);
  126.   END
  127. END;
  128.  
  129. PROCEDURE SetIconCount(MaxIco : INTEGER);
  130. BEGIN
  131.    IF (MaxIco>=0) AND (MaxIco<=32) THEN
  132.    BEGIN
  133.      Number_Icons:=MaxIco;
  134.    END;
  135. END;
  136.  
  137.  
  138. BEGIN
  139. END.
  140.