paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-19 07:29:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

ide: add resources with relative paths, process relative paths and macroses during resource processing

Browse Source 
git-svn-id: trunk@43281 -
This commit is contained in:
paul 2013-10-19 12:12:01 +00:00
parent 8bf097e799
commit 7aae9b8287
3 changed files with 38 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
ide/frames/project_resources_options.lfm
View File

@ -25,7 +25,7 @@ object ResourcesOptionsFrame: TResourcesOptionsFrame
Columns = <
item
Caption = 'FileName'
Width = 300
Width = 200
end
item
Caption = 'Type'
@ -33,7 +33,7 @@ object ResourcesOptionsFrame: TResourcesOptionsFrame
end
item
Caption = 'Resource'
Width = 376
Width = 326
end>
RowSelect = True
TabOrder = 0
@ -132,6 +132,7 @@ object ResourcesOptionsFrame: TResourcesOptionsFrame
TabOrder = 3
end
object dlgOpen: TOpenDialog
Options = [ofAllowMultiSelect, ofEnableSizing, ofViewDetail]
left = 146
top = 93
end

13
ide/frames/project_resources_options.pas
View File

@ -36,6 +36,7 @@ type
procedure lbResourcesSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
private
FProject: TProject;
procedure AddResource(AFileName: String);
procedure AddResourceItem(ResFile: String; ResType: TUserResourceType; ResName: String);
public
@ -53,9 +54,18 @@ implementation
{ TResourcesOptionsFrame }
procedure TResourcesOptionsFrame.btnAddClick(Sender: TObject);
var
FileName: String;
begin
if dlgOpen.Execute then
AddResource(dlgOpen.FileName);
begin
for FileName in dlgOpen.Files do
begin
if not FProject.IsVirtual then
FileName := CreateRelativePath(FileName, FProject.ProjectDirectory);
AddResource(FileName);
end;
end;
end;
procedure TResourcesOptionsFrame.btnClearClick(Sender: TObject);
@ -175,6 +185,7 @@ var
List: TResourceList;
I: Integer;
begin
FProject := Project;
lbResources.Items.Clear;
List := Project.ProjResources.UserResources.List;
lbResources.Items.BeginUpdate;

29
ide/projectuserresources.pas
View File

@ -37,7 +37,7 @@ interface
uses
Classes, SysUtils, FileUtil, Laz2_XMLCfg, lazutf8classes, Process, LCLProc,
Controls, Graphics, Forms, CodeToolManager, FileProcs, LazConf, LResources,
ProjectIntf, ProjectResourcesIntf, IDEMsgIntf, IDEExternToolIntf, LazarusIDEStrConsts,
ProjectIntf, ProjectResourcesIntf, IDEMsgIntf, IDEExternToolIntf, MacroIntf, LazarusIDEStrConsts,
resource, bitmapresource, groupresource, groupiconresource, groupcursorresource;
type
@ -59,7 +59,8 @@ type
ResName: String;
procedure ReadFromProjectFile(AConfig: TXMLConfig; Path: String);
procedure WriteToProjectFile(AConfig: TXMLConfig; Path: String);
function CreateResource: TAbstractResource;
function CreateResource(ProjectDirectory: String): TAbstractResource;
function GetRealFileName(ProjectDirectory: String): String;
end;
{ TResourceList }
@ -132,15 +133,19 @@ begin
AConfig.SetValue(Path + 'ResourceName', ResName);
end;
function TResourceItem.CreateResource: TAbstractResource;
function TResourceItem.CreateResource(ProjectDirectory: String): TAbstractResource;
var
Stream: TFileStream;
TypeDesc, NameDesc: TResourceDesc;
RealFileName: String;
begin
Result := nil;
if FileExistsUTF8(FileName) then
RealFileName := GetRealFileName(ProjectDirectory);
if FileExistsUTF8(RealFileName) then
begin
Stream := TFileStream.Create(UTF8ToSys(FileName), fmOpenRead or fmShareDenyWrite);
Stream := TFileStream.Create(UTF8ToSys(RealFileName), fmOpenRead or fmShareDenyWrite);
try
NameDesc := TResourceDesc.Create(ResName);
case ResType of
@ -187,6 +192,16 @@ begin
{$ENDIF}
end;
function TResourceItem.GetRealFileName(ProjectDirectory: String): String;
begin
Result := FileName;
if not IDEMacros.SubstituteMacros(Result) then
debugln(['TResourceItem.GetRealFileName failed FileName="', FileName, '"']);
Result := TrimFilename(Result);
if not FilenameIsAbsolute(Result) then
Result := TrimFilename(AppendPathDelim(ProjectDirectory) + Result);
end;
{ TResourceList }
function TResourceList.GetItem(AIndex: Integer): PResourceItem;
@ -223,11 +238,13 @@ function TProjectUserResources.UpdateResources(AResources: TAbstractProjectResou
var
I: Integer;
ARes: TAbstractResource;
ProjectDirectory: String;
begin
Result := True;
ProjectDirectory := ExtractFilePath(MainFileName);
for I := 0 to List.Count - 1 do
begin
ARes := List[I]^.CreateResource;
ARes := List[I]^.CreateResource(ProjectDirectory);
if Assigned(ARes) then
AResources.AddSystemResource(ARes);
end;