added "syncro-mode" to project configurations editor

This commit is contained in:
Basile Burg 2015-01-11 03:14:59 +01:00
parent 17b1ed48c9
commit 148c7729a9
2 changed files with 140 additions and 9 deletions

View File

@ -1,7 +1,7 @@
inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
Left = 1429
Left = 632
Height = 273
Top = 30
Top = 322
Width = 445
Caption = 'Project configuration'
ClientHeight = 273
@ -34,7 +34,7 @@ inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
Height = 23
Hint = 'select a configuration'
Top = 1
Width = 346
Width = 316
Align = alClient
BorderSpacing.Top = 1
BorderSpacing.Right = 1
@ -44,7 +44,7 @@ inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
TabOrder = 0
end
object btnAddConf: TSpeedButton
Left = 347
Left = 317
Height = 24
Hint = 'add an empty configuration'
Top = 0
@ -54,7 +54,7 @@ inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
ShowCaption = False
end
object btnDelConf: TSpeedButton
Left = 377
Left = 347
Height = 24
Hint = 'remove selected configuration'
Top = 0
@ -64,7 +64,7 @@ inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
ShowCaption = False
end
object btnCloneConf: TSpeedButton
Left = 407
Left = 377
Height = 24
Hint = 'clone selected configuration'
Top = 0
@ -73,6 +73,16 @@ inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
OnClick = btnCloneCurrClick
ShowCaption = False
end
object btnSyncEdit: TSpeedButton
Left = 407
Height = 24
Hint = 'syncrhonize each configuration'
Top = 0
Width = 30
Align = alRight
OnClick = btnSyncEditClick
ShowCaption = False
end
end
object Panel2: TPanel[1]
Left = 4
@ -138,6 +148,7 @@ inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
Indent = 16
NameFont.Color = clWindowText
OnEditorFilter = GridEditorFilter
OnModified = GridModified
PreferredSplitterX = 145
SplitterX = 145
ValueFont.Color = clGreen

View File

