ide: save/restore user resource items to/from config

git-svn-id: trunk@43225 -

.gitattributes

@@ -5252,6 +5252,7 @@ ide/projecticon.pas svneol=native#text/pascal
 ide/projectinspector.lfm svneol=native#text/plain
 ide/projectinspector.pas svneol=native#text/pascal
 ide/projectresources.pas svneol=native#text/pascal
+ide/projectuserresources.pas svneol=native#text/pascal
 ide/projectwizarddlg.lfm svneol=native#text/plain
 ide/projectwizarddlg.pas svneol=native#text/plain
 ide/publishmodule.pas svneol=native#text/pascal

ide/frames/project_application_options.pas

@@ -273,15 +273,18 @@ begin
     Title := TitleEdit.Text;
     AStream := GetIconAsStream;
     try
-      TProjectIcon(ProjResources[TProjectIcon]).SetStream(AStream);
+      ProjResources.ProjectIcon.SetStream(AStream);
     finally
       AStream.Free;
     end;
     UseAppBundle := UseAppBundleCheckBox.Checked;
-    TProjectXPManifest(ProjResources[TProjectXPManifest]).UseManifest := UseXPManifestCheckBox.Checked;
-    TProjectXPManifest(ProjResources[TProjectXPManifest]).DpiAware := DpiAwareCheckBox.Checked;
-    TProjectXPManifest(ProjResources[TProjectXPManifest]).ExecutionLevel := TXPManifestExecutionLevel(ExecutionLevelComboBox.ItemIndex);
-    TProjectXPManifest(ProjResources[TProjectXPManifest]).UIAccess := UIAccessCheckBox.Checked;
+    with ProjResources.XPManifest do
+    begin
+      UseManifest := UseXPManifestCheckBox.Checked;
+      DpiAware := DpiAwareCheckBox.Checked;
+      ExecutionLevel := TXPManifestExecutionLevel(ExecutionLevelComboBox.ItemIndex);
+      UIAccess := UIAccessCheckBox.Checked;
+    end;
   end;
 end;
 

ide/frames/project_resources_options.lfm

@@ -6,8 +6,8 @@ object ResourcesOptionsFrame: TResourcesOptionsFrame
   ClientHeight = 330
   ClientWidth = 742
   TabOrder = 0
-  DesignLeft = 334
-  DesignTop = 289
+  DesignLeft = 561
+  DesignTop = 308
   object lbResources: TListView
     Left = 0
     Height = 304
@@ -16,6 +16,15 @@ object ResourcesOptionsFrame: TResourcesOptionsFrame
     Align = alClient
     AutoWidthLastColumn = True
     Columns = <    
+      item
+        Caption = 'FullFileName'
+        Visible = False
+        Width = 0
+      end    
+      item
+        Caption = 'FileName'
+        Width = 150
+      end    
       item
         Caption = 'Type'
         Width = 80

ide/frames/project_resources_options.pas

@@ -7,7 +7,7 @@ interface
 uses
   Classes, SysUtils, FileUtil, Graphics, Forms, Controls, ComCtrls, Dialogs, LCLProc,
   IDEOptionsIntf, IDEImagesIntf,
-  Project, LCLStrConsts, LazarusIDEStrConsts;
+  Project, ProjectUserResources, LCLStrConsts, LazarusIDEStrConsts;
 
 type
 
@@ -23,6 +23,7 @@ type
     procedure btnDeleteClick(Sender: TObject);
   private
     procedure AddResource(AFileName: String);
+    procedure AddResourceItem(ResFile: String; ResType: TUserResourceType; ResName: String);
   public
     function GetTitle: string; override;
     procedure Setup(ADialog: TAbstractOptionsEditorDialog); override;
@@ -52,48 +53,30 @@ begin
     lbResources.Items.Delete(Index);
 end;
 
