mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-27 19:20:17 +02:00
implemented favourite properties for ObjectInspector
git-svn-id: trunk@7072 -
This commit is contained in:
mattias
parent
5a6ae1d91c
commit
a81cc46219
@ -173,6 +173,7 @@ end;
|
||||
|
||||
procedure TdlgSelectPrinter.tkbPriorityCHANGE(Sender: TObject);
|
||||
begin
|
||||
if Sender=nil then ;
|
||||
edPriority.Value:=tkbPriority.Position;
|
||||
end;
|
||||
|
||||
@ -365,6 +366,7 @@ end;
|
||||
//Initialization of screen
|
||||
procedure TdlgSelectPrinter.dlgSelectPrinterSHOW(Sender: TObject);
|
||||
begin
|
||||
if Sender=nil then ;
|
||||
NbOpts.PageIndex:=0;
|
||||
|
||||
//Printers
|
||||
@ -377,6 +379,7 @@ end;
|
||||
|
||||
procedure TdlgSelectPrinter.cbTasktimeCHANGE(Sender: TObject);
|
||||
begin
|
||||
if Sender=nil then ;
|
||||
//Time is active if last item is selected
|
||||
edTimeTask.Enabled:=(cbTaskTime.ItemIndex=cbTaskTime.Items.Count-1);
|
||||
edTimeTask.Text:=FormatDateTime('hh:nn:ss',Now);
|
||||
@ -384,6 +387,7 @@ end;
|
||||
|
||||
procedure TdlgSelectPrinter.dlgSelectPrinterCREATE(Sender: TObject);
|
||||
begin
|
||||
if Sender=nil then ;
|
||||
fPropertiesSetting:=False;
|
||||
end;
|
||||
|
||||
@ -391,6 +395,7 @@ end;
|
||||
procedure TdlgSelectPrinter.cbReverseCLICK(Sender: TObject);
|
||||
Var St : string;
|
||||
begin
|
||||
if Sender=nil then ;
|
||||
St:='collate';
|
||||
If not cbCollate.Checked then
|
||||
St:='un'+St;
|
||||
@ -404,6 +409,7 @@ end;
|
||||
|
||||
procedure TdlgSelectPrinter.cbPrintersKEYPRESS(Sender: TObject; var Key: Char);
|
||||
begin
|
||||
if Sender=nil then ;
|
||||
Key:=#0;
|
||||
end;
|
||||
|
||||
@ -411,6 +417,7 @@ end;
|
||||
//if it's 1 then "Less ..."
|
||||
procedure TdlgSelectPrinter.btnReducCLICK(Sender: TObject);
|
||||
begin
|
||||
if Sender=nil then ;
|
||||
if btnReduc.Tag=1 then
|
||||
begin
|
||||
btnReduc.Tag:=0;
|
||||
@ -427,6 +434,7 @@ end;
|
||||
|
||||
procedure TdlgSelectPrinter.btnPrintCLICK(Sender: TObject);
|
||||
begin
|
||||
if Sender=nil then ;
|
||||
InitPrinterOptions;
|
||||
end;
|
||||
|
||||
@ -434,6 +442,7 @@ end;
|
||||
procedure TdlgSelectPrinter.btnPropCLICK(Sender: TObject);
|
||||
var Dlg : Tdlgpropertiesprinter;
|
||||
begin
|
||||
if Sender=nil then ;
|
||||
//Set default printer
|
||||
THackCUPSPrinter(Printer).SelectCurrentPrinterOrDefault;
|
||||
|
||||
@ -451,6 +460,7 @@ end;
|
||||
|
||||
procedure TdlgSelectPrinter.cbPrintersCHANGE(Sender: TObject);
|
||||
begin
|
||||
if Sender=nil then ;
|
||||
Printer.SetPrinter(cbPrinters.Text);
|
||||
fPropertiesSetting:=False;
|
||||
RefreshInfos;
|
||||
|
||||
@ -24,11 +24,10 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, ObjectInspector, Forms, Controls, Buttons, StdCtrls,
|
||||
ExtCtrls, Dialogs,
|
||||
ConfigStorage, LazarusIDEStrConsts;
|
||||
ExtCtrls, Dialogs, LCLProc,
|
||||
FileUtil, LazConf, ConfigStorage, LazarusIDEStrConsts;
|
||||
|
||||
type
|
||||
|
||||
{ TOIAddRemoveFavouriteDlg }
|
||||
|
||||
TOIAddRemoveFavouriteDlg = class(TForm)
|
||||
@ -55,11 +54,18 @@ type
|
||||
property AddMode: Boolean read FAddMode write SetAddMode;
|
||||
end;
|
||||
|
||||
function CreateDefaultOIFavouriteProperties: TOIFavouriteProperties;
|
||||
const
|
||||
DefaultOIFavouriteConfigFilename = 'objectinspectorfavourites.xml';
|
||||
|
||||
var
|
||||
DefaultOIFavouriteProperties: TOIFavouriteProperties;
|
||||
|
||||
function ShowAddRemoveFavouriteDialog(ObjInspector: TObjectInspector;
|
||||
Add: Boolean): TModalResult;
|
||||
function CreateDefaultOIFavouriteProperties: TOIFavouriteProperties;
|
||||
function LoadOIFavouriteProperties: TOIFavouriteProperties;
|
||||
procedure SaveOIFavouriteProperties(ObjInspector: TObjectInspector);
|
||||
procedure SaveOIFavouriteProperties(Favourites: TOIFavouriteProperties);
|
||||
function GetOIFavouriteConfigFilename: string;
|
||||
|
||||
implementation
|
||||
|
||||
@ -73,13 +79,21 @@ function CreateDefaultOIFavouriteProperties: TOIFavouriteProperties;
|
||||
begin
|
||||
Result:=TOIFavouriteProperties.Create;
|
||||
// TControl
|
||||
Add(TControl,'Name');
|
||||
Add(TComponent,'Name');
|
||||
Add(TControl,'Anchors');
|
||||
Add(TControl,'Caption');
|
||||
Add(TControl,'OnClick');
|
||||
// miscellaneous
|
||||
Add(TGroupBox,'Align');
|
||||
Add(TImage,'Align');
|
||||
Add(TCustomGroupBox,'Align');
|
||||
Add(TCustomImage,'Align');
|
||||
Add(TCustomButton,'ModalResult');
|
||||
Add(TCustomLabel,'WordWrap');
|
||||
Add(TCustomEdit,'Text');
|
||||
Add(TCustomMemo,'Lines');
|
||||
Add(TCustomCheckBox,'Checked');
|
||||
Add(TCustomRadioGroup,'Items');
|
||||
Add(TCustomRadioGroup,'ItemIndex');
|
||||
Result.DeleteDoubles;
|
||||
end;
|
||||
|
||||
function ShowAddRemoveFavouriteDialog(ObjInspector: TObjectInspector;
|
||||
@ -95,14 +109,75 @@ begin
|
||||
end;
|
||||
|
||||
function LoadOIFavouriteProperties: TOIFavouriteProperties;
|
||||
var
|
||||
ConfigStore: TConfigStorage;
|
||||
begin
|
||||
Result:=CreateDefaultOIFavouriteProperties;
|
||||
// TODO: load and merge
|
||||
Result:=DefaultOIFavouriteProperties.CreateCopy;
|
||||
{$IFDEF DebugFavouriteroperties}
|
||||
debugln('LoadOIFavouriteProperties A FileExists(GetOIFavouriteConfigFilename)=',dbgs(FileExists(GetOIFavouriteConfigFilename)));
|
||||
Result.WriteDebugReport;
|
||||
{$ENDIF}
|
||||
if not FileExists(GetOIFavouriteConfigFilename) then exit;
|
||||
try
|
||||
ConfigStore:=DefaultConfigClass.Create(GetOIFavouriteConfigFilename,true);
|
||||
try
|
||||
Result.MergeConfig(ConfigStore,'ObjectInspector/Favourites/');
|
||||
Result.Modified:=false;
|
||||
finally
|
||||
ConfigStore.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
debugln('Error: LoadOIFavouriteProperties: unable to read ',
|
||||
GetOIFavouriteConfigFilename);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SaveOIFavouriteProperties(ObjInspector: TObjectInspector);
|
||||
procedure SaveOIFavouriteProperties(Favourites: TOIFavouriteProperties);
|
||||
var
|
||||
ConfigStore: TConfigStorage;
|
||||
DefaultFavourites: TOIFavouriteProperties;
|
||||
begin
|
||||
// TODO save only changes
|
||||
{$IFDEF DebugFavouriteroperties}
|
||||
debugln('SaveOIFavouriteProperties Favourites.Modified=',dbgs(Favourites.Modified),
|
||||
' FileExists(GetOIFavouriteConfigFilename)=',dbgs(FileExists(GetOIFavouriteConfigFilename)));
|
||||
{$ENDIF}
|
||||
if (not Favourites.Modified) and FileExists(GetOIFavouriteConfigFilename)
|
||||
then
|
||||
exit;
|
||||
DefaultFavourites:=CreateDefaulTOIFavouriteProperties;
|
||||
try
|
||||
if DefaultFavourites.IsEqual(Favourites) then exit;
|
||||
{$IFDEF DebugFavouriteroperties}
|
||||
debugln('SaveOIFavouriteProperties is not default');
|
||||
DefaultFavourites.WriteDebugReport;
|
||||
Favourites.WriteDebugReport;
|
||||
{$ENDIF}
|
||||
try
|
||||
ConfigStore:=DefaultConfigClass.Create(GetOIFavouriteConfigFilename,false);
|
||||
try
|
||||
Favourites.SaveNewItemsToConfig(ConfigStore,'ObjectInspector/Favourites/',
|
||||
DefaultFavourites);
|
||||
ConfigStore.WriteToDisk;
|
||||
Favourites.Modified:=false;
|
||||
finally
|
||||
ConfigStore.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
debugln('Error: LoadOIFavouriteProperties: unable to write ',
|
||||
GetOIFavouriteConfigFilename);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
DefaultFavourites.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetOIFavouriteConfigFilename: string;
|
||||
begin
|
||||
Result:=AppendPathDelim(GetPrimaryConfigPath)+DefaultOIFavouriteConfigFilename;
|
||||
end;
|
||||
|
||||
{ TOIAddRemoveFavouriteDlg }
|
||||
@ -130,7 +205,8 @@ begin
|
||||
CurClass:=CurClass.ClassParent;
|
||||
end;
|
||||
end;
|
||||
MessageDlg('Class not found','Class "'+NewClassName+'" not found.',mtError,
|
||||
MessageDlg(lisClassNotFound, Format(lisOIFClassNotFound, ['"', NewClassName,
|
||||
'"']), mtError,
|
||||
[mbOk],0);
|
||||
end;
|
||||
|
||||
@ -157,8 +233,8 @@ end;
|
||||
|
||||
procedure TOIAddRemoveFavouriteDlg.UpdateLabel;
|
||||
begin
|
||||
NoteLabel.Caption:='Choose a base class for the favourite '
|
||||
+'property "'+PropertyName+'".';
|
||||
NoteLabel.Caption:=Format(lisOIFChooseABaseClassForTheFavouriteProperty, [
|
||||
'"', PropertyName, '"']);
|
||||
end;
|
||||
|
||||
procedure TOIAddRemoveFavouriteDlg.UpdateComboBox;
|
||||
@ -172,7 +248,9 @@ begin
|
||||
CurClass:=ObjectInspector.Selection[0].ClassType;
|
||||
// add only classes, that are TPersistent and have a registered class
|
||||
while CurClass.InheritsFrom(TPersistent) do begin
|
||||
NewItems.Add(CurClass.ClassName);
|
||||
// add only registered classes
|
||||
if GetClass(CurClass.ClassName)<>nil then
|
||||
NewItems.Add(CurClass.ClassName);
|
||||
CurClass:=CurClass.ClassParent;
|
||||
end;
|
||||
end;
|
||||
@ -185,11 +263,11 @@ end;
|
||||
procedure TOIAddRemoveFavouriteDlg.UpdateMode;
|
||||
begin
|
||||
if AddMode then begin
|
||||
Caption:='Add to favourite properties';
|
||||
OkButton.Caption:='Add';
|
||||
Caption:=lisOIFAddToFavouriteProperties;
|
||||
OkButton.Caption:=lisCodeTemplAdd;
|
||||
end else begin
|
||||
Caption:='Remove from favourite properties';
|
||||
OkButton.Caption:='Remove';
|
||||
Caption:=lisOIFRemoveFromFavouriteProperties;
|
||||
OkButton.Caption:=lisExtToolRemove;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -221,7 +299,7 @@ begin
|
||||
with OkButton do begin
|
||||
Name:='AddButton';
|
||||
SetBounds(5,100,80,25);
|
||||
Caption:='Add';
|
||||
Caption:=lisCodeTemplAdd;
|
||||
Parent:=Self;
|
||||
OnClick:=@OkButtonClick;
|
||||
end;
|
||||
@ -231,7 +309,7 @@ begin
|
||||
with CancelButton do begin
|
||||
Name:='CancelButton';
|
||||
SetBounds(120,100,80,25);
|
||||
Caption:='Cancel';
|
||||
Caption:=dlgCancel;
|
||||
Parent:=Self;
|
||||
ModalResult:=mrCancel;
|
||||
end;
|
||||
@ -240,5 +318,8 @@ begin
|
||||
UpdateMode;
|
||||
end;
|
||||
|
||||
initialization
|
||||
DefaultOIFavouriteProperties:=CreateDefaultOIFavouriteProperties;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -471,6 +471,7 @@ resourcestring
|
||||
lisNOTECouldNotCreateDefineTemplateForFreePascal = 'NOTE: Could not create '
|
||||
+'Define Template for Free Pascal Sources';
|
||||
lisClassNotFound = 'Class not found';
|
||||
lisOIFClassNotFound = 'Class %s%s%s not found.';
|
||||
lisClassIsNotARegisteredComponentClassUnableToPaste = 'Class %s%s%s is not '
|
||||
+'a registered component class.%sUnable to paste.';
|
||||
lisControlNeedsParent = 'Control needs parent';
|
||||
@ -2708,6 +2709,10 @@ resourcestring
|
||||
lisNPSelectAProjectType = 'Select a project type';
|
||||
lisNPCreateANewProject = 'Create a new project';
|
||||
lisNPCreate = 'Create';
|
||||
lisOIFChooseABaseClassForTheFavouriteProperty = 'Choose a base class for '
|
||||
+'the favourite property %s%s%s.';
|
||||
lisOIFAddToFavouriteProperties = 'Add to favourite properties';
|
||||
lisOIFRemoveFromFavouriteProperties = 'Remove from favourite properties';
|
||||
|
||||
implementation
|
||||
end.
|
||||
|
||||
17
ide/main.pp
17
ide/main.pp
@ -1338,9 +1338,7 @@ begin
|
||||
ObjectInspector1.OnSelectPersistentsInOI:=@OIOnSelectPersistents;
|
||||
ObjectInspector1.OnShowOptions:=@OIOnShowOptions;
|
||||
ObjectInspector1.OnRemainingKeyUp:=@OIRemainingKeyUp;
|
||||
{$IFDEF EnableOIFavourites}
|
||||
ObjectInspector1.ShowFavouritePage:=true;
|
||||
{$ENDIF}
|
||||
ObjectInspector1.Favourites:=LoadOIFavouriteProperties;
|
||||
ObjectInspector1.OnAddToFavourites:=@OIOnAddToFavourites;
|
||||
ObjectInspector1.OnRemoveFromFavourites:=@OIOnRemoveFromFavourites;
|
||||
@ -3217,6 +3215,9 @@ procedure TMainIDE.SaveEnvironment;
|
||||
begin
|
||||
SaveDesktopSettings(EnvironmentOptions);
|
||||
EnvironmentOptions.Save(false);
|
||||
//debugln('TMainIDE.SaveEnvironment A ',dbgsName(ObjectInspector1.Favourites));
|
||||
if (ObjectInspector1<>nil) and (ObjectInspector1.Favourites<>nil) then
|
||||
SaveOIFavouriteProperties(ObjectInspector1.Favourites);
|
||||
end;
|
||||
|
||||
//==============================================================================
|
||||
@ -5586,12 +5587,9 @@ begin
|
||||
|
||||
// search file in path (search especially for pascal files)
|
||||
if FindFile(FName,SPath) then begin
|
||||
result:=mrOk;
|
||||
Result:=mrOk;
|
||||
InputHistories.FileDialogSettings.InitialDir:=ExtractFilePath(FName);
|
||||
if DoOpenEditorFile(FName,-1,[])=mrOk then begin
|
||||
EnvironmentOptions.AddToRecentOpenFiles(FName);
|
||||
SetRecentFilesMenu;
|
||||
SaveEnvironment;
|
||||
if DoOpenEditorFile(FName,-1,[ofAddToRecent])=mrOk then begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -6567,7 +6565,7 @@ begin
|
||||
SaveEnvironment;
|
||||
SaveIncludeLinks;
|
||||
InputHistories.Save;
|
||||
// ToDo: save package, cvs settings, ...
|
||||
// ToDo: save open packages, cvs settings, ...
|
||||
end;
|
||||
|
||||
procedure TMainIDE.DoRestart;
|
||||
@ -11544,6 +11542,9 @@ end.
|
||||
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.864 2005/04/13 09:33:15 mattias
|
||||
implemented favourite properties for ObjectInspector
|
||||
|
||||
Revision 1.863 2005/03/29 09:30:14 mattias
|
||||
started OI favourites
|
||||
|
||||
|
||||
@ -73,6 +73,11 @@ type
|
||||
function Constrains(AnItem: TOIFavouriteProperty): boolean;
|
||||
function IsFavourite(AClass: TPersistentClass;
|
||||
const APropertyName: string): boolean;
|
||||
function Compare(AFavourite: TOIFavouriteProperty): integer;
|
||||
procedure SaveToConfig(ConfigStore: TConfigStorage; const Path: string);
|
||||
procedure Assign(Src: TOIFavouriteProperty); virtual;
|
||||
function CreateCopy: TOIFavouriteProperty;
|
||||
function DebugReportAsString: string;
|
||||
end;
|
||||
|
||||
{ TOIFavouriteProperties }
|
||||
@ -80,25 +85,45 @@ type
|
||||
TOIFavouriteProperties = class
|
||||
private
|
||||
FItems: TList;
|
||||
FCount: integer;
|
||||
function GetItems(Index: integer): TOIFavouriteProperty;
|
||||
FModified: Boolean;
|
||||
FSorted: Boolean;
|
||||
FDoublesDeleted: Boolean;
|
||||
protected
|
||||
function GetCount: integer; virtual;
|
||||
function GetItems(Index: integer): TOIFavouriteProperty; virtual;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
procedure Add(NewItem: TOIFavouriteProperty);
|
||||
procedure Remove(AnItem: TOIFavouriteProperty);
|
||||
procedure DeleteConstraints(AnItem: TOIFavouriteProperty);
|
||||
procedure Clear; virtual;
|
||||
procedure Assign(Src: TOIFavouriteProperties); virtual;
|
||||
function CreateCopy: TOIFavouriteProperties;
|
||||
function Contains(AnItem: TOIFavouriteProperty): Boolean; virtual;
|
||||
procedure Add(NewItem: TOIFavouriteProperty); virtual;
|
||||
procedure AddNew(NewItem: TOIFavouriteProperty);
|
||||
procedure Remove(AnItem: TOIFavouriteProperty); virtual;
|
||||
procedure DeleteConstraints(AnItem: TOIFavouriteProperty); virtual;
|
||||
function IsFavourite(AClass: TPersistentClass;
|
||||
const PropertyName: string): boolean;
|
||||
function AreFavourites(Selection: TPersistentSelectionList;
|
||||
const PropertyName: string): boolean;
|
||||
procedure LoadFromConfig(ConfigStore: TConfigStorage; const Path: string);
|
||||
procedure SaveToConfig(ConfigStore: TConfigStorage; const Path: string);
|
||||
procedure MergeConfig(ConfigStore: TConfigStorage; const Path: string);
|
||||
procedure SaveNewItemsToConfig(ConfigStore: TConfigStorage;
|
||||
const Path: string; BaseFavourites: TOIFavouriteProperties);
|
||||
procedure Sort; virtual;
|
||||
procedure DeleteDoubles; virtual;
|
||||
function IsEqual(TheFavourites: TOIFavouriteProperties): boolean;
|
||||
function GetSubtractList(FavouritesToSubtract: TOIFavouriteProperties): TList;
|
||||
procedure WriteDebugReport;
|
||||
public
|
||||
property Items[Index: integer]: TOIFavouriteProperty read GetItems; default;
|
||||
property Count: integer read FCount;
|
||||
property Count: integer read GetCount;
|
||||
property Modified: Boolean read FModified write FModified;
|
||||
property Sorted: Boolean read FSorted;
|
||||
property DoublesDeleted: boolean read FDoublesDeleted;
|
||||
end;
|
||||
TOIFavouritePropertiesClass = class of TOIFavouriteProperties;
|
||||
|
||||
|
||||
{ TOIOptions }
|
||||
@ -599,6 +624,7 @@ const
|
||||
);
|
||||
|
||||
|
||||
function CompareOIFavouriteProperties(Data1, Data2: Pointer): integer;
|
||||
|
||||
//******************************************************************************
|
||||
|
||||
@ -613,6 +639,16 @@ begin
|
||||
Result:= AnsiCompareText(TOIPropertyGridRow(Item1).Name, TOIPropertyGridRow(Item2).Name);
|
||||
end;
|
||||
|
||||
function CompareOIFavouriteProperties(Data1, Data2: Pointer): integer;
|
||||
var
|
||||
Favourite1: TOIFavouriteProperty;
|
||||
Favourite2: TOIFavouriteProperty;
|
||||
begin
|
||||
Favourite1:=TOIFavouriteProperty(Data1);
|
||||
Favourite2:=TOIFavouriteProperty(Data2);
|
||||
Result:=Favourite1.Compare(Favourite2)
|
||||
end;
|
||||
|
||||
|
||||
{ TOICustomPropertyGrid }
|
||||
|
||||
@ -3355,9 +3391,11 @@ begin
|
||||
SetDefaultPopupMenuItem.Caption:=oisSetToDefaultValue;
|
||||
|
||||
AddToFavouritesPopupMenuItem.Visible:=(Favourites<>nil)
|
||||
and ShowFavouritePage
|
||||
and (GetActivePropertyGrid<>FavouriteGrid)
|
||||
and Assigned(OnAddToFavourites) and (GetActivePropertyRow<>nil);
|
||||
RemoveFromFavouritesPopupMenuItem.Visible:=(Favourites<>nil)
|
||||
and ShowFavouritePage
|
||||
and (GetActivePropertyGrid=FavouriteGrid)
|
||||
and Assigned(OnRemoveFromFavourites) and (GetActivePropertyRow<>nil);
|
||||
|
||||
@ -3461,6 +3499,11 @@ end;
|
||||
|
||||
{ TOIFavouriteProperties }
|
||||
|
||||
function TOIFavouriteProperties.GetCount: integer;
|
||||
begin
|
||||
Result:=FItems.Count;
|
||||
end;
|
||||
|
||||
function TOIFavouriteProperties.GetItems(Index: integer): TOIFavouriteProperty;
|
||||
begin
|
||||
Result:=TOIFavouriteProperty(FItems[Index]);
|
||||
@ -3485,18 +3528,62 @@ begin
|
||||
for i:=0 to FItems.Count-1 do
|
||||
TObject(FItems[i]).Free;
|
||||
FItems.Clear;
|
||||
FSorted:=true;
|
||||
end;
|
||||
|
||||
procedure TOIFavouriteProperties.Assign(Src: TOIFavouriteProperties);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Clear;
|
||||
for i:=0 to Src.Count-1 do
|
||||
FItems.Add(Src[i].CreateCopy);
|
||||
FModified:=Src.Modified;
|
||||
FDoublesDeleted:=Src.DoublesDeleted;
|
||||
FSorted:=Src.Sorted;
|
||||
end;
|
||||
|
||||
function TOIFavouriteProperties.CreateCopy: TOIFavouriteProperties;
|
||||
begin
|
||||
Result:=TOIFavouriteProperties.Create;
|
||||
Result.Assign(Self);
|
||||
end;
|
||||
|
||||
function TOIFavouriteProperties.Contains(AnItem: TOIFavouriteProperty
|
||||
): Boolean;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=Count-1 downto 0 do begin
|
||||
if Items[i].Compare(AnItem)=0 then begin
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
procedure TOIFavouriteProperties.Add(NewItem: TOIFavouriteProperty);
|
||||
begin
|
||||
FItems.Add(NewItem);
|
||||
FCount:=FItems.Count;
|
||||
FSorted:=(Count<=1)
|
||||
or (FSorted and (Items[Count-1].Compare(Items[Count-2])<0));
|
||||
FDoublesDeleted:=FSorted
|
||||
and ((Count<=1) or (Items[Count-1].Compare(Items[Count-2])<>0));
|
||||
Modified:=true;
|
||||
end;
|
||||
|
||||
procedure TOIFavouriteProperties.AddNew(NewItem: TOIFavouriteProperty);
|
||||
begin
|
||||
if Contains(NewItem) then
|
||||
NewItem.Free
|
||||
else
|
||||
Add(NewItem);
|
||||
end;
|
||||
|
||||
procedure TOIFavouriteProperties.Remove(AnItem: TOIFavouriteProperty);
|
||||
begin
|
||||
FItems.Remove(AnItem);
|
||||
FCount:=FItems.Count;
|
||||
Modified:=FItems.Remove(AnItem)>=0;
|
||||
end;
|
||||
|
||||
procedure TOIFavouriteProperties.DeleteConstraints(
|
||||
@ -3510,6 +3597,7 @@ begin
|
||||
CurItem:=Items[i];
|
||||
if CurItem.Constrains(AnItem) then begin
|
||||
FItems.Delete(i);
|
||||
Modified:=true;
|
||||
CurItem.Free;
|
||||
end;
|
||||
end;
|
||||
@ -3527,7 +3615,7 @@ begin
|
||||
exit;
|
||||
end;
|
||||
BestItem:=nil;
|
||||
for i:=0 to FCount-1 do begin
|
||||
for i:=0 to Count-1 do begin
|
||||
CurItem:=Items[i];
|
||||
if not CurItem.IsFavourite(AClass,PropertyName) then continue;
|
||||
if (BestItem=nil)
|
||||
@ -3584,23 +3672,194 @@ begin
|
||||
NewItem.BaseClassName:=NewBaseClassname;
|
||||
Add(NewItem);
|
||||
end;
|
||||
{$IFDEF DebugFavouriteroperties}
|
||||
debugln('TOIFavouriteProperties.LoadFromConfig END');
|
||||
WriteDebugReport;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TOIFavouriteProperties.SaveToConfig(ConfigStore: TConfigStorage;
|
||||
const Path: string);
|
||||
var
|
||||
i: Integer;
|
||||
p: String;
|
||||
CurItem: TOIFavouriteProperty;
|
||||
begin
|
||||
ConfigStore.SetDeleteValue(Path+'Count',Count,0);
|
||||
for i:=0 to Count-1 do begin
|
||||
CurItem:=Items[i];
|
||||
p:=Path+'Item'+IntToStr(i)+'/';
|
||||
ConfigStore.SetDeleteValue(p+'BaseClass',CurItem.BaseClass.ClassName,'');
|
||||
ConfigStore.SetDeleteValue(p+'PropertyName',CurItem.PropertyName,'');
|
||||
ConfigStore.SetDeleteValue(p+'Include',CurItem.Include,true);
|
||||
for i:=0 to Count-1 do
|
||||
Items[i].SaveToConfig(ConfigStore,Path+'Item'+IntToStr(i)+'/');
|
||||
end;
|
||||
|
||||
procedure TOIFavouriteProperties.MergeConfig(ConfigStore: TConfigStorage;
|
||||
const Path: string);
|
||||
var
|
||||
NewFavourites: TOIFavouriteProperties;
|
||||
OldItem: TOIFavouriteProperty;
|
||||
NewItem: TOIFavouriteProperty;
|
||||
cmp: LongInt;
|
||||
NewIndex: Integer;
|
||||
OldIndex: Integer;
|
||||
begin
|
||||
NewFavourites:=TOIFavouritePropertiesClass(ClassType).Create;
|
||||
{$IFDEF DebugFavouriteroperties}
|
||||
debugln('TOIFavouriteProperties.MergeConfig ',dbgsName(NewFavourites),' ',dbgsName(NewFavourites.FItems));
|
||||
{$ENDIF}
|
||||
try
|
||||
// load config
|
||||
NewFavourites.LoadFromConfig(ConfigStore,Path);
|
||||
// sort both to see the differences
|
||||
NewFavourites.DeleteDoubles; // descending
|
||||
DeleteDoubles; // descending
|
||||
// add all new things from NewFavourites
|
||||
NewIndex:=0;
|
||||
OldIndex:=0;
|
||||
while (NewIndex<NewFavourites.Count) do begin
|
||||
NewItem:=NewFavourites[NewIndex];
|
||||
if OldIndex>=Count then begin
|
||||
// item only exists in config -> move to this list
|
||||
NewFavourites.FItems[NewIndex]:=nil;
|
||||
inc(NewIndex);
|
||||
FItems.Insert(OldIndex,NewItem);
|
||||
inc(OldIndex);
|
||||
end else begin
|
||||
OldItem:=Items[OldIndex];
|
||||
cmp:=OldItem.Compare(NewItem);
|
||||
//debugln('TOIFavouriteProperties.MergeConfig cmp=',dbgs(cmp),' OldItem=[',OldItem.DebugReportAsString,'] NewItem=[',NewItem.DebugReportAsString,']');
|
||||
if cmp=0 then begin
|
||||
// item already exists in this list
|
||||
inc(NewIndex);
|
||||
inc(OldIndex);
|
||||
end else if cmp<0 then begin
|
||||
// item exists only in old favourites
|
||||
// -> next old
|
||||
inc(OldIndex);
|
||||
end else begin
|
||||
// item only exists in config -> move to this list
|
||||
NewFavourites.FItems[NewIndex]:=nil;
|
||||
inc(NewIndex);
|
||||
FItems.Insert(OldIndex,NewItem);
|
||||
inc(OldIndex);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
NewFavourites.Free;
|
||||
end;
|
||||
{$IFDEF DebugFavouriteroperties}
|
||||
debugln('TOIFavouriteProperties.MergeConfig END');
|
||||
WriteDebugReport;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TOIFavouriteProperties.SaveNewItemsToConfig(
|
||||
ConfigStore: TConfigStorage; const Path: string;
|
||||
BaseFavourites: TOIFavouriteProperties);
|
||||
// Save all items, that are in this list and not in BaseFavourites
|
||||
// It does not save, if an item in BaseFavourites is missing in this list
|
||||
var
|
||||
SubtractList: TList;
|
||||
i: Integer;
|
||||
CurItem: TOIFavouriteProperty;
|
||||
begin
|
||||
SubtractList:=GetSubtractList(BaseFavourites);
|
||||
try
|
||||
ConfigStore.SetDeleteValue(Path+'Count',SubtractList.Count,0);
|
||||
{$IFDEF DebugFavouriteroperties}
|
||||
debugln('TOIFavouriteProperties.SaveNewItemsToConfig A Count=',dbgs(SubtractList.Count));
|
||||
{$ENDIF}
|
||||
for i:=0 to SubtractList.Count-1 do begin
|
||||
CurItem:=TOIFavouriteProperty(SubtractList[i]);
|
||||
CurItem.SaveToConfig(ConfigStore,Path+'Item'+IntToStr(i)+'/');
|
||||
{$IFDEF DebugFavouriteroperties}
|
||||
debugln(' i=',dbgs(i),' ',CurItem.DebugReportAsString);
|
||||
{$ENDIF}
|
||||
end;
|
||||
finally
|
||||
SubtractList.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOIFavouriteProperties.Sort;
|
||||
begin
|
||||
if FSorted then exit;
|
||||
FItems.Sort(@CompareOIFavouriteProperties);
|
||||
end;
|
||||
|
||||
procedure TOIFavouriteProperties.DeleteDoubles;
|
||||
// This also sorts
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if FDoublesDeleted then exit;
|
||||
Sort;
|
||||
for i:=Count-1 downto 1 do begin
|
||||
if Items[i].Compare(Items[i-1])=0 then begin
|
||||
Items[i].Free;
|
||||
FItems.Delete(i);
|
||||
end;
|
||||
end;
|
||||
FDoublesDeleted:=true;
|
||||
end;
|
||||
|
||||
function TOIFavouriteProperties.IsEqual(TheFavourites: TOIFavouriteProperties
|
||||
): boolean;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result:=false;
|
||||
DeleteDoubles;
|
||||
TheFavourites.DeleteDoubles;
|
||||
if Count<>TheFavourites.Count then exit;
|
||||
for i:=Count-1 downto 1 do
|
||||
if Items[i].Compare(TheFavourites.Items[i])<>0 then exit;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TOIFavouriteProperties.GetSubtractList(
|
||||
FavouritesToSubtract: TOIFavouriteProperties): TList;
|
||||
// create a list of TOIFavouriteProperty of all items in this list
|
||||
// and not in FavouritesToSubtract
|
||||
var
|
||||
SelfIndex: Integer;
|
||||
SubtractIndex: Integer;
|
||||
CurItem: TOIFavouriteProperty;
|
||||
cmp: LongInt;
|
||||
begin
|
||||
Result:=TList. Create;
|
||||
DeleteDoubles; // this also sorts descending
|
||||
FavouritesToSubtract.DeleteDoubles; // this also sorts descending
|
||||
SelfIndex:=0;
|
||||
SubtractIndex:=0;
|
||||
while SelfIndex<Count do begin
|
||||
CurItem:=Items[SelfIndex];
|
||||
if SubtractIndex>=FavouritesToSubtract.Count then begin
|
||||
// item does not exist in SubtractIndex -> add it
|
||||
Result.Add(CurItem);
|
||||
inc(SelfIndex);
|
||||
end else begin
|
||||
cmp:=CurItem.Compare(FavouritesToSubtract[SubtractIndex]);
|
||||
//debugln('TOIFavouriteProperties.GetSubtractList cmp=',dbgs(cmp),' CurItem=[',CurItem.DebugReportAsString,'] SubtractItem=[',FavouritesToSubtract[SubtractIndex].DebugReportAsString,']');
|
||||
if cmp=0 then begin
|
||||
// item exists in SubtractIndex -> skip
|
||||
inc(SubtractIndex);
|
||||
inc(SelfIndex);
|
||||
end else if cmp>0 then begin
|
||||
// item does not exist in FavouritesToSubtract -> add it
|
||||
Result.Add(CurItem);
|
||||
inc(SelfIndex);
|
||||
end else begin
|
||||
// item exists only in FavouritesToSubtract -> skip
|
||||
inc(SubtractIndex);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOIFavouriteProperties.WriteDebugReport;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
debugln('TOIFavouriteProperties.WriteDebugReport Count=',dbgs(Count));
|
||||
for i:=0 to Count-1 do
|
||||
debugln(' i=',dbgs(i),' ',Items[i].DebugReportAsString);
|
||||
end;
|
||||
|
||||
{ TOIFavouriteProperty }
|
||||
@ -3631,5 +3890,72 @@ begin
|
||||
and (AClass.InheritsFrom(BaseClass));
|
||||
end;
|
||||
|
||||
function TOIFavouriteProperty.Compare(AFavourite: TOIFavouriteProperty
|
||||
): integer;
|
||||
|
||||
function CompareBaseClass: integer;
|
||||
begin
|
||||
if BaseClass<>nil then begin
|
||||
if AFavourite.BaseClass<>nil then
|
||||
Result:=ComparePointers(BaseClass,AFavourite.BaseClass)
|
||||
else
|
||||
Result:=CompareText(BaseClass.ClassName,AFavourite.BaseClassName);
|
||||
end else begin
|
||||
if AFavourite.BaseClass<>nil then
|
||||
Result:=CompareText(BaseClassName,AFavourite.BaseClass.ClassName)
|
||||
else
|
||||
Result:=CompareText(BaseClassName,AFavourite.BaseClassName);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
// first compare PropertyName
|
||||
Result:=CompareText(PropertyName,AFavourite.PropertyName);
|
||||
if Result<>0 then exit;
|
||||
// then compare Include
|
||||
if Include<>AFavourite.Include then begin
|
||||
if Include then
|
||||
Result:=1
|
||||
else
|
||||
Result:=-1;
|
||||
exit;
|
||||
end;
|
||||
// then compare BaseClass and BaseClassName
|
||||
Result:=CompareBaseClass;
|
||||
end;
|
||||
|
||||
procedure TOIFavouriteProperty.SaveToConfig(ConfigStore: TConfigStorage;
|
||||
const Path: string);
|
||||
begin
|
||||
if BaseClass<>nil then
|
||||
ConfigStore.SetDeleteValue(Path+'BaseClass',BaseClass.ClassName,'')
|
||||
else
|
||||
ConfigStore.SetDeleteValue(Path+'BaseClass',BaseClassName,'');
|
||||
ConfigStore.SetDeleteValue(Path+'PropertyName',PropertyName,'');
|
||||
ConfigStore.SetDeleteValue(Path+'Include',Include,true);
|
||||
end;
|
||||
|
||||
procedure TOIFavouriteProperty.Assign(Src: TOIFavouriteProperty);
|
||||
begin
|
||||
BaseClassName:=Src.BaseClassName;
|
||||
BaseClass:=Src.BaseClass;
|
||||
PropertyName:=Src.PropertyName;
|
||||
Include:=Src.Include;
|
||||
end;
|
||||
|
||||
function TOIFavouriteProperty.CreateCopy: TOIFavouriteProperty;
|
||||
begin
|
||||
Result:=TOIFavouriteProperty.Create(BaseClass,PropertyName,Include);
|
||||
Result.BaseClass:=BaseClass;
|
||||
end;
|
||||
|
||||
function TOIFavouriteProperty.DebugReportAsString: string;
|
||||
begin
|
||||
Result:='PropertyName="'+PropertyName+'"'
|
||||
+' Include='+dbgs(Include)
|
||||
+' BaseClassName="'+BaseClassName+'"'
|
||||
+' BaseClass='+dbgsName(BaseClass);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -153,6 +153,7 @@ function DbgS(const p: pointer): string;
|
||||
function DbgS(const e: extended): string;
|
||||
function DbgS(const b: boolean): string;
|
||||
function DbgSName(const p: TObject): string;
|
||||
function DbgSName(const p: TClass): string;
|
||||
function DbgStr(const StringWithSpecialChars: string): string;
|
||||
function dbgMemRange(P: PByte; Count: integer): string;
|
||||
function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string;
|
||||
@ -1088,6 +1089,14 @@ begin
|
||||
Result:=p.ClassName;
|
||||
end;
|
||||
|
||||
function DbgSName(const p: TClass): string;
|
||||
begin
|
||||
if p=nil then
|
||||
Result:='nil'
|
||||
else
|
||||
Result:=p.ClassName;
|
||||
end;
|
||||
|
||||
function DbgStr(const StringWithSpecialChars: string): string;
|
||||
var
|
||||
i: Integer;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user