home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 2 / crawlyvol2.bin / program / pascal / pdial / showdial / resource.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-08  |  10.0 KB  |  270 lines
  1. { ------------------------------------------------------------ }
  2. { UNIT  RESOURCES                                              }
  3. { (c) 1992 Pure Software GmbH                                  }
  4. {                                                              }
  5. { this unit enables the usage of linked-in GEM resource files. }
  6. { therefore the .RSC-file must be converted into an object     }
  7. { file using BINOBJ.                                           }
  8. {                                                              }
  9. {                                                              }
  10. { 1. Execute BINOBJ to create an object file, i.e.             }
  11. {      BINOBJ myrsc.rcs myrsc MyResource                       }
  12. {                                                              }
  13. { 2. Include the object file into the primary file using the   }
  14. {    $L-directive.                                             }
  15. {                                                              }
  16. { 3. Declare the entry point for the resource file which must  }
  17. {    be the same identifier used at 1., i.e.                   }
  18. {      procedure  MyResource; external; (*$L myrsc *)          }
  19. {                                                              }
  20. { 4. Initialize the linked-in resource file:                   }
  21. {      resourcePool := InitResourcePool( @MyResource );        }
  22. {                                                              }
  23. { 5. now the variable resourcePool can be used to inquire the  }
  24. {    start address of an AESTree:                              }
  25. {      menuTree := GetResource( resourcePool, MYMENU );        }
  26. {      menu_bar( menuTree, 1 );                                }
  27. {                                                              }
  28. { 6. before program termination you must call FreeResourcePool }
  29. {      FreeResourcePool( resourcePool );                       }
  30. { ------------------------------------------------------------ }
  31.  
  32. unit Resources;
  33.  
  34. interface
  35.  
  36. uses Gem;
  37.  
  38. type
  39.     TResource = AESTreePtr;
  40.     TResourcePoolPtr = ^TResourcePool;
  41.     TResourcePool = Pointer;
  42.  
  43.  
  44. function    InitResourcePool( unfixedResource : Pointer ) : TResourcePoolPtr;
  45. procedure    FreeResourcePool( pool : TResourcePoolPtr );
  46. function    GetResource( pool : TResourcePoolPtr; poolIndex : Word ) : TResource;
  47.  
  48.  
  49. { ============================================================ }
  50.  
  51. implementation
  52.  
  53. {$X+}
  54.  
  55. { ------------------------------------------------------------ }
  56. { these are the maximum numbers of the named data structures   }
  57. { a resource file can contain.                                 }
  58. { ------------------------------------------------------------ }
  59.  
  60. const
  61.     MaxAESObjects = 2730;
  62.     MaxTedinfos = 2340;
  63.     MaxIconBlocks = 1820;
  64.     MaxBitBlocks = 4681;
  65.  
  66. { ------------------------------------------------------------ }
  67. { this variant record allows convenient accessing the resource }
  68. { file bytewise and also the resource header.                  }
  69. { ------------------------------------------------------------ }
  70.  
  71. type
  72.     ResourceFileTypePtr = ^ResourceFileType;
  73.     ResourceFileType = record
  74.         case Integer of
  75.             1:        ( resourceHeader :    RSHDR );
  76.             2:        ( resourceData :    Array[0..65535] of Byte );
  77.     end;
  78.  
  79. { ------------------------------------------------------------ }
  80. { some data structures to deal with the different components   }
  81. { of a resource file.                                          }
  82. { ------------------------------------------------------------ }
  83.  
  84.     TedinfoArrayPtr = ^TedinfoArray;
  85.     TedinfoArray = Array[0..MaxTedinfos] of TEDINFO;
  86.     IconBlockArrayPtr = ^IconBlockArray;
  87.     IconBlockArray = Array[0..MaxIconBlocks] of ICONBLK;
  88.     BitBlockArrayPtr = ^BitBlockArray;
  89.     BitBlockArray = Array[0..MaxBitBlocks] of BITBLK;
  90.     AESTreePtrArrayPtr = ^AESTreePtrArray;
  91.     AESTreePtrArray = Array[0..MaxAESObjects] of AESTreePtr;
  92.  
  93. { ------------------------------------------------------------ }
  94. { FIXRSC means that the relative addresses of the components   }
  95. { of the resource file should be fixed to absolute addresses.  }
  96. { UNFIXRSC is the counteroperation.                            }
  97. { ------------------------------------------------------------ }
  98.  
  99.     FixMode = ( FIXRSC, UNFIXRSC );
  100.  
  101.  
  102. { ------------------------------------------------------------ }
  103. { the gem function rsrc_obfix transforms relative coordinates  }
  104. { to absolute ones. this procedure works the the other way     }
  105. { round.                                                       }
  106. { the low byte of a relative coordinate contains a character-  }
  107. { distance and the high byte a remaining pixel distance.       }
  108. { ------------------------------------------------------------ }
  109.  
  110. procedure    AbsToRelCoords( var coord : Integer; defCharSize : Integer );
  111. var
  112.     px, ch : Integer;
  113. begin
  114.     ch := coord div defCharSize;
  115.     px := coord mod defCharSize;
  116.     coord := ( px shl 8 ) + ch;
  117. end;
  118.  
  119.  
  120. { ------------------------------------------------------------ }
  121. { since there seem to be some problems using rsrc_obfix we     }
  122. { will do it ourselves.                                        }
  123. { ------------------------------------------------------------ }
  124.  
  125. procedure    RelToAbsCoords( var coord : Integer; defCharSize : Integer );
  126. var
  127.     px, ch : Integer;
  128. begin
  129.     ch := ( coord and $00ff ) * defCharSize;
  130.     px := coord shr 8;
  131.     coord := ch + px;
  132. end;
  133.  
  134.  
  135. { ------------------------------------------------------------ }
  136. { the procedure FixResourcePool handles, depending on the      }
  137. { parameter mode, the fixing respectively the un-fixing of the }
  138. { relative addresses of a resource file by adding or           }
  139. { substracting the start address of the resource file.         }
  140. { ------------------------------------------------------------ }
  141.  
  142. procedure    FixResourcePool( unfixedResource : Pointer; mode : FixMode );
  143. var
  144.     resourceFile : ResourceFileTypePtr;
  145.     resourceHeader : RSHDRPtr;
  146.     tree : AESTreePtr;
  147.     treePool : AESTreePtrArrayPtr;
  148.     tedinfo : TedinfoArrayPtr;
  149.     iconblk : IconBlockArrayPtr;
  150.     bitblk : BitBlockArrayPtr;
  151.     obj, objCnt : Integer;
  152.     defWidth, defHeight, dummy : Integer;
  153.     offset : LongInt;
  154.     objType : Byte;
  155.  
  156. begin
  157.     offset := LongInt( unfixedResource );
  158.     if mode = UNFIXRSC then
  159.         offset := -offset;
  160.     resourceFile := unfixedResource;
  161.     resourceHeader := @resourceFile^.resourceHeader;
  162.     graf_handle( defWidth, defHeight, dummy, dummy );
  163.  
  164.     tree := @resourceFile^.resourceData[resourceHeader^.rsh_object];
  165.     for obj := 0 to resourceHeader^.rsh_nobs - 1 do
  166.     begin
  167.         if mode = FIXRSC then
  168.         begin
  169.             RelToAbsCoords( tree^[obj].ob_x, defWidth );
  170.             RelToAbsCoords( tree^[obj].ob_y, defHeight );
  171.             RelToAbsCoords( tree^[obj].ob_width, defWidth );
  172.             RelToAbsCoords( tree^[obj].ob_height, defHeight );
  173.         end
  174.         else
  175.         begin
  176.             AbsToRelCoords( tree^[obj].ob_x, defWidth );
  177.             AbsToRelCoords( tree^[obj].ob_y, defHeight );
  178.             AbsToRelCoords( tree^[obj].ob_width, defWidth );
  179.             AbsToRelCoords( tree^[obj].ob_height, defHeight );
  180.         end;
  181.  
  182.         objType := lo(tree^[obj].ob_type);
  183.         if ( objType = G_TEXT ) or ( objType = G_BOXTEXT )
  184.                 or ( objType = G_FTEXT ) or ( objType = G_FBOXTEXT )
  185.                 or ( objType = G_BUTTON ) or ( objType = G_STRING )
  186.                 or ( objType = G_TITLE ) or ( objType = G_ICON )
  187.                 or ( objType = G_IMAGE ) then
  188.         begin
  189.             Inc( tree^[obj].ob_spec.index, offset );
  190.         end;
  191.     end;
  192.  
  193.     tedinfo := @resourceFile^.resourceData[resourceHeader^.rsh_tedinfo];
  194.     for obj := 0 to Integer( resourceHeader^.rsh_nted ) - 1 do
  195.     begin
  196.         Inc( LongInt( tedinfo^[obj].te_ptext ), offset );
  197.         Inc( LongInt( tedinfo^[obj].te_ptmplt ), offset );
  198.         Inc( LongInt( tedinfo^[obj].te_pvalid ), offset );
  199.     end;
  200.  
  201.     iconblk := @resourceFile^.resourceData[resourceHeader^.rsh_iconblk];
  202.     for obj := 0 to Integer( resourceHeader^.rsh_nib ) - 1 do
  203.     begin
  204.         Inc( LongInt( iconblk^[obj].ib_pmask ), offset );
  205.         Inc( LongInt( iconblk^[obj].ib_pdata ), offset );
  206.         Inc( LongInt( iconblk^[obj].ib_ptext ), offset );
  207.     end;
  208.  
  209.     bitblk := @resourceFile^.resourceData[resourceHeader^.rsh_bitblk];
  210.     for obj := 0 to Integer( resourceHeader^.rsh_nbb ) - 1 do
  211.         Inc( LongInt( bitblk^[obj].bi_pdata ), offset );
  212.  
  213.     treePool := @resourceFile^.resourceData[resourceHeader^.rsh_trindex];
  214.     for obj := 0 to Integer( resourceHeader^.rsh_ntree ) - 1 do
  215.         Inc( LongInt( treePool^[obj] ), offset );
  216. end;
  217.  
  218.  
  219. { ------------------------------------------------------------ }
  220. { this procedure start the un-fixing process.                  }
  221. { ------------------------------------------------------------ }
  222.  
  223. procedure    FreeResourcePool( pool : TResourcePoolPtr );
  224. begin
  225.     FixResourcePool( pool, UNFIXRSC );
  226. end;
  227.  
  228.  
  229. { ------------------------------------------------------------ }
  230. { this procedure initializes the resource file and the GEM!    }
  231. { ------------------------------------------------------------ }
  232.  
  233. function    InitResourcePool( unfixedResource : Pointer ) : TResourcePoolPtr;
  234. var
  235.     resourceFile : ResourceFileTypePtr;
  236.     resourceHeader : RSHDRPtr;
  237.     treePool : AESTreePtrArrayPtr;
  238. begin
  239.     FixResourcePool( unfixedResource, FIXRSC );
  240.     resourceFile := unfixedResource;
  241.     resourceHeader := @resourceFile^.resourceHeader;
  242.     treePool := @resourceFile^.resourceData[resourceHeader^.rsh_trindex];
  243.     Gem_pb.global[5] := Integer( LongInt( treePool ) shr 16 );
  244.     Gem_pb.global[6] := Integer( treePool );
  245.     InitResourcePool := unfixedResource;
  246. end;
  247.  
  248.  
  249. { ------------------------------------------------------------ }
  250. { this function returns the address of a specific AESTree of   }
  251. { the resource file.                                           }
  252. { ------------------------------------------------------------ }
  253.  
  254. function    GetResource( pool : TResourcePoolPtr; poolIndex : Word ) : TResource;
  255. var
  256.     resourceFile : ResourceFileTypePtr;
  257.     resourceHeader : RSHDRPtr;
  258.     treePool : AESTreePtrArrayPtr;
  259. begin
  260.     resourceFile := ResourceFileTypePtr( pool );
  261.     resourceHeader := @resourceFile^.resourceHeader;
  262.     treePool := @resourceFile^.resourceData[resourceHeader^.rsh_trindex];
  263.     GetResource := treePool^[poolIndex];
  264. end;
  265.  
  266.  
  267. end.
  268.  
  269. { ============================================================ }
  270.