diff --git a/.gitattributes b/.gitattributes index 006d3da29d..8160ead31d 100644 --- a/.gitattributes +++ b/.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 diff --git a/ide/frames/project_application_options.pas b/ide/frames/project_application_options.pas index 50954559dd..c04071d5ee 100644 --- a/ide/frames/project_application_options.pas +++ b/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; diff --git a/ide/frames/project_resources_options.lfm b/ide/frames/project_resources_options.lfm index 502d13f68f..5c1c230ab5 100644 --- a/ide/frames/project_resources_options.lfm +++ b/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 diff --git a/ide/frames/project_resources_options.pas b/ide/frames/project_resources_options.pas index 395abf0f3e..a0c07a178f 100644 --- a/ide/frames/project_resources_options.pas +++ b/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; diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index f257e43485..ed97d95134 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -2278,6 +2278,7 @@ resourcestring dlgPOApplication = 'Application'; dlgPOFroms = 'Forms'; dlgPOResources = 'Resources'; + rsResourceFileName = 'File name'; rsResourceType = 'Type'; rsResource = 'Resource'; dlgPOMisc = 'Miscellaneous'; diff --git a/ide/projectresources.pas b/ide/projectresources.pas index 336e610c8c..6da016fb8d 100644 --- a/ide/projectresources.pas +++ b/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)); diff --git a/ide/projectuserresources.pas b/ide/projectuserresources.pas new file mode 100644 index 0000000000..58b1439153 --- /dev/null +++ b/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 . 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. +