-procedure TResourcesOptionsFrame.AddResource(AFileName: String);
-
-  procedure AddItem(ResType, ResName: String);
-  var
-    Item: TListItem;
-  begin
-    Item := lbResources.Items.Add;
-    Item.Caption := ResType;
-    Item.SubItems.Add(UTF8UpperCase(ResName));
-  end;
-
-  procedure AddBitmap(AFileName: String);
-  begin
-    AddItem('BITMAP', ExtractFileNameOnly(AFileName));
-  end;
-
-  procedure AddCursor(AFileName: String);
-  begin
-    AddItem('CURSOR', ExtractFileNameOnly(AFileName));
-  end;
-
-  procedure AddIcon(AFileName: String);
-  begin
-    AddItem('ICON', ExtractFileNameOnly(AFileName));
-  end;
-
-  procedure AddRCData(AFileName: String);
-  begin
-    AddItem('RCDATA', ExtractFileNameOnly(AFileName));
-  end;
-
+procedure TResourcesOptionsFrame.AddResourceItem(ResFile: String; ResType: TUserResourceType; ResName: String);
 var
-  Ext: String;
+  Item: TListItem;
+begin
+  Item := lbResources.Items.Add;
+  Item.Caption := ResFile;
+  Item.SubItems.Add(ExtractFileName(ResFile));
+  Item.SubItems.Add(ResourceTypeToStr[ResType]);
+  Item.SubItems.Add(ResName);
+end;
+
+procedure TResourcesOptionsFrame.AddResource(AFileName: String);
+var
+  ResName, Ext: String;
 begin
   Ext := UTF8UpperCase(ExtractFileExt(AFileName));
+  ResName := UTF8UpperCase(ExtractFileNameOnly(AFileName));
   case Ext of
-    '.BMP': AddBitmap(AFileName);
-    '.CUR': AddCursor(AFileName);
-    '.ICO': AddIcon(AFileName);
-    //'.FNT', '.FON', '.TTF': AddFont(AFileName);
+    '.BMP': AddResourceItem(AFileName, rtBitmap, ResName);
+    '.CUR': AddResourceItem(AFileName, rtCursor, ResName);
+    '.ICO': AddResourceItem(AFileName, rtIcon, ResName);
+    //'.FNT', '.FON', '.TTF': AddResourceItem(AFileName, rtFont, ResName);
   else
-    AddRCData(AFileName);
+    AddResourceItem(AFileName, rtRCData, ResName);
   end;
 end;
 
@@ -105,8 +88,9 @@ end;
 procedure TResourcesOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
 begin
   ToolBar1.Images := IDEImages.Images_16;
-  lbResources.Column[0].Caption := rsResourceType;
-  lbResources.Column[1].Caption := rsResource;
+  lbResources.Column[1].Caption := rsResourceFileName;
+  lbResources.Column[2].Caption := rsResourceType;
+  lbResources.Column[3].Caption := rsResource;
   btnAdd.Caption := lisBtnAdd;
   btnDelete.Caption := lisBtnDelete;
   btnAdd.ImageIndex := IDEImages.LoadImage(16, 'laz_add');
@@ -119,13 +103,26 @@ begin
 end;
 
 procedure TResourcesOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
+var
+  Project: TProject absolute AOptions;
+  List: TResourceList;
+  I: Integer;
 begin
-
+  lbResources.Items.Clear;
+  List := Project.ProjResources.UserResources.List;
+  for I := 0 to List.Count - 1 do
+    AddResourceItem(List[I]^.FileName, List[I]^.ResType, List[I]^.ResName);
 end;
 
 procedure TResourcesOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
+var
+  Project: TProject absolute AOptions;
+  I: Integer;
 begin
-
+  Project.ProjResources.UserResources.List.Clear;
+  for I := 0 to lbResources.Items.Count - 1 do
+    Project.ProjResources.UserResources.List.AddResource(lbResources.Items[I].Caption,
+      StrToResourceType(lbResources.Items[I].SubItems[1]), lbResources.Items[I].SubItems[2]);
 end;
 
 class function TResourcesOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;

ide/lazarusidestrconsts.pas

@@ -2278,6 +2278,7 @@ resourcestring
   dlgPOApplication = 'Application';
   dlgPOFroms = 'Forms';
   dlgPOResources = 'Resources';
