123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354 |
- //
- // The graphics engine GLScene
- //
- unit FmXCollectionEditor;
- (* Edits a TXCollection *)
- interface
- {$I Stage.Defines.inc}
- uses
- System.Classes,
- System.SysUtils,
- System.Actions,
- System.ImageList,
- VCL.Forms,
- VCL.ImgList,
- VCL.Controls,
- VCL.ActnList,
- VCL.Menus,
- VCL.ComCtrls,
- VCL.ToolWin,
- VCL.Dialogs,
- DesignIntf,
- Stage.Strings,
- GLS.Scene,
- GLS.Behaviours,
- GLS.MaterialEx,
- GLS.XCollection;
- type
- TXCollectionEditorForm = class(TForm)
- ListView: TListView;
- PMListView: TPopupMenu;
- ActionList: TActionList;
- ACRemove: TAction;
- ACMoveUp: TAction;
- ACMoveDown: TAction;
- ImageList: TImageList;
- MIAdd: TMenuItem;
- N1: TMenuItem;
- N2: TMenuItem;
- Moveup1: TMenuItem;
- Movedown1: TMenuItem;
- ToolBar1: TToolBar;
- TBAdd: TToolButton;
- ToolButton2: TToolButton;
- ToolButton3: TToolButton;
- ToolButton4: TToolButton;
- ToolButton5: TToolButton;
- ToolButton6: TToolButton;
- PMToolBar: TPopupMenu;
- procedure TBAddClick(Sender: TObject);
- procedure ListViewChange(Sender: TObject; Item: TListItem;
- Change: TItemChange);
- procedure ACRemoveExecute(Sender: TObject);
- procedure ACMoveUpExecute(Sender: TObject);
- procedure ACMoveDownExecute(Sender: TObject);
- procedure PMToolBarPopup(Sender: TObject);
- procedure PMListViewPopup(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure FormHide(Sender: TObject);
- private
- FXCollection: TXCollection;
- // ownerComponent : TComponent;
- FDesigner: IDesigner;
- UpdatingListView: Boolean;
- procedure PrepareListView;
- procedure PrepareXCollectionItemPopup(parent: TMenuItem);
- procedure OnAddXCollectionItemClick(Sender: TObject);
- procedure OnNameChanged(Sender: TObject);
- procedure OnXCollectionDestroyed(Sender: TObject);
- protected
- procedure Notification(AComponent: TComponent;
- Operation: TOperation); override;
- public
- procedure SetXCollection(aXCollection: TXCollection; designer: IDesigner );
- end;
- function XCollectionEditorForm: TXCollectionEditorForm;
- procedure ReleaseXCollectionEditor;
- // ------------------------------------------------------------------
- implementation
- // ------------------------------------------------------------------
- {$R *.dfm}
- var
- vXCollectionEditorForm: TXCollectionEditorForm;
- function XCollectionEditorForm: TXCollectionEditorForm;
- begin
- if not Assigned(vXCollectionEditorForm) then
- vXCollectionEditorForm := TXCollectionEditorForm.Create(nil);
- Result := vXCollectionEditorForm;
- end;
- procedure ReleaseXCollectionEditor;
- begin
- if Assigned(vXCollectionEditorForm) then
- begin
- vXCollectionEditorForm.Release;
- vXCollectionEditorForm := nil;
- end;
- end;
- //--------------------------------------------
- // TXCollectionEditorForm
- //--------------------------------------------
- procedure TXCollectionEditorForm.FormCreate(Sender: TObject);
- begin
- RegisterGLBehaviourNameChangeEvent(OnNameChanged);
- RegisterGLMaterialExNameChangeEvent(OnNameChanged);
- RegisterXCollectionDestroyEvent(OnXCollectionDestroyed);
- end;
- procedure TXCollectionEditorForm.FormDestroy(Sender: TObject);
- begin
- DeRegisterGLBehaviourNameChangeEvent(OnNameChanged);
- DeRegisterGLMaterialExNameChangeEvent(OnNameChanged);
- DeRegisterXCollectionDestroyEvent(OnXCollectionDestroyed);
- end;
- procedure TXCollectionEditorForm.FormHide(Sender: TObject);
- begin
- SetXCollection(nil, nil);
- ReleaseXCollectionEditor;
- end;
- procedure TXCollectionEditorForm.SetXCollection(aXCollection: TXCollection; designer: IDesigner);
- begin
- // if Assigned(ownerComponent) then
- // ownerComponent.RemoveFreeNotification(Self);
- FXCollection := aXCollection;
- FDesigner := designer;
- if Assigned(FXCollection) then
- begin
- // if Assigned(FXCollection.Owner) and (FXCollection.Owner is TComponent) then
- // ownerComponent:=TComponent(FXCollection.Owner);
- // if Assigned(ownerComponent) then
- // ownerComponent.FreeNotification(Self);
- Caption := FXCollection.GetNamePath;
- end
- else
- begin
- // ownerComponent:=nil;
- Caption := strXCollectionEditor;
- end;
- PrepareListView;
- end;
- procedure TXCollectionEditorForm.TBAddClick(Sender: TObject);
- begin
- TBAdd.CheckMenuDropdown;
- end;
- procedure TXCollectionEditorForm.ListViewChange(Sender: TObject; Item: TListItem;
- Change: TItemChange);
- var
- sel: Boolean;
- begin
- if (Change = ctState) and Assigned(FDesigner) and (not updatingListView) then
- begin
- // setup enablings
- sel := (ListView.Selected <> nil);
- TBAdd.Enabled := Assigned(FDesigner);
- ACRemove.Enabled := sel;
- ACMoveUp.Enabled := sel and (ListView.Selected.Index > 0);
- ACMoveDown.Enabled := sel and
- (ListView.Selected.Index < ListView.Items.Count - 1);
- if Assigned(FDesigner) then
- if sel then
- FDesigner.SelectComponent(TXCollectionItem(ListView.Selected.Data))
- else
- FDesigner.SelectComponent(nil);
- end;
- end;
- procedure TXCollectionEditorForm.PrepareListView;
- var
- i: Integer;
- prevSelData: Pointer;
- XCollectionItem: TXCollectionItem;
- DisplayedName: String;
- begin
- Assert(Assigned(ListView));
- updatingListView := True;
- try
- if ListView.Selected <> nil then
- prevSelData := ListView.Selected.Data
- else
- prevSelData := nil;
- with ListView.Items do
- begin
- BeginUpdate;
- Clear;
- if Assigned(FXCollection) then
- begin
- for i := 0 to FXCollection.Count - 1 do
- with Add do
- begin
- XCollectionItem := FXCollection[i];
- DisplayedName := XCollectionItem.Name;
- if DisplayedName = '' then
- DisplayedName := '(unnamed)';
- Caption := Format('%d - %s', [i, DisplayedName]);
- SubItems.Add(XCollectionItem.FriendlyName);
- Data := XCollectionItem;
- end;
- if prevSelData <> nil then
- ListView.Selected := ListView.FindData(0, prevSelData, True, False);
- end;
- EndUpdate;
- end;
- finally
- updatingListView := False;
- end;
- ListViewChange(Self, nil, ctState);
- end;
- procedure TXCollectionEditorForm.PrepareXCollectionItemPopup(parent: TMenuItem);
- var
- i: Integer;
- list: TList;
- XCollectionItemClass: TXCollectionItemClass;
- mi, categoryItem: TMenuItem;
- begin
- list := GetXCollectionItemClassesList(FXCollection.ItemsClass);
- try
- parent.Clear;
- for i := 0 to list.Count - 1 do
- begin
- XCollectionItemClass := TXCollectionItemClass(list[i]);
- if XCollectionItemClass.ItemCategory <> '' then
- begin
- categoryItem := parent.Find(XCollectionItemClass.ItemCategory);
- if categoryItem = nil then
- begin
- categoryItem := TMenuItem.Create(owner);
- categoryItem.Caption := XCollectionItemClass.ItemCategory;
- parent.Add(categoryItem);
- end;
- end
- else
- categoryItem := parent;
- mi := TMenuItem.Create(owner);
- mi.Caption := XCollectionItemClass.FriendlyName;
- mi.OnClick := OnAddXCollectionItemClick;
- mi.Tag := Integer(XCollectionItemClass);
- mi.Enabled := Assigned(FXCollection) and
- FXCollection.CanAdd(XCollectionItemClass);
- categoryItem.Add(mi);
- end;
- finally
- list.Free;
- end;
- end;
- procedure TXCollectionEditorForm.OnNameChanged(Sender: TObject);
- begin
- if TXCollectionItem(Sender).owner = FXCollection then
- PrepareListView;
- end;
- procedure TXCollectionEditorForm.OnXCollectionDestroyed(Sender: TObject);
- begin
- if TXCollection(Sender) = FXCollection then
- Close;
- end;
- procedure TXCollectionEditorForm.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- { if (Operation=opRemove) and (AComponent=ownerComponent) then begin
- ownerComponent:=nil;
- SetXCollection(nil, nil);
- Close;
- end;
- }
- inherited;
- end;
- procedure TXCollectionEditorForm.OnAddXCollectionItemClick(Sender: TObject);
- var
- XCollectionItemClass: TXCollectionItemClass;
- XCollectionItem: TXCollectionItem;
- begin
- XCollectionItemClass := TXCollectionItemClass((Sender as TMenuItem).Tag);
- XCollectionItem := XCollectionItemClass.Create(FXCollection);
- PrepareListView;
- ListView.Selected := ListView.FindData(0, XCollectionItem, True, False);
- FDesigner.Modified;
- end;
- procedure TXCollectionEditorForm.ACRemoveExecute(Sender: TObject);
- begin
- if ListView.Selected <> nil then
- begin
- FDesigner.Modified;
- FDesigner.SelectComponent(FXCollection.owner);
- TXCollectionItem(ListView.Selected.Data).Free;
- ListView.Selected.Free;
- ListViewChange(Self, nil, ctState);
- end;
- end;
- procedure TXCollectionEditorForm.ACMoveUpExecute(Sender: TObject);
- begin
- if ListView.Selected <> nil then
- begin
- TXCollectionItem(ListView.Selected.Data).MoveUp;
- PrepareListView;
- FDesigner.Modified;
- end;
- end;
- procedure TXCollectionEditorForm.ACMoveDownExecute(Sender: TObject);
- begin
- if ListView.Selected <> nil then
- begin
- TXCollectionItem(ListView.Selected.Data).MoveDown;
- PrepareListView;
- FDesigner.Modified;
- end;
- end;
- procedure TXCollectionEditorForm.PMToolBarPopup(Sender: TObject);
- begin
- PrepareXCollectionItemPopup(PMToolBar.Items);
- end;
- procedure TXCollectionEditorForm.PMListViewPopup(Sender: TObject);
- begin
- PrepareXCollectionItemPopup(MIAdd);
- end;
- //-----------------------------------
- initialization
- //-----------------------------------
- finalization
- ReleaseXCollectionEditor;
- end.
|