From 24f8569925b2e876705873387054814f9e5ae00a Mon Sep 17 00:00:00 2001 From: juha Date: Wed, 26 Sep 2018 17:49:33 +0000 Subject: [PATCH] IDE: Support 3 icons with different resolutions in "New Component" dialog. Improve the GUI. git-svn-id: trunk@59170 - --- ide/lazarusidestrconsts.pas | 16 +- packager/addtopackagedlg.lfm | 227 +++++++++++++++------- packager/addtopackagedlg.pas | 353 +++++++++++++++++++++-------------- packager/packageeditor.pas | 3 +- packager/pkgmanager.pas | 120 ++++++------ 5 files changed, 443 insertions(+), 276 deletions(-) diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index cc472231d8..71168653f8 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -1551,7 +1551,6 @@ resourcestring lisPkgMangThePackageFailedToCompileRemoveItFromTheInstallati = 'The package "%s" ' +'failed to compile.%sRemove it from the installation list?'; lisEnvOptDlgTestDirNotFoundMsg = 'Test directory "%s" not found.'; - lisTitleOpenComponentIcon24x24 = 'Choose a component icon 24x24'; // open-dialog filters dlgFilterAll = 'All files'; @@ -4531,8 +4530,6 @@ resourcestring lisA2PPageNameTooLong = 'Page Name too long'; lisA2PThePageNameIsTooLongMax100Chars = 'The page name "%s" is too long (max 100 chars).'; lisA2PUnitNameInvalid = 'Unit Name Invalid'; - lisA2PTheUnitNameDoesNotCorrespondToTheFilename = 'The unit name "%s" ' - +'does not correspond to the filename.'; lisA2PInvalidClassName = 'Invalid Class Name'; lisA2PTheClassNameIsNotAValidPascalIdentifier = 'The class name "%s" is ' +'not a valid Pascal identifier.'; @@ -4557,15 +4554,18 @@ resourcestring +'%sFor example: 1.0.20.10'; lisA2PNewFile = 'New File'; lisA2PAddFiles = 'Add Files'; - lisA2PAncestorType = 'Ancestor Type'; + lisA2PAncestorType = 'Ancestor type'; lisA2PShowAll = 'Show all'; lisA2PNewClassName = 'New class name:'; - lisA2PPalettePage = 'Palette Page:'; - lisA2PUnitFileName2 = 'Unit File Name:'; - lisA2PUnitName = 'Unit Name:'; + lisA2PPalettePage = 'Palette page:'; + lisA2PDirectoryForUnitFile = 'Directory for unit file:'; + lisA2PUnitName = 'Unit name:'; lisA2PShortenOrExpandFilename = 'Shorten or expand filename'; lisA2PSaveFileDialog = 'Save file dialog'; - lisA2PIconAndSize = 'Icon (maximum 24x24):'; + lisA2PIcon24x24 = 'Icon 24x24:'; + lisA2PIcon36x36 = 'Icon 36x36:'; + lisA2PIcon48x48 = 'Icon 48x48:'; + lisMoveSelectedUp = 'Move selected item up (Ctrl+Up)'; lisMoveSelectedDown = 'Move selected item down (Ctrl+Down)'; diff --git a/packager/addtopackagedlg.lfm b/packager/addtopackagedlg.lfm index ffd37a6cfa..9cdf5ce719 100644 --- a/packager/addtopackagedlg.lfm +++ b/packager/addtopackagedlg.lfm @@ -1,23 +1,23 @@ object AddToPackageDlg: TAddToPackageDlg Left = 383 - Height = 263 + Height = 391 Top = 297 - Width = 606 + Width = 696 BorderIcons = [biSystemMenu, biMaximize] Caption = 'New component' - ClientHeight = 263 - ClientWidth = 606 + ClientHeight = 391 + ClientWidth = 696 KeyPreview = True OnClose = AddToPackageDlgClose OnCreate = FormCreate OnDestroy = FormDestroy Position = poScreenCenter - LCLVersion = '1.9.0.0' + LCLVersion = '2.1.0.0' object ButtonPanel1: TButtonPanel Left = 6 - Height = 26 - Top = 231 - Width = 594 + Height = 30 + Top = 355 + Width = 684 OKButton.Name = 'OKButton' OKButton.DefaultCaption = True HelpButton.Name = 'HelpButton' @@ -33,11 +33,11 @@ object AddToPackageDlg: TAddToPackageDlg object AncestorComboBox: TComboBox AnchorSideLeft.Side = asrBottom Left = 184 - Height = 31 + Height = 33 Top = 6 Width = 200 BorderSpacing.Top = 6 - ItemHeight = 0 + ItemHeight = 25 OnChange = AncestorComboBoxChange OnCloseUp = AncestorComboBoxCloseUp TabOrder = 0 @@ -50,8 +50,8 @@ object AddToPackageDlg: TAddToPackageDlg AnchorSideRight.Control = AncestorComboBox AnchorSideRight.Side = asrBottom Left = 184 - Height = 25 - Top = 43 + Height = 33 + Top = 45 Width = 200 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 6 @@ -66,69 +66,70 @@ object AddToPackageDlg: TAddToPackageDlg AnchorSideRight.Control = AncestorComboBox AnchorSideRight.Side = asrBottom Left = 184 - Height = 31 - Top = 74 + Height = 33 + Top = 84 Width = 200 BorderSpacing.Top = 6 - ItemHeight = 0 + ItemHeight = 25 TabOrder = 3 Text = 'PalettePageCombobox' end - object ComponentUnitFileEdit: TEdit + object UnitDirectoryEdit: TEdit AnchorSideLeft.Control = AncestorComboBox - AnchorSideTop.Control = PalettePageCombobox + AnchorSideTop.Control = UnitNameEdit AnchorSideTop.Side = asrBottom AnchorSideRight.Control = ComponentUnitFileBrowseButton Left = 184 - Height = 25 - Top = 111 - Width = 359 + Height = 33 + Top = 162 + Width = 442 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 6 + OnChange = UnitDirectoryEditChange TabOrder = 4 - Text = 'ComponentUnitFileEdit' + Text = 'UnitDirectoryEdit' end - object ComponentUnitNameEdit: TEdit + object UnitNameEdit: TEdit AnchorSideLeft.Control = AncestorComboBox - AnchorSideTop.Control = ComponentUnitFileEdit + AnchorSideTop.Control = PalettePageCombobox AnchorSideTop.Side = asrBottom AnchorSideRight.Control = AncestorComboBox AnchorSideRight.Side = asrBottom Left = 184 - Height = 25 - Top = 142 + Height = 33 + Top = 123 Width = 200 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 6 - OnChange = ComponentUnitNameEditChange + OnChange = UnitNameEditChange TabOrder = 7 - Text = 'ComponentUnitNameEdit' + Text = 'UnitNameEdit' end - object ComponentIconBitBtn: TBitBtn - AnchorSideLeft.Control = ComponentUnitNameEdit - AnchorSideTop.Control = ComponentUnitNameEdit + object IconNormBitBtn: TBitBtn + AnchorSideLeft.Control = AncestorComboBox + AnchorSideTop.Control = UnitFilenameLabel AnchorSideTop.Side = asrBottom Left = 184 Height = 32 - Top = 173 + Top = 223 Width = 50 BorderSpacing.Top = 6 Constraints.MinWidth = 50 GlyphShowMode = gsmAlways - OnClick = ComponentIconBitBtnClick + OnClick = IconBitBtnClick TabOrder = 8 end - object LabelIconInfo: TLabel - AnchorSideLeft.Control = ComponentIconBitBtn + object IconNormInfoLabel: TLabel + AnchorSideLeft.Control = IconNormBitBtn AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = ComponentIconLabel + AnchorSideTop.Control = IconNormLabel AnchorSideTop.Side = asrCenter Left = 240 Height = 19 - Top = 180 - Width = 6 + Top = 230 + Width = 125 BorderSpacing.Around = 6 - Caption = '?' + Caption = 'IconNormInfoLabel' ParentColor = False end object AncestorShowAllCheckBox: TCheckBox @@ -137,9 +138,9 @@ object AddToPackageDlg: TAddToPackageDlg AnchorSideTop.Control = AncestorComboBox AnchorSideTop.Side = asrCenter Left = 390 - Height = 21 + Height = 23 Top = 11 - Width = 190 + Width = 199 BorderSpacing.Left = 6 Caption = 'AncestorShowAllCheckBox' Checked = True @@ -149,13 +150,13 @@ object AddToPackageDlg: TAddToPackageDlg end object ComponentUnitFileBrowseButton: TButton AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = ComponentUnitFileEdit + AnchorSideTop.Control = UnitDirectoryEdit AnchorSideTop.Side = asrCenter AnchorSideRight.Control = ComponentUnitFileShortenButton - Left = 543 + Left = 626 Height = 25 Hint = 'Save file dialog' - Top = 111 + Top = 166 Width = 25 Anchors = [akTop, akRight] Caption = '...' @@ -166,14 +167,14 @@ object AddToPackageDlg: TAddToPackageDlg end object ComponentUnitFileShortenButton: TButton AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = ComponentUnitFileEdit + AnchorSideTop.Control = UnitDirectoryEdit AnchorSideTop.Side = asrCenter AnchorSideRight.Side = asrBottom - Left = 568 - Height = 25 + Left = 651 + Height = 29 Hint = 'Shorten or expand filename' - Top = 111 - Width = 22 + Top = 164 + Width = 29 Anchors = [akTop, akRight] AutoSize = True BorderSpacing.Right = 6 @@ -183,35 +184,34 @@ object AddToPackageDlg: TAddToPackageDlg ShowHint = True TabOrder = 6 end - object ComponentIconLabel: TLabel - AnchorSideLeft.Control = ComponentUnitNameLabel - AnchorSideTop.Control = ComponentIconBitBtn + object IconNormLabel: TLabel + AnchorSideTop.Control = IconNormBitBtn AnchorSideTop.Side = asrCenter Left = 5 Height = 19 - Top = 180 - Width = 135 - Caption = 'ComponentIconLabel' + Top = 230 + Width = 99 + Caption = 'IconNormLabel' ParentColor = False end - object ComponentUnitNameLabel: TLabel - AnchorSideTop.Control = ComponentUnitNameEdit + object UnitNameLabel: TLabel + AnchorSideTop.Control = UnitNameEdit AnchorSideTop.Side = asrCenter Left = 5 Height = 19 - Top = 145 - Width = 173 - Caption = 'ComponentUnitNameLabel' + Top = 130 + Width = 100 + Caption = 'UnitNameLabel' ParentColor = False end - object ComponentUnitFileLabel: TLabel - AnchorSideTop.Control = ComponentUnitFileEdit + object UnitDirectoryLabel: TLabel + AnchorSideTop.Control = UnitDirectoryEdit AnchorSideTop.Side = asrCenter Left = 5 Height = 19 - Top = 114 - Width = 155 - Caption = 'ComponentUnitFileLabel' + Top = 169 + Width = 121 + Caption = 'UnitDirectoryLabel' ParentColor = False end object PalettePageLabel: TLabel @@ -219,7 +219,7 @@ object AddToPackageDlg: TAddToPackageDlg AnchorSideTop.Side = asrCenter Left = 5 Height = 19 - Top = 80 + Top = 91 Width = 111 Caption = 'PalettePageLabel' ParentColor = False @@ -229,8 +229,8 @@ object AddToPackageDlg: TAddToPackageDlg AnchorSideTop.Side = asrCenter Left = 5 Height = 19 - Top = 46 - Width = 104 + Top = 52 + Width = 106 Caption = 'ClassNameLabel' ParentColor = False end @@ -239,9 +239,98 @@ object AddToPackageDlg: TAddToPackageDlg AnchorSideTop.Side = asrCenter Left = 5 Height = 19 - Top = 12 - Width = 120 + Top = 13 + Width = 122 Caption = 'AncestorTypeLabel' ParentColor = False end + object Icon150BitBtn: TBitBtn + AnchorSideLeft.Control = IconNormBitBtn + AnchorSideTop.Control = IconNormBitBtn + AnchorSideTop.Side = asrBottom + Left = 184 + Height = 32 + Top = 261 + Width = 50 + BorderSpacing.Top = 6 + Constraints.MinWidth = 50 + GlyphShowMode = gsmAlways + OnClick = IconBitBtnClick + TabOrder = 10 + end + object Icon200BitBtn: TBitBtn + AnchorSideLeft.Control = Icon150BitBtn + AnchorSideTop.Control = Icon150BitBtn + AnchorSideTop.Side = asrBottom + Left = 184 + Height = 32 + Top = 299 + Width = 50 + BorderSpacing.Top = 6 + Constraints.MinWidth = 50 + GlyphShowMode = gsmAlways + OnClick = IconBitBtnClick + TabOrder = 11 + end + object Icon150Label: TLabel + AnchorSideLeft.Control = IconNormLabel + AnchorSideTop.Control = Icon150BitBtn + AnchorSideTop.Side = asrCenter + Left = 5 + Height = 19 + Top = 268 + Width = 85 + Caption = 'Icon150Label' + ParentColor = False + end + object Icon200Label: TLabel + AnchorSideLeft.Control = IconNormLabel + AnchorSideTop.Control = Icon200BitBtn + AnchorSideTop.Side = asrCenter + Left = 5 + Height = 19 + Top = 306 + Width = 85 + Caption = 'Icon200Label' + ParentColor = False + end + object Icon150InfoLabel: TLabel + AnchorSideLeft.Control = Icon150BitBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Icon150BitBtn + AnchorSideTop.Side = asrCenter + Left = 240 + Height = 19 + Top = 268 + Width = 111 + BorderSpacing.Around = 6 + Caption = 'Icon150InfoLabel' + ParentColor = False + end + object Icon200InfoLabel: TLabel + AnchorSideLeft.Control = Icon200BitBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Icon200BitBtn + AnchorSideTop.Side = asrCenter + Left = 240 + Height = 19 + Top = 306 + Width = 111 + BorderSpacing.Around = 6 + Caption = 'Icon200InfoLabel' + ParentColor = False + end + object UnitFilenameLabel: TLabel + AnchorSideLeft.Control = UnitDirectoryEdit + AnchorSideTop.Control = UnitDirectoryEdit + AnchorSideTop.Side = asrBottom + Left = 195 + Height = 19 + Top = 198 + Width = 120 + BorderSpacing.Left = 11 + BorderSpacing.Top = 3 + Caption = 'UnitFilenameLabel' + ParentColor = False + end end diff --git a/packager/addtopackagedlg.pas b/packager/addtopackagedlg.pas index ecbfee9a07..55c0162616 100644 --- a/packager/addtopackagedlg.pas +++ b/packager/addtopackagedlg.pas @@ -38,7 +38,7 @@ uses FileUtil, LazFileUtils, // IDEIntf NewItemIntf, PackageIntf, FormEditingIntf, IDEWindowIntf, ComponentReg, - IDEDialogs, IDEImagesIntf, + IDEDialogs, // IDE LazarusIDEStrConsts, InputHistory, IDEDefs, EnvironmentOpts, PackageSystem, PackageDefs, ProjPackChecks; @@ -59,7 +59,9 @@ type FileType: TPkgFileType; PkgFileFlags: TPkgFileFlags; UsedUnitname: string; - IconFile: string; + IconNormFile: string; + Icon150File: string; + Icon200File: string; AutoAddLFMFile: boolean; AutoAddLRSFile: boolean; NewItem: TNewIDEItemTemplate; @@ -71,6 +73,19 @@ type TOnGetUnitRegisterInfo = procedure(Sender: TObject; const AFilename: string; out TheUnitName: string; out HasRegisterProc: boolean) of object; + { TIconGuiStuff } + + TIconGuiStuff = class + // Join icon related GUI controls together. Streamlines the code. + private + Btn: TBitBtn; + InfoLabel: TLabel; + Title: string; + FileName: string; + constructor Create(aBtn: TBitBtn; aInfoLabel: TLabel; aTitle: string); + procedure LoadIcon(aLazPackage: TLazPackage; aFileName: string); + end; + { TAddToPackageDlg } TAddToPackageDlg = class(TForm) @@ -80,15 +95,22 @@ type ButtonPanel1: TButtonPanel; ClassNameEdit: TEdit; ClassNameLabel: TLabel; - ComponentIconBitBtn: TBitBtn; - ComponentIconLabel: TLabel; + Icon200Label: TLabel; + IconNormBitBtn: TBitBtn; + Icon150BitBtn: TBitBtn; + Icon150InfoLabel: TLabel; + Icon200InfoLabel: TLabel; + IconNormLabel: TLabel; ComponentUnitFileBrowseButton: TButton; - ComponentUnitFileEdit: TEdit; - ComponentUnitFileLabel: TLabel; + UnitDirectoryEdit: TEdit; + UnitDirectoryLabel: TLabel; ComponentUnitFileShortenButton: TButton; - ComponentUnitNameEdit: TEdit; - ComponentUnitNameLabel: TLabel; - LabelIconInfo: TLabel; + UnitNameEdit: TEdit; + UnitNameLabel: TLabel; + Icon200BitBtn: TBitBtn; + Icon150Label: TLabel; + IconNormInfoLabel: TLabel; + UnitFilenameLabel: TLabel; PalettePageCombobox: TComboBox; PalettePageLabel: TLabel; procedure AddToPackageDlgClose(Sender: TObject; var {%H-}CloseAction: TCloseAction); @@ -96,30 +118,32 @@ type procedure AncestorComboBoxCloseUp(Sender: TObject); procedure AncestorShowAllCheckBoxClick(Sender: TObject); procedure ClassNameEditChange(Sender: TObject); - procedure ComponentIconBitBtnClick(Sender: TObject); + procedure IconBitBtnClick(Sender: TObject); procedure ComponentUnitFileBrowseButtonClick(Sender: TObject); procedure ComponentUnitFileShortenButtonClick(Sender: TObject); - procedure ComponentUnitNameEditChange(Sender: TObject); + procedure UnitDirectoryEditChange(Sender: TObject); + procedure UnitNameEditChange(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure NewComponentButtonClick(Sender: TObject); private - fLastNewComponentAncestorType: string; - fLastNewComponentClassName: string; + fLastNewAncestorType: string; + fLastNewClassName: string; FLazPackage: TLazPackage; FOnGetIDEFileInfo: TGetIDEFileStateEvent; FOnGetUnitRegisterInfo: TOnGetUnitRegisterInfo; fPkgComponents: TAVLTree;// tree of TPkgComponent fPackages: TAVLTree;// tree of TLazPackage or TPackageLink - FComponentIconFilename: string; fParams: TAddToPkgResult; + fIconNormGUI: TIconGuiStuff; + fIcon150GUI: TIconGuiStuff; + fIcon200GUI: TIconGuiStuff; + function GenerateUnitFileName: string; procedure SetLazPackage(const AValue: TLazPackage); procedure OnIterateComponentClasses(PkgComponent: TPkgComponent); function CheckNewCompOk: Boolean; procedure AutoCompleteNewComponent; procedure AutoCompleteNewComponentUnitName; - function SwitchRelativeAbsoluteFilename(const Filename: string): string; - procedure LoadComponentIcon(AFilename: string); public procedure UpdateAvailableAncestorTypes; procedure UpdateAvailablePageNames; @@ -162,6 +186,48 @@ begin end; end; +{ TIconGuiStuff } + +constructor TIconGuiStuff.Create(aBtn: TBitBtn; aInfoLabel: TLabel; aTitle: string); +begin + Btn:=aBtn; + InfoLabel:=aInfoLabel; + Title:=aTitle; + // Set button Width and Height. (Is this needed?) + Btn.Width:=ComponentPaletteBtnWidth; + Btn.Height:=ComponentPaletteBtnHeight; + InfoLabel.Caption:=''; +end; + +procedure TIconGuiStuff.LoadIcon(aLazPackage: TLazPackage; aFileName: string); +var + ShortFN: String; + Image: TImage; +begin + Filename:=aFileName; + try + Image:=TImage.Create(nil); + try + Image.Picture.LoadFromFile(Filename); + Btn.Glyph.Assign(Image.Picture.Graphic); + ShortFN:=Filename; + aLazPackage.ShortenFilename(ShortFN,true); + InfoLabel.Caption:=Format('%s (%dx%d)',[ShortFN, Btn.Glyph.Width, Btn.Glyph.Height]); + finally + Image.Free; + end; + except + on E: Exception do begin + IDEMessageDialog(lisCCOErrorCaption, + Format(lisErrorLoadingFile2,[FileName]) + LineEnding + E.Message, + mtError, [mbCancel]); + Btn.Glyph.Clear; + InfoLabel.Caption:=lisNoneClickToChooseOne; + FileName:=''; + end; + end; +end; + { TAddToPackageDlg } procedure TAddToPackageDlg.FormCreate(Sender: TObject); @@ -170,7 +236,7 @@ begin fPkgComponents:=TAVLTree.Create(@CompareIDEComponentByClassName); fPackages:=TAVLTree.Create(@CompareLazPackageID); fParams:=TAddToPkgResult.Create; - IDEDialogLayoutList.ApplyLayout(Self,500,260); + IDEDialogLayoutList.ApplyLayout(Self,700,390); // Setup Components ButtonPanel1.OkButton.Caption:=lisA2PCreateNewComp; ButtonPanel1.OkButton.OnClick:=@NewComponentButtonClick; @@ -182,8 +248,9 @@ begin ClassNameEdit.Text:=''; PalettePageLabel.Caption:=lisA2PPalettePage; PalettePageCombobox.Text:=''; - ComponentUnitFileLabel.Caption:=lisA2PUnitFileName2; - ComponentUnitFileEdit.Text:=''; + UnitDirectoryLabel.Caption:=lisA2PDirectoryForUnitFile; + UnitDirectoryEdit.Text:=''; + UnitFilenameLabel.Caption:=''; with ComponentUnitFileBrowseButton do begin Caption:='...'; ShowHint:=true; @@ -194,18 +261,25 @@ begin ShowHint:=true; Hint:=lisA2PShortenOrExpandFilename; end; - ComponentUnitNameLabel.Caption:=lisA2PUnitName; - ComponentUnitNameEdit.Text:=''; - ComponentIconLabel.Caption:=lisA2PIconAndSize; - ComponentIconBitBtn.Width:=ComponentPaletteBtnWidth; - ComponentIconBitBtn.Height:=ComponentPaletteBtnHeight; + UnitNameLabel.Caption:=lisA2PUnitName; + UnitNameEdit.Text:=''; + IconNormLabel.Caption:=lisA2PIcon24x24; + Icon150Label.Caption:=lisA2PIcon36x36; + Icon200Label.Caption:=lisA2PIcon48x48; + // Helper objects to join icon related GUI controls together + fIconNormGUI:=TIconGuiStuff.Create(IconNormBitBtn, IconNormInfoLabel, lisA2PIcon24x24); + fIcon150GUI:=TIconGuiStuff.Create(Icon150BitBtn, Icon150InfoLabel, lisA2PIcon36x36); + fIcon200GUI:=TIconGuiStuff.Create(Icon200BitBtn, Icon200InfoLabel, lisA2PIcon48x48); end; procedure TAddToPackageDlg.FormDestroy(Sender: TObject); begin - FreeAndNil(fPkgComponents); - FreeAndNil(fPackages); + FreeAndNil(fIcon200GUI); + FreeAndNil(fIcon150GUI); + FreeAndNil(fIconNormGUI); FreeAndNil(fParams); + FreeAndNil(fPackages); + FreeAndNil(fPkgComponents); end; procedure TAddToPackageDlg.AddToPackageDlgClose(Sender: TObject; @@ -221,7 +295,7 @@ end; procedure TAddToPackageDlg.AncestorComboBoxCloseUp(Sender: TObject); begin - if fLastNewComponentAncestorType<>AncestorComboBox.Text then + if fLastNewAncestorType<>AncestorComboBox.Text then AutoCompleteNewComponent; end; @@ -236,15 +310,35 @@ begin CheckNewCompOk; end; -procedure TAddToPackageDlg.ComponentIconBitBtnClick(Sender: TObject); +procedure TAddToPackageDlg.IconBitBtnClick(Sender: TObject); var Dlg: TOpenPictureDialog; + + function RelatedIconFile(aSuffix: string): string; + var + Ext: String; + begin + Ext := ExtractFileExt(Dlg.FileName); + Result := ExtractFileNameWithoutExt(Dlg.FileName)+ASuffix+Ext; + end; + +var + Btn: TBitBtn; + IconGUI: TIconGuiStuff; + OtherIconFile: string; begin + Btn:=Sender as TBitBtn; Dlg:=TOpenPictureDialog.Create(nil); try InputHistories.ApplyFileDialogSettings(Dlg); - Dlg.InitialDir:=LazPackage.GetFileDialogInitialDir(ExtractFilePath(ComponentUnitFileEdit.Text)); - Dlg.Title:=lisTitleOpenComponentIcon24x24; + Dlg.InitialDir:=LazPackage.GetFileDialogInitialDir(UnitDirectoryEdit.Text); + if Btn = IconNormBitBtn then + IconGUI:=fIconNormGUI + else if Btn = Icon150BitBtn then + IconGUI:=fIcon150GUI + else if Btn = Icon200BitBtn then + IconGUI:=fIcon200GUI; + Dlg.Title:=IconGUI.Title; Dlg.Options:=Dlg.Options+[ofPathMustExist]; Dlg.Filter:=Format('%s|*.png|%s|*.bmp|%s|*.xpm|%s|%s', [dlgFilterImagesPng, @@ -253,7 +347,18 @@ begin dlgFilterAll, GetAllFilesMask]); if Dlg.Execute then begin - LoadComponentIcon(Dlg.FileName); + IconGUI.LoadIcon(LazPackage, Dlg.FileName); + // Load high resolution icons automatically if found. + if Btn = IconNormBitBtn then begin + // 150% + OtherIconFile:=RelatedIconFile('_150'); + if FileExists(OtherIconFile) then + fIcon150GUI.LoadIcon(LazPackage, OtherIconFile); + // 200% + OtherIconFile:=RelatedIconFile('_200'); + if FileExists(OtherIconFile) then + fIcon200GUI.LoadIcon(LazPackage, OtherIconFile); + end; end; InputHistories.StoreFileDialogSettings(Dlg); finally @@ -263,42 +368,51 @@ end; procedure TAddToPackageDlg.ComponentUnitFileBrowseButtonClick(Sender: TObject); var - SaveDialog: TSaveDialog; - AFilename: string; + DirDialog: TSelectDirectoryDialog; begin - SaveDialog:=TSaveDialog.Create(nil); + DirDialog:=TSelectDirectoryDialog.Create(nil); try - InputHistories.ApplyFileDialogSettings(SaveDialog); - SaveDialog.InitialDir := LazPackage.GetFileDialogInitialDir(SaveDialog.InitialDir); - SaveDialog.Title := lisSaveAs; - SaveDialog.Options := SaveDialog.Options+[ofPathMustExist]; - SaveDialog.Filter := Format('%s|*.pas;*.pp', [dlgFilterPascalFile]); - if SaveDialog.Execute then begin - AFilename := CleanAndExpandFilename(SaveDialog.Filename); - if FilenameIsPascalUnit(AFilename) then begin - LazPackage.ShortenFilename(AFilename,true); - ComponentUnitFileEdit.Text := AFilename; - end else begin - IDEMessageDialog(lisA2PInvalidFile, - lisA2PAPascalUnitMustHaveTheExtensionPPOrPas, - mtError,[mbCancel]); - end; + InputHistories.ApplyFileDialogSettings(DirDialog); + DirDialog.InitialDir:=LazPackage.Directory; + DirDialog.Title:=lisA2PDirectoryForUnitFile; + //DirDialog.Options:=DirDialog.Options+[ofPathMustExist]; + //DirDialog.Filter:=Format('%s|*.pas;*.pp', [dlgFilterPascalFile]); + if DirDialog.Execute then begin + UnitDirectoryEdit.Text:=DirDialog.Filename; + UnitFilenameLabel.Caption:=AppendPathDelim(UnitDirectoryEdit.Text)+GenerateUnitFileName; end; - InputHistories.StoreFileDialogSettings(SaveDialog); + InputHistories.StoreFileDialogSettings(DirDialog); finally - SaveDialog.Free; + DirDialog.Free; end; end; procedure TAddToPackageDlg.ComponentUnitFileShortenButtonClick(Sender: TObject); +var + S: string; begin - if ''=ComponentUnitFileEdit.Text then exit; - ComponentUnitFileEdit.Text:=SwitchRelativeAbsoluteFilename(ComponentUnitFileEdit.Text); + Assert(LazPackage.HasDirectory and FilenameIsAbsolute(LazPackage.Directory), + 'Unexpected package directory'); + S:=UnitDirectoryEdit.Text; + if (S='') then + S:='.'; + // Toggle between absolute and relative paths. + if FilenameIsAbsolute(S) then + UnitDirectoryEdit.Text:=CreateRelativePath(S,LazPackage.Directory,True) + else + UnitDirectoryEdit.Text:=CreateAbsolutePath(S,LazPackage.Directory); + UnitFilenameLabel.Caption:=AppendPathDelim(UnitDirectoryEdit.Text)+GenerateUnitFileName; end; -procedure TAddToPackageDlg.ComponentUnitNameEditChange(Sender: TObject); +procedure TAddToPackageDlg.UnitDirectoryEditChange(Sender: TObject); +begin + UnitFilenameLabel.Caption:=AppendPathDelim(UnitDirectoryEdit.Text)+GenerateUnitFileName; +end; + +procedure TAddToPackageDlg.UnitNameEditChange(Sender: TObject); begin CheckNewCompOk; + UnitFilenameLabel.Caption:=AppendPathDelim(UnitDirectoryEdit.Text)+GenerateUnitFileName; end; procedure TAddToPackageDlg.NewComponentButtonClick(Sender: TObject); @@ -306,6 +420,7 @@ var PkgFile: TPkgFile; PkgComponent: TPkgComponent; ARequiredPackage: TLazPackage; + ThePath: String; begin fParams.Clear; fParams.FileType:=pftUnit; @@ -313,10 +428,21 @@ begin fParams.AncestorType:=AncestorComboBox.Text; fParams.NewClassName:=ClassNameEdit.Text; fParams.PageName:=PalettePageCombobox.Text; - fParams.Unit_Name:=ComponentUnitNameEdit.Text; - fParams.UnitFilename:=ComponentUnitFileEdit.Text; + fParams.Unit_Name:=UnitNameEdit.Text; fParams.UsedUnitname:=''; - fParams.IconFile:=FComponentIconFilename; + fParams.IconNormFile:=fIconNormGUI.Filename; + fParams.Icon150File:=fIcon150GUI.Filename; + fParams.Icon200File:=fIcon200GUI.Filename; + + // prepend path to unit filename + ThePath:=UnitDirectoryEdit.Text; + if ThePath='' then + ThePath:='.'; + ThePath:=CreateAbsolutePath(ThePath,LazPackage.Directory); + if not DirectoryExists(ThePath) then + if not ForceDirectories(ThePath) then + raise Exception.Create('NewComponentButtonClick: Cannot create directory '+ThePath); + fParams.UnitFilename:=AppendPathDelim(ThePath)+GenerateUnitFileName; // check Ancestor Type if not IsValidIdent(fParams.AncestorType) then begin @@ -325,7 +451,6 @@ begin mtError,[mbCancel]); exit; end; - // check pagename if length(fParams.PageName)>100 then begin IDEMessageDialog(lisA2PPageNameTooLong, @@ -333,16 +458,6 @@ begin mtError,[mbCancel]); exit; end; - - // check unitname - filename redundancy - if CompareText(fParams.Unit_name,ExtractFileNameOnly(fParams.UnitFilename))<>0 - then begin - IDEMessageDialog(lisA2PUnitNameInvalid, - Format(lisA2PTheUnitNameDoesNotCorrespondToTheFilename, [fParams.Unit_Name]), - mtError,[mbCancel]); - exit; - end; - // check classname if not IsValidIdent(fParams.NewClassName) then begin IDEMessageDialog(lisA2PInvalidClassName, @@ -350,7 +465,6 @@ begin mtError,[mbCancel]); exit; end; - // check classname<>ancestortype if CompareText(fParams.NewClassName,fParams.AncestorType)=0 then begin IDEMessageDialog(lisA2PInvalidCircularDependency, @@ -358,7 +472,6 @@ begin mtError,[mbCancel]); exit; end; - // check ancestor type is not unitname PkgFile:=PackageGraph.FindUnit(LazPackage,fParams.AncestorType,true,true); if PkgFile<>nil then begin @@ -369,7 +482,6 @@ begin then exit; end; - // check classname does not interfere with an existing unitname PkgFile:=PackageGraph.FindUnit(LazPackage,fParams.NewClassName,true,true); if PkgFile<>nil then begin @@ -380,7 +492,6 @@ begin then exit; end; - // check if classname already exists PkgComponent:=TPkgComponent(IDEComponentPalette.FindComponent(fParams.NewClassname)); if PkgComponent<>nil then begin @@ -391,7 +502,6 @@ begin then exit; end; - // check filename if not CheckAddingPackageUnit(LazPackage, d2ptNewComponent, OnGetIDEFileInfo, fParams.UnitFilename) then exit; @@ -403,7 +513,7 @@ begin ARequiredPackage:=PkgComponent.PkgFile.LazPackage; ARequiredPackage:=TLazPackage(PackageEditingInterface.RedirectPackageDependency(ARequiredPackage)); if (LazPackage<>ARequiredPackage) - and (not LazPackage.Requires(PkgComponent.PkgFile.LazPackage)) + and not LazPackage.Requires(PkgComponent.PkgFile.LazPackage) then fParams.Dependency:=ARequiredPackage.CreateDependencyWithOwner(nil); end; @@ -421,7 +531,7 @@ end; function TAddToPackageDlg.CheckNewCompOk: Boolean; begin - Result:=(AncestorComboBox.Text<>'') and (ClassNameEdit.Text<>'') and (ComponentUnitNameEdit.Text<>''); + Result:=(AncestorComboBox.Text<>'') and (ClassNameEdit.Text<>'') and (UnitNameEdit.Text<>''); ButtonPanel1.OKButton.Enabled:=Result; end; @@ -431,22 +541,28 @@ begin fPkgComponents.Add(PkgComponent); end; +function TAddToPackageDlg.GenerateUnitFileName: string; +begin + Result:=UnitNameEdit.Text; + if Result='' then Exit; + if EnvironmentOptions.CharcaseFileAction in [ccfaAsk, ccfaAutoRename] then + Result:=LowerCase(Result); + // append pascal file extension + Result:=Result+PascalExtension[EnvironmentOptions.PascalFileExtension]; +end; + procedure TAddToPackageDlg.AutoCompleteNewComponent; var PkgComponent: TPkgComponent; begin - fLastNewComponentAncestorType:=AncestorComboBox.Text; - if not IsValidIdent(fLastNewComponentAncestorType) then exit; - PkgComponent:=TPkgComponent( - IDEComponentPalette.FindComponent(fLastNewComponentAncestorType)); + fLastNewAncestorType:=AncestorComboBox.Text; + if not IsValidIdent(fLastNewAncestorType) then exit; + PkgComponent:=TPkgComponent(IDEComponentPalette.FindComponent(fLastNewAncestorType)); // create unique classname - if not IsValidIdent(ClassNameEdit.Text) then - ClassNameEdit.Text:=IDEComponentPalette.CreateNewClassName( - fLastNewComponentAncestorType); + ClassNameEdit.Text:=IDEComponentPalette.CreateNewClassName(fLastNewAncestorType); // choose the same page name - if (PalettePageCombobox.Text='') - and (PkgComponent<>nil) and (PkgComponent.RealPage<>nil) then + if (PkgComponent<>nil) and (PkgComponent.RealPage<>nil) then PalettePageCombobox.Text:=PkgComponent.RealPage.PageName; // filename AutoCompleteNewComponentUnitName; @@ -461,73 +577,19 @@ var begin // check if update needed CurClassName:=ClassNameEdit.Text; - if fLastNewComponentClassName=CurClassName then exit; - fLastNewComponentClassName:=CurClassName; - + if fLastNewClassName=CurClassName then exit; + fLastNewClassName:=CurClassName; // check classname if not IsValidIdent(CurClassName) then exit; - // create unitname NewUnitName:=CurClassName; if NewUnitName[1]='T' then NewUnitName:=copy(NewUnitName,2,length(NewUnitName)-1); NewUnitName:=PackageGraph.CreateUniqueUnitName(NewUnitName); - ComponentUnitNameEdit.Text:=NewUnitName; - - // create filename - NewFileName:=NewUnitName; - - if EnvironmentOptions.CharcaseFileAction in [ccfaAsk, ccfaAutoRename] then - NewFileName:=lowercase(NewFileName); - - // append pascal file extension - NewFileName:=NewFileName - +EnvironmentOpts.PascalExtension[EnvironmentOptions.PascalFileExtension]; - // prepend path - if LazPackage.HasDirectory then - NewFileName:=LazPackage.Directory+NewFileName; - ComponentUnitFileEdit.Text:=NewFileName; -end; - -function TAddToPackageDlg.SwitchRelativeAbsoluteFilename(const Filename: string): string; -begin - Result:=Filename; - if (not LazPackage.HasDirectory) - or (not FilenameIsAbsolute(LazPackage.Directory)) then exit; - if FilenameIsAbsolute(Filename) then - Result:=TrimFilename(CreateRelativePath(Filename,LazPackage.Directory)) - else - Result:=TrimFilename(CreateAbsoluteSearchPath(Filename,LazPackage.Directory)); -end; - -procedure TAddToPackageDlg.LoadComponentIcon(AFilename: string); -var - ShortFilename: String; - Image: TImage; -begin - try - Image:=TImage.Create(nil); - try - Image.Picture.LoadFromFile(AFilename); - ComponentIconBitBtn.Glyph.Assign(Image.Picture.Graphic); - ShortFilename:=AFilename; - LazPackage.ShortenFilename(ShortFilename,true); - LabelIconInfo.Caption:= Format('%s (%dx%d)', - [ShortFilename, ComponentIconBitBtn.Glyph.Width, ComponentIconBitBtn.Glyph.Height]); - FComponentIconFilename:=AFilename; - finally - Image.Free; - end; - except - on E: Exception do begin - IDEMessageDialog(lisCCOErrorCaption, - Format(lisErrorLoadingFile2,[AFilename]) + LineEnding + E.Message, - mtError, [mbCancel]); - ComponentIconBitBtn.Glyph.Clear; - FComponentIconFilename:=''; - LabelIconInfo.Caption:=lisNoneClickToChooseOne; - end; - end; + UnitNameEdit.Text:=NewUnitName; + // default directory + UnitDirectoryEdit.Text:=LazPackage.Directory; + UnitFilenameLabel.Caption:=AppendPathDelim(UnitDirectoryEdit.Text)+GenerateUnitFileName; end; procedure TAddToPackageDlg.UpdateAvailableAncestorTypes; @@ -584,7 +646,7 @@ end; procedure TAddToPkgResult.Clear; begin - Dependency:=nil; + FreeAndNil(Dependency); UnitFilename:=''; Unit_Name:=''; AncestorType:=''; @@ -601,6 +663,7 @@ end; destructor TAddToPkgResult.Destroy; begin FreeThenNil(Next); + FreeAndNil(Dependency); inherited Destroy; end; diff --git a/packager/packageeditor.pas b/packager/packageeditor.pas index a91ea0bc2b..2f8a462e96 100644 --- a/packager/packageeditor.pas +++ b/packager/packageeditor.pas @@ -2150,8 +2150,7 @@ var if (AddParams.Dependency<>nil) and (not PkgDependsOn(AddParams.Dependency.PackageName)) then PackageGraph.AddDependencyToPackage(LazPackage,AddParams.Dependency); - if (AddParams.IconFile<>'') - and (not PkgDependsOn('LCL')) then + if (AddParams.IconNormFile<>'') and (not PkgDependsOn('LCL')) then PackageGraph.AddDependencyToPackage(LazPackage,PackageGraph.LCLPackage); PackageEditors.DeleteAmbiguousFiles(LazPackage,AddParams.UnitFilename); // open file in editor diff --git a/packager/pkgmanager.pas b/packager/pkgmanager.pas index 19419cbbf6..67a8c12aa6 100644 --- a/packager/pkgmanager.pas +++ b/packager/pkgmanager.pas @@ -39,6 +39,7 @@ interface {$I ide.inc} +{$DEFINE UseLRS} {off $DEFINE VerbosePkgEditDrag} uses @@ -121,7 +122,6 @@ type out HasRegisterProc: boolean); function PackageGraphCheckInterPkgFiles(IDEObject: TObject; PkgList: TFPList; out FilesChanged: boolean): boolean; - // package graph function PackageGraphExplorerOpenPackage(Sender: TObject; APackage: TLazPackage): TModalResult; @@ -138,7 +138,6 @@ type procedure PackageGraphEndUpdate(Sender: TObject; GraphChanged: boolean); procedure PackageGraphFindFPCUnit(const AUnitName, Directory: string; var Filename: string); - // menu procedure MainIDEitmPkgOpenPackageFileClick(Sender: TObject); procedure MainIDEitmPkgPkgGraphClick(Sender: TObject); @@ -177,6 +176,9 @@ type private // helper functions FLastLazarusSrcDir: string; + {$IFDEF UseLRS} + FIconLRSSource: string; + {$ENDIF} function DoShowSavePackageAsDialog(APackage: TLazPackage): TModalResult; function CheckPackageGraphForCompilation(APackage: TLazPackage; FirstDependency: TPkgDependency; @@ -192,6 +194,7 @@ type procedure LoadAutoInstallPackages; procedure AddUnitToProjectMainUsesSection(AProject: TProject; const AnUnitName, AnUnitInFilename: string); + procedure AddToIconResource(const aIconFile, aResName: string); // move files function CheckDrag(Sender, Source: TObject; X, Y: Integer; out SrcFilesEdit, TargetFilesEdit: IFilesEditorInterface; @@ -721,6 +724,48 @@ begin Result:=DoCreatePackageFpmakefile(APackage,false); end; +{$IFDEF UseLRS} +procedure TPkgManager.AddToIconResource(const aIconFile, aResName: string); +var + BinFileStream: TFileStreamUTF8; + ResMemStream: TMemoryStream; + BinExt, ResType, S: String; + Len: integer; +begin + try + BinFileStream:=TFileStreamUTF8.Create(aIconFile,fmOpenRead); + try + ResMemStream:=TMemoryStream.Create; + try + Assert(BinFileStream.Position=0, 'TPkgManager.AddToIconResource: Stream.Position > 0'); + BinExt:=UpperCase(ExtractFileExt(aIconFile)); + ResType:=Copy(BinExt,2,length(BinExt)-1); + BinaryToLazarusResourceCode(BinFileStream,ResMemStream,aResName,ResType); + ResMemStream.Position:=0; + Len:=ResMemStream.Size; + if Len>0 then begin + SetLength(S,Len); + ResMemStream.Read(S[1],Len); + end; + FIconLRSSource:=FIconLRSSource+S; + finally + ResMemStream.Free; + end; + finally + BinFileStream.Free; + end; + except + on E: Exception do begin + MessageDlg(lisCCOErrorCaption, + Format(lisErrorLoadingFile2,[aIconFile]) + LineEnding + E.Message, + mtError, [mbCancel], 0); + end; + end; +end; +{$ELSE} + ToDo: Use FPC's resource type (.res) +{$ENDIF} + function TPkgManager.OnPackageEditorCreateFile(Sender: TObject; Params: TAddToPkgResult): TModalResult; var @@ -729,73 +774,44 @@ var NewSource: String; UnitDirectives: String; IconLRSFilename: String; - BinFileStream: TFileStreamUTF8; - BinMemStream: TMemoryStream; - BinExt: String; - ResType: String; ResName: String; - ResMemStream: TMemoryStream; CodeBuf: TCodeBuffer; begin Result:=mrCancel; - // create icon resource - IconLRSFilename:=''; - if Params.IconFile<>'' then begin + if Params.IconNormFile<>'' then + begin IconLRSFilename:=ChangeFileExt(Params.UnitFilename,'')+'_icon.lrs'; CodeBuf:=CodeToolBoss.CreateFile(IconLRSFilename); if CodeBuf=nil then begin debugln(['Error: (lazarus) [TPkgManager.OnPackageEditorCreateFile] file create failed: ',IconLRSFilename]); exit; end; - try - BinFileStream:=TFileStreamUTF8.Create(Params.IconFile,fmOpenRead); - try - BinMemStream:=TMemoryStream.Create; - ResMemStream:=TMemoryStream.Create; - try - BinMemStream.CopyFrom(BinFileStream,BinFileStream.Size); - BinMemStream.Position:=0; - BinExt:=uppercase(ExtractFileExt(Params.IconFile)); - ResType:=copy(BinExt,2,length(BinExt)-1); - ResName:=ExtractFileNameOnly(Params.NewClassName); - BinaryToLazarusResourceCode(BinMemStream,ResMemStream,ResName,ResType); - ResMemStream.Position:=0; - CodeBuf.LoadFromStream(ResMemStream); - Result:=SaveCodeBuffer(CodeBuf); - if Result<>mrOk then exit; - finally - BinMemStream.Free; - ResMemStream.Free; - end; - finally - BinFileStream.Free; - end; - except - on E: Exception do begin - MessageDlg(lisCCOErrorCaption, - Format(lisErrorLoadingFile2,[Params.IconFile]) + LineEnding + E.Message, - mtError, [mbCancel], 0); - end; - end; - end; - - // create sourcecode - LE:=LineEnding; - if PackageGraph.FindDependencyRecursively(Params.Pkg.FirstRequiredDependency, - 'LCL')<>nil - then - UsesLine:='Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs' + FIconLRSSource:=''; + ResName:=ExtractFileNameOnly(Params.NewClassName); + AddToIconResource(Params.IconNormFile, ResName); + if Params.Icon150File<>'' then + AddToIconResource(Params.Icon150File, ResName+'_150'); + if Params.Icon200File<>'' then + AddToIconResource(Params.Icon200File, ResName+'_200'); + CodeBuf.Source:=FIconLRSSource; + Result:=SaveCodeBuffer(CodeBuf); + if Result<>mrOk then exit; + end else - UsesLine:='Classes, SysUtils'; - if (System.Pos(Params.UsedUnitname,UsesLine)<1) - and (Params.UsedUnitname<>'') then + IconLRSFilename:=''; + // create sourcecode + UsesLine:='Classes, SysUtils'; + if PackageGraph.FindDependencyRecursively(Params.Pkg.FirstRequiredDependency,'LCL')<>nil + then + UsesLine:=UsesLine+', LResources, Forms, Controls, Graphics, Dialogs'; + if (System.Pos(Params.UsedUnitname,UsesLine)<1) and (Params.UsedUnitname<>'') then UsesLine:=UsesLine+', '+Params.UsedUnitname; UnitDirectives:='{$mode objfpc}{$H+}'; if Params.Pkg<>nil then UnitDirectives:=TFileDescPascalUnit.CompilerOptionsToUnitDirectives( Params.Pkg.CompilerOptions); - + LE:=LineEnding; NewSource:= 'unit '+Params.Unit_Name+';'+LE +LE