paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-20 13:19:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

IDE: Fix adding resource with same name but different extension. Issue #26813, patch from Denis Volodarsky.

Browse Source 
git-svn-id: trunk@46513 -
This commit is contained in:
juha 2014-10-11 07:42:05 +00:00
parent fa27e75356
commit 61b3247fd5
3 changed files with 184 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
ide/frames/project_resources_options.lfm
View File

@ -6,8 +6,8 @@ object ResourcesOptionsFrame: TResourcesOptionsFrame
ClientHeight = 330
ClientWidth = 742
TabOrder = 0
DesignLeft = 561
DesignTop = 308
DesignLeft = 735
DesignTop = 393
object lbResources: TListView
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = ToolBar1
@ -36,10 +36,12 @@ object ResourcesOptionsFrame: TResourcesOptionsFrame
Width = 326
end>
HideSelection = False
ReadOnly = True
RowSelect = True
TabOrder = 0
ViewStyle = vsReport
OnInsert = lbResourcesInsert
OnKeyDown = lbResourcesKeyDown
OnSelectItem = lbResourcesSelectItem
end
object ToolBar1: TToolBar

215
ide/frames/project_resources_options.pas
View File

@ -32,16 +32,30 @@ type
procedure btnDeleteClick(Sender: TObject);
procedure cbResourceTypeChange(Sender: TObject);
procedure edResourceNameEditingDone(Sender: TObject);
procedure edResourceNameKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure edResourceNameKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure lbResourcesInsert(Sender: TObject; Item: TListItem);
procedure lbResourcesSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure lbResourcesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure lbResourcesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
private
FProject: TProject;
procedure AddResource(AFileName: String);
procedure AddResourceItem(ResFile: String; ResType: TUserResourceType; ResName: String);
private
FAddResourceItemDuplicates: integer;
FResourceNameList: TStringList; // to keep resource names unique
FResourceFileNameList: TStringList; // to keep resource file names unique
// Used to know what was resource name before editing.
FCurrentResName: string;
// Begin adding resources.
procedure AddResourceBegin;
// Try to add resource. Result is false if resource is duplicate.
function AddResource(AFileName: String): boolean;
// Finish adding resources. If there were duplicate resources message will be shown.
procedure AddResourceEnd;
// Try to add resource item. Result is false if resource is duplicate.
function AddResourceItem(ResFile: String; ResType: TUserResourceType; ResName: String): boolean;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetTitle: string; override;
procedure Setup(ADialog: TAbstractOptionsEditorDialog); override;
procedure ReadSettings(AOptions: TAbstractIDEOptions); override;
@ -53,6 +67,10 @@ implementation
{$R *.lfm}
const
LVSUBITEM_TYPE = 0;
LVSUBITEM_NAME = 1;
{ TResourcesOptionsFrame }
procedure TResourcesOptionsFrame.btnAddClick(Sender: TObject);
@ -60,14 +78,20 @@ var
FileName: String;
aFilename: String;
begin
if dlgOpen.Execute then
if dlgOpen.Execute() and (dlgOpen.Files.Count <> 0) then
begin
for FileName in dlgOpen.Files do
begin
aFilename := Filename;
if not FProject.IsVirtual then
aFileName := CreateRelativePath(aFileName, FProject.ProjectDirectory);
AddResource(aFileName);
AddResourceBegin;
try
for FileName in dlgOpen.Files do
begin
aFilename := Filename;
if not FProject.IsVirtual then
aFileName := CreateRelativePath(aFileName, FProject.ProjectDirectory);
AddResource(aFileName);
end;
finally
AddResourceEnd;
end;
end;
end;
@ -75,27 +99,65 @@ end;
procedure TResourcesOptionsFrame.btnClearClick(Sender: TObject);
begin
if IDEMessageDialog(lisConfirmDelete, rsResourceClear, mtConfirmation, [mbYes, mbNo]) = mrYes then
begin
lbResources.Items.Clear;
FResourceNameList.Clear;
FResourceFileNameList.Clear;
end;
btnClear.Enabled := lbResources.Items.Count > 0;
end;
procedure TResourcesOptionsFrame.btnDeleteClick(Sender: TObject);
var
resName, resFileName: String;
begin
if Assigned(lbResources.Selected) then
begin
resName := lbResources.Selected.SubItems[LVSUBITEM_NAME];
resFileName := lbResources.Selected.Caption;
FResourceNameList.Delete(FResourceNameList.IndexOf(resName));
FResourceFileNameList.Delete(FResourceFileNameList.IndexOf(resFileName));
lbResources.Items.Delete(lbResources.Selected.Index);
end;
btnClear.Enabled := lbResources.Items.Count > 0;
end;
procedure TResourcesOptionsFrame.cbResourceTypeChange(Sender: TObject);
begin
if Assigned(lbResources.Selected) then
lbResources.Selected.SubItems[0] := ResourceTypeToStr[TUserResourceType(cbResourceType.ItemIndex)];
lbResources.Selected.SubItems[LVSUBITEM_TYPE] := ResourceTypeToStr[TUserResourceType(cbResourceType.ItemIndex)];
end;
procedure TResourcesOptionsFrame.edResourceNameEditingDone(Sender: TObject);
var
newResName: string;
begin
if Assigned(lbResources.Selected) then
lbResources.Selected.SubItems[1] := edResourceName.Text;
begin
newResName := edResourceName.Text;
// Exit if resName wasn't changed.
if newResName = FCurrentResName then
exit;
// Check if new name is unique.
if FResourceNameList.IndexOf(newResName) <> -1 then
begin
// If new name is not unique show message and restore edited name.
ShowMessage(lisResourceNameMustBeUnique);
edResourceName.Text := FCurrentResName;
edResourceName.SetFocus; // assume user want to continue editing
exit;
end;
// Remove old name.
FResourceNameList.Delete(FResourceNameList.IndexOf(FCurrentResName));
// Add new name.
FResourceNameList.Add(newResName);
// Update in list view.
lbResources.Selected.SubItems[LVSUBITEM_NAME] := newResName;
// Update current name.
FCurrentResName := newResName;
end;
end;
procedure TResourcesOptionsFrame.edResourceNameKeyDown(Sender: TObject;
@ -103,58 +165,130 @@ procedure TResourcesOptionsFrame.edResourceNameKeyDown(Sender: TObject;
begin
if Key = VK_RETURN then
begin
edResourceName.EditingDone;
// Shouldn't call edResourceName.EditingDone because when control will lose
// focus it will call EditingDone one more time.
// Instead set focus to list view.
lbResources.SetFocus;
Key := 0;
end;
end;
procedure TResourcesOptionsFrame.lbResourcesInsert(Sender: TObject;
Item: TListItem);
procedure TResourcesOptionsFrame.lbResourcesInsert(Sender: TObject; Item: TListItem);
begin
btnClear.Enabled := lbResources.Items.Count > 0;
end;
procedure TResourcesOptionsFrame.lbResourcesKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
case Key of
VK_INSERT:
btnAddClick(nil);
VK_DELETE:
btnDeleteClick(nil);
end;
end;
procedure TResourcesOptionsFrame.lbResourcesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
begin
btnDelete.Enabled := Assigned(lbResources.Selected);
edResourceName.Enabled := Assigned(lbResources.Selected);
if edResourceName.Enabled then
edResourceName.Text := lbResources.Selected.SubItems[1]
edResourceName.Text := lbResources.Selected.SubItems[LVSUBITEM_NAME]
else
edResourceName.Text := '';
FCurrentResName := edResourceName.Text;
cbResourceType.Enabled := Assigned(lbResources.Selected);
if cbResourceType.Enabled then
cbResourceType.ItemIndex := Ord(StrToResourceType(lbResources.Selected.SubItems[0]))
cbResourceType.ItemIndex := Ord(StrToResourceType(lbResources.Selected.SubItems[LVSUBITEM_TYPE]))
else
cbResourceType.ItemIndex := -1;
end;
procedure TResourcesOptionsFrame.AddResourceItem(ResFile: String; ResType: TUserResourceType; ResName: String);
var
Item: TListItem;
procedure TResourcesOptionsFrame.AddResourceBegin;
begin
Item := lbResources.Items.Add;
Item.Caption := ResFile;
Item.SubItems.Add(ResourceTypeToStr[ResType]);
Item.SubItems.Add(ResName);
// Initialize duplicated resource counter.
FAddResourceItemDuplicates := 0;
end;
procedure TResourcesOptionsFrame.AddResource(AFileName: String);
function TResourcesOptionsFrame.AddResource(AFileName: String): boolean;
var
ResName, Ext: String;
begin
Ext := UTF8UpperCase(ExtractFileExt(AFileName));
ResName := UTF8UpperCase(ExtractFileNameOnly(AFileName));
case Ext of
'.BMP': AddResourceItem(AFileName, rtBitmap, ResName);
'.CUR': AddResourceItem(AFileName, rtCursor, ResName);
'.ICO': AddResourceItem(AFileName, rtIcon, ResName);
//'.FNT', '.FON', '.TTF': AddResourceItem(AFileName, rtFont, ResName);
'.BMP': Result := AddResourceItem(AFileName, rtBitmap, ResName);
'.CUR': Result := AddResourceItem(AFileName, rtCursor, ResName);
'.ICO': Result := AddResourceItem(AFileName, rtIcon, ResName);
//'.FNT', '.FON', '.TTF': Result := AddResourceItem(AFileName, rtFont, ResName);
else
AddResourceItem(AFileName, rtRCData, ResName);
Result := AddResourceItem(AFileName, rtRCData, ResName);
end;
end;
procedure TResourcesOptionsFrame.AddResourceEnd;
begin
if FAddResourceItemDuplicates <> 0 then
begin
ShowMessageFmt(lisFailedToAddNNotUniqueResources, [FAddResourceItemDuplicates]);
FAddResourceItemDuplicates := 0;
end;
end;
function TResourcesOptionsFrame.AddResourceItem(ResFile: String;
ResType: TUserResourceType; ResName: String): boolean;
var
Item: TListItem;
begin
if FResourceFileNameList.IndexOf(ResFile) <> -1 then
begin
// Such file name is already in list.
// Ignore adding.
exit(true);
end;
if FResourceNameList.IndexOf(ResName) <> -1 then
begin
// Such res. name already exists.
// Don't add it twice.
inc(FAddResourceItemDuplicates);
exit(false);
end;
Item := lbResources.Items.Add;
Item.Caption := ResFile; // path
Item.SubItems.Add(ResourceTypeToStr[ResType]); // type
Item.SubItems.Add(ResName); // name
FResourceFileNameList.Add(ResFile);
FResourceNameList.Add(ResName);
exit(true);
end;
constructor TResourcesOptionsFrame.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FResourceNameList := TStringList.Create;
FResourceNameList.Sorted := True;
FResourceNameList.Duplicates := dupError;
FResourceFileNameList := TStringList.Create;
FResourceFileNameList.Sorted := True;
FResourceFileNameList.Duplicates := dupError;
end;
destructor TResourcesOptionsFrame.Destroy;
begin
FResourceNameList.Free;
FResourceFileNameList.Free;
inherited Destroy;
end;
function TResourcesOptionsFrame.GetTitle: string;
begin
Result := dlgPOResources;
@ -193,12 +327,17 @@ begin
FProject := (AOptions as TProjectIDEOptions).Project;
lbResources.Items.Clear;
List := FProject.ProjResources.UserResources.List;
lbResources.Items.BeginUpdate;
AddResourceBegin;
try
for I := 0 to List.Count - 1 do
AddResourceItem(List[I]^.FileName, List[I]^.ResType, List[I]^.ResName);
lbResources.Items.BeginUpdate;
try
for I := 0 to List.Count - 1 do
AddResourceItem(List[I]^.FileName, List[I]^.ResType, List[I]^.ResName);
finally
lbResources.Items.EndUpdate;
end;
finally
lbResources.Items.EndUpdate;
AddResourceEnd;
end;
btnClear.Enabled := lbResources.Items.Count > 0;
end;
@ -212,7 +351,7 @@ 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[0]), lbResources.Items[I].SubItems[1]);
StrToResourceType(lbResources.Items[I].SubItems[LVSUBITEM_TYPE]), lbResources.Items[I].SubItems[LVSUBITEM_NAME]);
end;
class function TResourcesOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;

5
ide/lazarusidestrconsts.pas
View File

@ -135,6 +135,8 @@ resourcestring
lrsRescanLplFiles = 'Rescan lpl files';
lrsPLDDeleteSelected = 'Delete selected';
lisRenameShowResult = 'Show list of renamed Identifiers';
lisResourceNameMustBeUnique = 'Resource name must be unique';
lisFailedToAddNNotUniqueResources = 'Failed to add %d not unique resource(s)';
// errors
lisErrInvalidOption = 'Invalid option at position %d: "%s"';
@ -152,8 +154,7 @@ resourcestring
lisSkipLoadingLastProject = 'Skip loading last project';
lisOverrideLanguage = 'Override language. For example --language=de.'+
' For possible values see files in the languages directory.';
lissecondaryConfigDirectoryWhereLazarusSearchesFor =
'secondary config '+
lissecondaryConfigDirectoryWhereLazarusSearchesFor = 'secondary config '+
'directory, where Lazarus searches for config template files. Default is ';
lisFileWhereDebugOutputIsWritten =
'file, where debug output is written to. If it is '+