mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 15:09:33 +02: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)
|
|
|
|
}
|