home *** CD-ROM | disk | FTP | other *** search
/ Mega Top 1 / os2_top1.zip / os2_top1 / APPS / PROG / PASCAL / SPEED2 / SRC / RCOMP / RCICON.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-09-29  |  3.7 KB  |  168 lines
  1. UNIT RcIcon;
  2.  
  3. INTERFACE
  4.  
  5. USES RcTypes;
  6.  
  7. VAR
  8.    TempIcon:PIcon;
  9.  
  10. CONST
  11.      IconCount:Word=0;
  12.      BitmapCount:WORD=0;
  13.  
  14. PROCEDURE ParseIcon;
  15. PROCEDURE Parsebitmap;
  16. PROCEDURE Write_res_Icons(i:PIcon);
  17. PROCEDURE Write_Icons;
  18. PROCEDURE Write_Bitmaps;
  19.  
  20. IMPLEMENTATION
  21.  
  22. PROCEDURE NewIcon(VAR i,i1:PIcon;num:Word);
  23. Var spos:Byte;
  24.     f:file;
  25.     l:longint;
  26. BEGIN
  27.      IF i=NIL THEN
  28.      BEGIN
  29.           New(i);
  30.           i1:=i;
  31.      END
  32.      ELSE
  33.      BEGIN
  34.           i1:=i;
  35.           while i1^.next<>NIL do i1:=i1^.next;
  36.           new(i1^.next);
  37.           i1:=i1^.next;
  38.      END;
  39.      i1^.IconName:=params;
  40.      i1^.ident:=Num;
  41.      assign(f,i1^.IconName);
  42.      reset(f,1);
  43.      if ioresult<>0 then error('Icon/Bitmap not found:'+i1^.Iconname);
  44.      l:=filesize(f);
  45.      i1^.SubSize:=l;  {Independent color form format 1.2 recommended}
  46.      close(f);
  47.      if ioresult<>0 then error('File read error:'+i1^.Iconname);
  48.      i1^.Next:=NIL;
  49. END;
  50.  
  51. PROCEDURE ParseIcon;
  52. VAR i:PICON;
  53.     n:word;
  54.     s:string;
  55.     c:Integer;
  56.     i1:LONGINT;
  57. BEGIN
  58.      INC(IconCount);
  59.      SplitLine(params,s,' ');
  60.      val(s,n,c);
  61.      if c<>0 then
  62.      BEGIN
  63.           IF not SearchConstant(s,i1) THEN
  64.             error('Illegal numeric format');
  65.           n:=i1;
  66.      END;
  67.      NewIcon(Icons,i,n);
  68. END;
  69.  
  70. PROCEDURE Parsebitmap;
  71. VAR i:PICON;
  72.     n:word;
  73.     s:string;
  74.     c:Integer;
  75.     i1:LONGINT;
  76. BEGIN
  77.      INC(BitmapCount);
  78.      SplitLine(params,s,' ');
  79.      val(s,n,c);
  80.      if c<>0 then
  81.      BEGIN
  82.           IF not SearchConstant(s,i1) THEN
  83.             error('Illegal numeric format');
  84.           n:=i1;
  85.      END;
  86.      NewIcon(Bitmaps,i,n);
  87. END;
  88.  
  89. PROCEDURE Write_Icons;
  90. VAR w:Word;
  91.     i:PIcon;
  92. BEGIN
  93.      IconOffset:=BitMapOffset;
  94.  
  95.      {Nun die Bezeichner der Icons}
  96.      i:=Icons;
  97.      while i<>NIL do
  98.      begin
  99.           WriteWord(1);          {Typ:Icon or mouseshape}
  100.           writeword(i^.ident);   {Bezeichner des Menus}
  101.           writeword(i^.subsize MOD 65536); {Länge der Einträge für dieses Menu}
  102.           writeword(i^.subsize DIV 65536);
  103.           writeWord(3);  {Object number}
  104.           writeWord(IconOffset MOD 65536);
  105.           writeWord(IconOffset DIV 65536);
  106.           inc(IconOffset,i^.SubSize);
  107.           i:=i^.next;
  108.      end;
  109. END;
  110.  
  111. PROCEDURE Write_Bitmaps;
  112. VAR w:Word;
  113.     i:PIcon;
  114. BEGIN
  115.      BitmapOffset:=0;
  116.  
  117.      {Nun die Bezeichner der Bitmaps}
  118.      i:=Bitmaps;
  119.      while i<>NIL do
  120.      begin
  121.           WriteWord(2);          {Typ:Bitmap}
  122.           writeword(i^.ident);   {Bezeichner der Bitmap}
  123.           writeword(i^.subsize MOD 65536); {Länge der Einträge für diese Bitmap}
  124.           writeword(i^.subsize DIV 65536);
  125.           writeWord(3);  {Object number}
  126.           writeWord(BitmapOffset MOD 65536);
  127.           writeWord(BitmapOffset DIV 65536);
  128.           inc(BitmapOffset,i^.SubSize);
  129.           i:=i^.next;
  130.      end;
  131. END;
  132.  
  133. PROCEDURE Write_res_Icons(i:PIcon);
  134. var
  135.     w:word;
  136.     t:word;
  137.     f:file;
  138.     p:^Byte;
  139. BEGIN
  140.      if i=NIL then exit;
  141.      while i<>NIL do
  142.      begin
  143.           assign(f,i^.IconName);
  144.           reset(f,1);
  145.           if ioresult<>0 then error('File not found:'+i^.IconName);
  146.  
  147.           Getmem(p,i^.SubSize);
  148.           blockread(f,p^,i^.SubSize);
  149.           if ioresult<>0 then
  150.           begin
  151.                close(f);
  152.                error('Disk read error');
  153.           end;
  154.           blockwrite(zielf,p^,i^.Subsize);
  155.           if ioresult<>0 then
  156.           begin
  157.                close(f);
  158.                error('File write error');
  159.           end;
  160.           {WriteWord(0);}
  161.           close(f);
  162.           if ioresult<>0 then error('Disk read error');
  163.           i:=i^.next;
  164.      END;
  165. END;
  166.  
  167. BEGIN
  168. END.