IDE: Support 3 icons with different resolutions in "New Component" dialog. Improve the GUI.

git-svn-id: trunk@59170 -
This commit is contained in:
juha 2018-09-26 17:49:33 +00:00
parent 571647e302
commit 24f8569925
5 changed files with 443 additions and 276 deletions

View File

@ -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)';

View File

@ -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

View File

@ -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;

View File

@ -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

View File

@ -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