@ -5,15 +5,17 @@ unit ce_projconf;
interface
uses
Classes, SysUtils, FileUtil, RTTIGrids, Forms, Controls, Graphics, Dialogs,
ExtCtrls, ComCtrls, StdCtrls, Menus, Buttons, PropEdits, ObjectInspector,
ce_dmdwrap, ce_project, ce_widget, ce_interfaces, ce_observer;
Classes, SysUtils, FileUtil, RTTIGrids, RTTICtrls, Forms, Controls, Graphics,
Dialogs, ExtCtrls, ComCtrls, StdCtrls, Menus, Buttons, rttiutils, typinfo,
PropEdits, ObjectInspector, ce_dmdwrap, ce_project, ce_widget, ce_interfaces,
ce_observer;
type
{ TCEProjectConfigurationWidget }
TCEProjectConfigurationWidget = class(TCEWidget, ICEProjectObserver)
btnSyncEdit: TSpeedButton;
imgList: TImageList;
Panel2: TPanel;
selConf: TComboBox;
@ -27,13 +29,21 @@ type
procedure btnAddConfClick(Sender: TObject);
procedure btnDelConfClick(Sender: TObject);
procedure btnCloneCurrClick(Sender: TObject);
procedure btnSyncEditClick(Sender: TObject);
procedure GridEditorFilter(Sender: TObject; aEditor: TPropertyEditor;var aShow: boolean);
procedure GridModified(Sender: TObject);
procedure selConfChange(Sender: TObject);
procedure TreeChange(Sender: TObject; Node: TTreeNode);
procedure GridFilter(Sender: TObject; aEditor: TPropertyEditor;var aShow: boolean);
private
fProj: TCEProject;
fSyncroMode: boolean;
fSyncroPropValue: string;
function getGridTarget: TPersistent;
procedure setSyncroMode(aValue: boolean);
function syncroSetPropAsString(const ASection, Item, Default: string): string;
procedure syncroGetPropAsString(const ASection, Item, Value: string);
property syncroMode: boolean read fSyncroMode write setSyncroMode;
protected
procedure UpdateByEvent; override;
public
@ -63,6 +73,8 @@ begin
btnDelConf.Glyph.Assign(png);
png.LoadFromLazarusResource('cog_go');
btnCloneConf.Glyph.Assign(png);
png.LoadFromLazarusResource('link_break');
btnSyncEdit.Glyph.Assign(png);
finally
png.Free;
end;
@ -85,6 +97,7 @@ begin
beginUpdateByEvent;
fProj := aProject;
endUpdateByEvent;
syncroMode := false;
end;
procedure TCEProjectConfigurationWidget.projClosing(aProject: TCEProject);
@ -94,6 +107,7 @@ begin
Grid.TIObject := nil;
Grid.ItemIndex := -1;
self.selConf.Clear;
syncroMode := false;
fProj := nil;
end;
@ -138,6 +152,106 @@ begin
if aEditor.ClassType = TCollectionPropertyEditor then aShow := false;
end;
procedure TCEProjectConfigurationWidget.setSyncroMode(aValue: boolean);
var
png: TPortableNetworkGraphic;
begin
if fSyncroMode = aValue then exit;
//
fSyncroMode := aValue;
png := TPortableNetworkGraphic.Create;
try
if fSyncroMode then png.LoadFromLazarusResource('link')
else png.LoadFromLazarusResource('link_break');
btnSyncEdit.Glyph.Assign(png);
finally
png.Free;
end;
end;
function TCEProjectConfigurationWidget.syncroSetPropAsString(const ASection, Item, Default: string): string;
begin
result := fSyncroPropValue;
end;
procedure TCEProjectConfigurationWidget.syncroGetPropAsString(const ASection, Item, Value: string);
begin
fSyncroPropValue := Value;
end;
procedure TCEProjectConfigurationWidget.GridModified(Sender: TObject);
var
propstr: string;
src_list, trg_list: rttiutils.TPropInfoList;
src_prop, trg_prop: PPropInfo;
storage: rttiutils.TPropsStorage;
trg_obj: TPersistent;
i: Integer;
begin
if fProj = nil then exit;
if not fSyncroMode then exit;
if Grid.TIObject = nil then exit;
if Grid.ItemIndex = -1 then exit;
//
storage := nil;
src_prop:= nil;
trg_prop:= nil;
trg_obj := nil;
propstr := Grid.PropertyPath(Grid.ItemIndex);
storage := rttiutils.TPropsStorage.Create;
storage.OnReadString := @syncroSetPropAsString;
storage.OnWriteString := @syncroGetPropAsString;
src_list:= rttiutils.TPropInfoList.Create(getGridTarget, tkAny);
fProj.beginUpdate;
try
src_prop := src_list.Find(propstr);
if src_prop = nil then exit;
storage.AObject := getGridTarget;
storage.StoreAnyProperty(src_prop);
for i:= 0 to fProj.OptionsCollection.Count-1 do
begin
// skip current config
if i = fProj.ConfigurationIndex then continue;
// find target persistent
if Grid.TIObject = fProj.currentConfiguration.messagesOptions then
trg_obj := fProj.configuration[i].messagesOptions else
if Grid.TIObject = fProj.currentConfiguration.debugingOptions then
trg_obj := fProj.configuration[i].debugingOptions else
if Grid.TIObject = fProj.currentConfiguration.documentationOptions then
trg_obj := fProj.configuration[i].documentationOptions else
if Grid.TIObject = fProj.currentConfiguration.outputOptions then
trg_obj := fProj.configuration[i].outputOptions else
if Grid.TIObject = fProj.currentConfiguration.otherOptions then
trg_obj := fProj.configuration[i].otherOptions else
if Grid.TIObject = fProj.currentConfiguration.pathsOptions then
trg_obj := fProj.configuration[i].pathsOptions else
if Grid.TIObject = fProj.currentConfiguration.preBuildProcess then
trg_obj := fProj.configuration[i].preBuildProcess else
if Grid.TIObject = fProj.currentConfiguration.postBuildProcess then
trg_obj := fProj.configuration[i].postBuildProcess else
if Grid.TIObject = fProj.currentConfiguration.runOptions then
trg_obj := fProj.configuration[i].runOptions
else continue;
// find target property
storage.AObject := trg_obj;
trg_list := rttiutils.TPropInfoList.Create(trg_obj, tkAny);
try
trg_prop := trg_list.Find(propstr);
if trg_prop <> nil then
storage.LoadAnyProperty(trg_prop);
finally
trg_list.Free;
trg_prop := nil;
end;
end;
finally
storage.free;
src_list.free;
fProj.endUpdate;
fSyncroPropValue := '';
end;
end;
procedure TCEProjectConfigurationWidget.btnAddConfClick(Sender: TObject);
var
nme: string;
@ -185,6 +299,12 @@ begin
endUpdateByEvent;
end;
procedure TCEProjectConfigurationWidget.btnSyncEditClick(Sender: TObject);
begin
if fProj = nil then exit;
syncroMode := not syncroMode;
end;
procedure TCEProjectConfigurationWidget.GridFilter(Sender: TObject; aEditor: TPropertyEditor;
var aShow: boolean);
begin