+  rsResourceFileName = 'File name';
   rsResourceType = 'Type';
   rsResource = 'Resource';
   dlgPOMisc = 'Miscellaneous';

ide/projectresources.pas

@@ -43,7 +43,7 @@ uses
   ProjectIntf, ProjectResourcesIntf, CompOptsIntf,
   LazarusIDEStrConsts,
   IDEProcs, DialogProcs,
-  W32Manifest, W32VersionInfo, ProjectIcon;
+  W32Manifest, W32VersionInfo, ProjectIcon, ProjectUserResources;
 
 type
   { TProjectResources }
@@ -65,6 +65,7 @@ type
     LastLrsFileName: String;
 
     function GetProjectIcon: TProjectIcon;
+    function GetProjectUserResources: TProjectUserResources;
     function GetVersionInfo: TProjectVersionInfo;
     function GetXPManifest: TProjectXPManifest;
     procedure SetFileNames(const MainFileName, TestDir: String);
@@ -108,6 +109,7 @@ type
     property XPManifest: TProjectXPManifest read GetXPManifest;
     property VersionInfo: TProjectVersionInfo read GetVersionInfo;
     property ProjectIcon: TProjectIcon read GetProjectIcon;
+    property UserResources: TProjectUserResources read GetProjectUserResources;
   end;
 
 function GuessResourceType(Code: TCodeBuffer; out Typ: TResourceType): boolean;
@@ -339,6 +341,11 @@ begin
   Result := TProjectIcon(GetProjectResource(TProjectIcon));
 end;
 
+function TProjectResources.GetProjectUserResources: TProjectUserResources;
+begin
+  Result := TProjectUserResources(GetProjectResource(TProjectUserResources));
+end;
+
 function TProjectResources.GetVersionInfo: TProjectVersionInfo;
 begin
   Result := TProjectVersionInfo(GetProjectResource(TProjectVersionInfo));

ide/projectuserresources.pas

