mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 10:11:27 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			187 lines
		
	
	
		
			4.9 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			187 lines
		
	
	
		
			4.9 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|     $Id$
 | |
|     Copyright (c) 1998-2002 by Florian Klaempfl
 | |
| 
 | |
|     Handles the resource files handling
 | |
| 
 | |
|     This program is free software; you can redistribute it and/or modify
 | |
|     it under the terms of the GNU General Public License as published by
 | |
|     the Free Software Foundation; either version 2 of the License, or
 | |
|     (at your option) any later version.
 | |
| 
 | |
|     This program is distributed in the hope that it will be useful,
 | |
|     but WITHOUT ANY WARRANTY; without even the implied warranty of
 | |
|     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | |
|     GNU General Public License for more details.
 | |
| 
 | |
|     You should have received a copy of the GNU General Public License
 | |
|     along with this program; if not, write to the Free Software
 | |
|     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 | |
| 
 | |
|  ****************************************************************************
 | |
| }
 | |
| unit comprsrc;
 | |
| 
 | |
| {$i fpcdefs.inc}
 | |
| 
 | |
| interface
 | |
| 
 | |
| type
 | |
|    presourcefile=^tresourcefile;
 | |
|    tresourcefile=object
 | |
|    private
 | |
|       fname : string;
 | |
|    public
 | |
|       constructor Init(const fn:string);
 | |
|       destructor Done;
 | |
|       procedure  Compile;virtual;
 | |
|    end;
 | |
| 
 | |
| procedure CompileResourceFiles;
 | |
| 
 | |
| 
 | |
| implementation
 | |
| 
 | |
| uses
 | |
| {$ifdef Delphi}
 | |
|   dmisc,
 | |
| {$else Delphi}
 | |
|   dos,
 | |
| {$endif Delphi}
 | |
|   Systems,cutils,Globtype,Globals,Verbose,Fmodule,
 | |
|   Script;
 | |
| 
 | |
| {****************************************************************************
 | |
|                               TRESOURCEFILE
 | |
| ****************************************************************************}
 | |
| 
 | |
| constructor tresourcefile.init(const fn:string);
 | |
| begin
 | |
|   fname:=fn;
 | |
| end;
 | |
| 
 | |
| 
 | |
| destructor tresourcefile.done;
 | |
| begin
 | |
| end;
 | |
| 
 | |
| 
 | |
| procedure tresourcefile.compile;
 | |
| var
 | |
|   respath,
 | |
|   srcfilepath : dirstr;
 | |
|   n       : namestr;
 | |
|   e       : extstr;
 | |
|   s,
 | |
|   resobj,
 | |
|   resbin   : string;
 | |
|   resfound,
 | |
|   objused  : boolean;
 | |
| begin
 | |
|   resbin:='';
 | |
|   resfound:=false;
 | |
|   if utilsdirectory<>'' then
 | |
|    resfound:=FindFile(target_res.resbin+source_info.exeext,utilsdirectory,resbin);
 | |
|   if not resfound then
 | |
|    resfound:=FindExe(target_res.resbin,resbin);
 | |
|   { get also the path to be searched for the windres.h }
 | |
|   fsplit(resbin,respath,n,e);
 | |
|   if (not resfound) and not(cs_link_extern in aktglobalswitches) then
 | |
|    begin
 | |
|      Message(exec_e_res_not_found);
 | |
|      aktglobalswitches:=aktglobalswitches+[cs_link_extern];
 | |
|    end;
 | |
|   fsplit(current_module.mainsource^,srcfilepath,n,e);
 | |
|   if not path_absolute(fname) then
 | |
|     fname:=srcfilepath+fname;
 | |
|   resobj:=ForceExtension(fname,target_info.resobjext);
 | |
|   s:=target_res.rescmd;
 | |
|   ObjUsed:=(pos('$OBJ',s)>0);
 | |
|   Replace(s,'$OBJ',resobj);
 | |
|   Replace(s,'$RES',fname);
 | |
|   Replace(s,'$INC',respath);
 | |
|   if (target_info.system = system_i386_win32) and
 | |
|      (srcfilepath<>'') then
 | |
|     s:=s+' --include '+srcfilepath;
 | |
| { Exec the command }
 | |
|   if not (cs_link_extern in aktglobalswitches) then
 | |
|    begin
 | |
|      Message1(exec_i_compilingresource,fname);
 | |
|      swapvectors;
 | |
|      exec(resbin,s);
 | |
|      swapvectors;
 | |
|      if (doserror<>0) then
 | |
|       begin
 | |
|         Message(exec_e_cant_call_linker);
 | |
|         aktglobalswitches:=aktglobalswitches+[cs_link_extern];
 | |
|       end
 | |
|      else
 | |
|       if (dosexitcode<>0) then
 | |
|        begin
 | |
|          Message(exec_e_error_while_linking);
 | |
|          aktglobalswitches:=aktglobalswitches+[cs_link_extern];
 | |
|        end;
 | |
|     end;
 | |
|   { Update asmres when externmode is set }
 | |
|   if cs_link_extern in aktglobalswitches then
 | |
|     AsmRes.AddLinkCommand(resbin,s,'');
 | |
|   if ObjUsed then
 | |
|     current_module.linkotherofiles.add(resobj,link_allways);
 | |
| end;
 | |
| 
 | |
| 
 | |
| procedure CompileResourceFiles;
 | |
| var
 | |
|   hr : presourcefile;
 | |
| begin
 | |
|   { OS/2 (EMX) must be processed elsewhere (in the linking/binding stage). }
 | |
|   if not (target_info.system in [system_i386_os2,system_i386_emx]) then
 | |
|    While not current_module.ResourceFiles.Empty do
 | |
|     begin
 | |
|       case target_info.system of
 | |
|         system_m68k_palmos,
 | |
|         system_i386_win32,
 | |
|         system_i386_wdosx :
 | |
|           hr:=new(presourcefile,init(current_module.ResourceFiles.getfirst));
 | |
|         else
 | |
|           Message(scan_e_resourcefiles_not_supported);
 | |
|       end;
 | |
|       hr^.compile;
 | |
|       dispose(hr,done);
 | |
|     end;
 | |
| end;
 | |
| 
 | |
| 
 | |
| end.
 | |
| {
 | |
|   $Log$
 | |
|   Revision 1.19  2003-10-08 17:54:23  florian
 | |
|     * fixed resource compiler search if no utilty directory was given
 | |
| 
 | |
|   Revision 1.18  2003/03/23 23:20:38  hajny
 | |
|     + emx target added
 | |
| 
 | |
|   Revision 1.17  2003/01/30 21:45:40  peter
 | |
|     * path fix (merged)
 | |
| 
 | |
|   Revision 1.16  2003/01/12 15:42:23  peter
 | |
|     * m68k pathexist update from 1.0.x
 | |
|     * palmos res update from 1.0.x
 | |
| 
 | |
|   Revision 1.15  2002/07/26 21:15:37  florian
 | |
|     * rewrote the system handling
 | |
| 
 | |
|   Revision 1.14  2002/05/18 13:34:06  peter
 | |
|     * readded missing revisions
 | |
| 
 | |
|   Revision 1.13  2002/05/16 19:46:35  carl
 | |
|   + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
 | |
|   + try to fix temp allocation (still in ifdef)
 | |
|   + generic constructor calls
 | |
|   + start of tassembler / tmodulebase class cleanup
 | |
| 
 | |
|   Revision 1.11  2002/04/04 18:32:37  carl
 | |
|   + added wdosx support (patch from Pavel)
 | |
| 
 | |
| }
 | 