@@ -0,0 +1,202 @@
+{
+ /***************************************************************************
+                        projecticon.pas  -  Lazarus IDE unit
+                        ---------------------------------------
+               TProjectIcon is responsible for the inclusion of the 
+             icon in windows executables as rc file and others as .lrs.
+
+
+ ***************************************************************************/
+
+ ***************************************************************************
+ *                                                                         *
+ *   This source 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 code 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.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+}
+unit ProjectUserResources;
+
+{$mode objfpc}{$H+}
+{$modeswitch advancedrecords}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Laz2_XMLCfg, lazutf8classes, Process, LCLProc,
+  Controls, Graphics, Forms, CodeToolManager, FileProcs, LazConf, LResources,
+  resource, groupiconresource, ProjectIntf, ProjectResourcesIntf;
+   
+type
+  TUserResourceType = (
+    rtIcon,    // maps to RT_GROUP_ICON
+    rtCursor,  // maps to RT_GROUP_CURSOR
+    rtBitmap,  // maps to RT_BITMAP
+    rtRCData   // maps to RT_RCDATA
+  );
+  PResourceItem = ^TResourceItem;
+
+  { TResourceItem }
+
+  TResourceItem = record
+  public
+    FileName: String;
+    ResType: TUserResourceType;
+    ResName: String;
+    procedure ReadFromProjectFile(AConfig: TXMLConfig; Path: String);
+    procedure WriteToProjectFile(AConfig: TXMLConfig; Path: String);
+  end;
+
+  { TResourceList }
+
+  TResourceList = class(TList)
+  private
+    function GetItem(AIndex: Integer): PResourceItem;
+  protected
+    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
+  public
+    function AddItem: PResourceItem;
+    procedure AddResource(FileName: String; ResType: TUserResourceType; ResName: String);
+    property Items[AIndex: Integer]: PResourceItem read GetItem; default;
+  end;
+
+  { TProjectUserResources }
+
+  TProjectUserResources = class(TAbstractProjectResource)
+  private
+    FList: TResourceList;
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+
+    function UpdateResources(AResources: TAbstractProjectResources;
+                             const MainFilename: string): Boolean; override;
+    procedure WriteToProjectFile(AConfig: {TXMLConfig}TObject; Path: String); override;
+    procedure ReadFromProjectFile(AConfig: {TXMLConfig}TObject; Path: String); override;
+    property List: TResourceList read FList;
+  end;
+
+const
+  ResourceTypeToStr: array[TUserResourceType] of String = (
+ { rtIcon   } 'ICON',
+ { rtCursor } 'CURSOR',
+ { rtBitmap } 'BITMAP',
+ { rtRCData } 'RCDATA'
+  );
+
+  function StrToResourceType(AStr: String): TUserResourceType;
+
+implementation
+
+function StrToResourceType(AStr: String): TUserResourceType;
+begin
+  case AStr of
+    'ICON': Result := rtIcon;
+    'CURSOR': Result := rtCursor;
+    'BITMAP': Result := rtBitmap;
+  else
+    Result := rtRCData;
+  end;
+end;
+
+{ TResourceItem }
+
+procedure TResourceItem.ReadFromProjectFile(AConfig: TXMLConfig; Path: String);
+begin
+  FileName := AConfig.GetValue(Path + 'FileName', '');
+  ResType := StrToResourceType(AConfig.GetValue(Path + 'Type', ''));
+  ResName := AConfig.GetValue(Path + 'ResourceName', '');
+end;
+
+procedure TResourceItem.WriteToProjectFile(AConfig: TXMLConfig; Path: String);
+begin
+  AConfig.SetValue(Path + 'FileName', FileName);
+  AConfig.SetValue(Path + 'Type', ResourceTypeToStr[ResType]);
+  AConfig.SetValue(Path + 'ResourceName', ResName);
+end;
+
+{ TResourceList }
+
+function TResourceList.GetItem(AIndex: Integer): PResourceItem;
+begin
+  Result := PResourceItem(inherited Get(AIndex));
+end;
+
+procedure TResourceList.Notify(Ptr: Pointer; Action: TListNotification);
+begin
+  if Action = lnDeleted then
+    Dispose(PResourceItem(Ptr))
+  else
+    inherited Notify(Ptr, Action);
+end;
+
+function TResourceList.AddItem: PResourceItem;
+begin
+  New(Result);
+  Add(Result);
+end;
+
+procedure TResourceList.AddResource(FileName: String; ResType: TUserResourceType;
+  ResName: String);
+var
+  Data: PResourceItem;
+begin
+  Data := AddItem;
+  Data^.FileName := FileName;
+  Data^.ResType := ResType;
+  Data^.ResName := ResName;
+end;
+
+function TProjectUserResources.UpdateResources(AResources: TAbstractProjectResources; const MainFilename: string): Boolean;
+begin
+  Result := True;
+end;
+
+procedure TProjectUserResources.WriteToProjectFile(AConfig: TObject; Path: String);
+var
+  I: Integer;
+begin
+  TXMLConfig(AConfig).SetDeleteValue(Path+'General/Resources/Count', List.Count, 0);
+  for I := 0 to List.Count - 1 do
+    List[I]^.WriteToProjectFile(TXMLConfig(AConfig), Path + 'General/Resources/Resource_' + IntToStr(I) + '/')
+end;
+
+procedure TProjectUserResources.ReadFromProjectFile(AConfig: TObject; Path: String);
+var
+  I, Count: Integer;
+begin
+  List.Clear;
+  Count := TXMLConfig(AConfig).GetValue(Path+'General/Resources/Count', 0);
+  for I := 0 to Count - 1 do
+    List.AddItem^.ReadFromProjectFile(TXMLConfig(AConfig), Path + 'General/Resources/Resource_' + IntToStr(I) + '/')
+end;
+
+constructor TProjectUserResources.Create;
+begin
+  inherited Create;
+  FList := TResourceList.Create;
+end;
+
+destructor TProjectUserResources.Destroy;
+begin
+  FList.Free;
+  inherited Destroy;
+end;
+
+initialization
+  RegisterProjectResource(TProjectUserResources);
+
+end.
+