123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521 |
- //
- // The graphics engine GLScene
- //
- unit FmSceneEditor;
- (* Scene Editor, for adding + removing scene objects *)
- interface
- {$I Stage.Defines.inc}
- uses
- WinApi.Windows,
- System.Classes,
- System.SysUtils,
- System.Win.Registry,
- System.ImageList,
- System.Actions,
- VCL.ActnList,
- VCL.Controls,
- VCL.Forms,
- VCL.ComCtrls,
- VCL.ImgList,
- VCL.Dialogs,
- VCL.Menus,
- VCL.ToolWin,
- VCL.ExtCtrls,
- VCL.StdCtrls,
- VCL.ClipBrd,
- DesignIntf,
- VCLEditors,
- GLS.Scene,
- GLS.SceneViewer,
- Stage.Strings,
- FmInfo,
- GLS.XCollection,
- Stage.Utils,
- GLS.SceneRegister;
- const
- SCENE_SELECTED = 0;
- BEHAVIOURS_SELECTED = 1;
- EFFECTS_SELECTED = 2;
- type
- TSetSubItemsEvent = procedure(Sender: TObject) of object;
- TGLSceneEditorForm = class(TForm)
- PopupMenu: TPopupMenu;
- MIAddObject: TMenuItem;
- N1: TMenuItem;
- MIDelObject: TMenuItem;
- ToolBar: TToolBar;
- ActionList: TActionList;
- TBAddObjects: TToolButton;
- TBMoveUp: TToolButton;
- pmToolBar: TPopupMenu;
- TBDeleteObject: TToolButton;
- TBMoveDown: TToolButton;
- acAddObject: TAction;
- ImageList: TImageList;
- acDeleteObject: TAction;
- acMoveUp: TAction;
- acMoveDown: TAction;
- N2: TMenuItem;
- MIMoveUp: TMenuItem;
- MIMoveDown: TMenuItem;
- acSaveScene: TAction;
- acLoadScene: TAction;
- OpenDialog: TOpenDialog;
- SaveDialog: TSaveDialog;
- TBLoadScene: TToolButton;
- TBSaveScene: TToolButton;
- acInfo: TAction;
- acCopy: TAction;
- acCut: TAction;
- acPaste: TAction;
- MICopy: TMenuItem;
- MIPaste: TMenuItem;
- MICut: TMenuItem;
- TBCut: TToolButton;
- TBCopy: TToolButton;
- TBPaste: TToolButton;
- pmBehavioursToolbar: TPopupMenu;
- acAddBehaviour: TAction;
- MIAddBehaviour: TMenuItem;
- MIAddEffect: TMenuItem;
- MIBehaviourSeparator: TMenuItem;
- acDeleteBehaviour: TAction;
- pmBehaviours: TPopupMenu;
- Delete1: TMenuItem;
- MoveUp1: TMenuItem;
- MoveDown1: TMenuItem;
- N4: TMenuItem;
- pmEffectsToolbar: TPopupMenu;
- acAddEffect: TAction;
- TBCharacterPanels: TToolButton;
- TBStayOnTop: TToolButton;
- acStayOnTop: TAction;
- TBSeparator4: TToolButton;
- TBExpand: TToolButton;
- acExpand: TAction;
- PATreeAll: TPanel;
- PATree: TPanel;
- Tree: TTreeView;
- TBInfo: TToolButton;
- PABehaviours: TPanel;
- ToolBarBehaviours: TToolBar;
- TBAddBehaviours: TToolButton;
- BehavioursListView: TListView;
- PAEffects: TPanel;
- EffectsListView: TListView;
- ToolBarEffects: TToolBar;
- TBAddEffects: TToolButton;
- TBGalleryPanel: TToolButton;
- TreeAll: TTreeView;
- procedure FormCreate(Sender: TObject);
- procedure TreeEditing(Sender: TObject; Node: TTreeNode; var AllowEdit: Boolean);
- procedure TreeDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
- procedure TreeDragDrop(Sender, Source: TObject; X, Y: Integer);
- procedure TreeAllChange(Sender: TObject; Node: TTreeNode); // or onclick to simply select
- procedure TreeChange(Sender: TObject; Node: TTreeNode);
- procedure TreeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- procedure TreeEnter(Sender: TObject);
- procedure TreeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
- procedure acDeleteObjectExecute(Sender: TObject);
- procedure acMoveUpExecute(Sender: TObject);
- procedure acMoveDownExecute(Sender: TObject);
- procedure acAddObjectExecute(Sender: TObject);
- procedure acSaveSceneExecute(Sender: TObject);
- procedure acLoadSceneExecute(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure acInfoExecute(Sender: TObject);
- procedure acCopyExecute(Sender: TObject);
- procedure acCutExecute(Sender: TObject);
- procedure acPasteExecute(Sender: TObject);
- procedure BehavioursListViewEnter(Sender: TObject);
- procedure EffectsListViewEnter(Sender: TObject);
- procedure acAddBehaviourExecute(Sender: TObject);
- procedure DeleteBaseBehaviour(ListView: TListView);
- procedure pmBehavioursToolbarPopup(Sender: TObject);
- procedure pmEffectsToolbarPopup(Sender: TObject);
- procedure BehavioursListViewSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
- procedure acAddEffectExecute(Sender: TObject);
- procedure PopupMenuPopup(Sender: TObject);
- procedure TBCharacterPanelsClick(Sender: TObject);
- procedure TreeKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- procedure acStayOnTopExecute(Sender: TObject);
- procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- procedure acExpandExecute(Sender: TObject);
- private
- FSelectedItems: Integer;
- FScene: TGLScene;
- FObjectNode, FSceneObjects: TTreeNode;
- FCurrentDesigner: IDesigner;
- FLastMouseDownPos: TPoint;
- FPasteOwner: TComponent;
- FPasteSelection: IDesignerSelections;
- procedure ReadScene;
- procedure ResetTree;
- (* Adds All scene objects to the TreeAll the same as in menu toolbar TBAddObjects
- for moving selection to current list of active objects in Tree *)
- function AddNodesAll(ANode: TTreeNode; AObject: TGLBaseSceneObject): TTreeNode;
- (* Adds the given scene object as well as its children to the Tree and returns
- the last add node (e.g. for selection) *)
- function AddNodes(ANode: TTreeNode; AObject: TGLBaseSceneObject): TTreeNode;
- procedure AddObjectClick(Sender: TObject);
- procedure AddBehaviourClick(Sender: TObject);
- procedure AddEffectClick(Sender: TObject);
- procedure SetObjectsSubItems(parent: TMenuItem);
- procedure SetXCollectionSubItems(parent: TMenuItem; XCollection: TXCollection; Event: TSetSubItemsEvent);
- procedure SetBehavioursSubItems(parent: TMenuItem; XCollection: TXCollection);
- procedure SetEffectsSubItems(parent: TMenuItem; XCollection: TXCollection);
- procedure OnBaseSceneObjectNameChanged(Sender: TObject);
- function IsValidClipBoardNode: Boolean;
- function IsPastePossible: Boolean;
- procedure ShowBehaviours(BaseSceneObject: TGLBaseSceneObject);
- procedure ShowEffects(BaseSceneObject: TGLBaseSceneObject);
- procedure ShowBehavioursAndEffects(BaseSceneObject: TGLBaseSceneObject);
- procedure EnableAndDisableActions();
- function CanPaste(obj, destination: TGLBaseSceneObject): Boolean;
- procedure CopyComponents(Root: TComponent; const Components: IDesignerSelections);
- procedure MethodError(Reader: TReader; const MethodName: string; var Address: Pointer; var Error: Boolean);
- function PasteComponents(AOwner, AParent: TComponent; const Components: IDesignerSelections): Boolean;
- procedure ReaderSetName(Reader: TReader; Component: TComponent; var Name: string);
- procedure ComponentRead(Component: TComponent);
- function UniqueName(Component: TComponent): string;
- (* We can not use the IDE to define this event because the
- prototype is not the same between Delphi and Kylix !! *)
- procedure TreeEdited(Sender: TObject; Node: TTreeNode; var S: string);
- protected
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- public
- procedure SetScene(Scene: TGLScene; Designer: IDesigner);
- end;
- function GLSceneEditorForm: TGLSceneEditorForm;
- procedure ReleaseGLSceneEditorForm;
- // ------------------------------------------------------------------
- implementation
- // ------------------------------------------------------------------
- {$R *.dfm}
- const
- cRegistryKey = 'Software\GLScene\GLSceneEditor';
- var
- vGLSceneEditorForm: TGLSceneEditorForm;
- function GLSceneEditorForm: TGLSceneEditorForm;
- begin
- if not Assigned(vGLSceneEditorForm) then
- vGLSceneEditorForm := TGLSceneEditorForm.Create(nil);
- Result := vGLSceneEditorForm;
- end;
- procedure ReleaseGLSceneEditorForm;
- begin
- if Assigned(vGLSceneEditorForm) then
- begin
- vGLSceneEditorForm.Free;
- vGLSceneEditorForm := nil;
- end;
- end;
- function ReadRegistryInteger(reg: TRegistry; const Name: string;
- defaultValue: Integer): Integer;
- begin
- if reg.ValueExists(name) then
- Result := reg.ReadInteger(name)
- else
- Result := defaultValue;
- end;
- function FindNodeByData(treeNodes: TTreeNodes; data: Pointer;
- baseNode: TTreeNode = nil): TTreeNode;
- var
- n: TTreeNode;
- begin
- Result := nil;
- if Assigned(baseNode) then
- begin
- n := baseNode.getFirstChild;
- while Assigned(n) do
- begin
- if n.data = data then
- begin
- Result := n;
- Break;
- end
- else if n.HasChildren then
- begin
- Result := FindNodeByData(treeNodes, data, n);
- if Assigned(Result) then
- Break;
- end;
- n := baseNode.GetNextChild(n);
- end;
- end
- else
- begin
- n := treeNodes.GetFirstNode;
- while Assigned(n) do
- begin
- if n.data = data then
- begin
- Result := n;
- Break;
- end
- else if n.HasChildren then
- begin
- Result := FindNodeByData(treeNodes, data, n);
- if Assigned(Result) then
- Break;
- end;
- n := n.getNextSibling;
- end;
- end;
- end;
- // ----------------- TGLSceneEditorForm ---------------------------------------------------------------------------------
- procedure TGLSceneEditorForm.SetScene(Scene: TGLScene; Designer: IDesigner);
- begin
- if Assigned(FScene) then
- FScene.RemoveFreeNotification(Self);
- FScene := Scene;
- FCurrentDesigner := Designer;
- ResetTree;
- // TreeView.Items.Clear;
- BehavioursListView.Items.Clear;
- EffectsListView.Items.Clear;
- if Assigned(FScene) then
- begin
- FScene.FreeNotification(Self);
- ReadScene;
- Caption := strGLSceneEditor + ' : ' + FScene.Name;
- end
- else
- Caption := strGLSceneEditor;
- TreeChange(Self, nil);
- if Assigned(FScene) then
- begin
- Tree.Enabled := true;
- BehavioursListView.Enabled := true;
- EffectsListView.Enabled := true;
- ACLoadScene.Enabled := true;
- ACSaveScene.Enabled := true;
- FSelectedItems := SCENE_SELECTED;
- EnableAndDisableActions;
- end
- else
- begin
- Tree.Enabled := False;
- BehavioursListView.Enabled := False;
- EffectsListView.Enabled := False;
- ACLoadScene.Enabled := False;
- ACSaveScene.Enabled := False;
- ACAddObject.Enabled := False;
- ACAddBehaviour.Enabled := False;
- ACAddEffect.Enabled := False;
- ACDeleteObject.Enabled := False;
- ACMoveUp.Enabled := False;
- ACMoveDown.Enabled := False;
- ACCut.Enabled := False;
- ACCopy.Enabled := False;
- ACPaste.Enabled := False;
- end;
- ShowBehavioursAndEffects(nil);
- end;
- procedure TGLSceneEditorForm.FormCreate(Sender: TObject);
- var
- CurrentNode: TTreeNode;
- reg: TRegistry;
- begin
- RegisterGLBaseSceneObjectNameChangeEvent(OnBaseSceneObjectNameChanged);
- Tree.Images := ObjectManager.ObjectIcons;
- Tree.Indent := ObjectManager.ObjectIcons.Width;
- with Tree.Items do
- begin
- // first add the scene root
- CurrentNode := Add(nil, strSceneRoot);
- with CurrentNode do
- begin
- ImageIndex := ObjectManager.SceneRootIndex;
- SelectedIndex := ImageIndex;
- end;
- // and the root for all objects
- FObjectNode := AddChild(CurrentNode, strObjectRoot);
- FSceneObjects := FObjectNode;
- with FObjectNode do
- begin
- ImageIndex := ObjectManager.ObjectRootIndex;
- SelectedIndex := ImageIndex;
- end;
- end;
- // Build SubMenus
- SetObjectsSubItems(MIAddObject);
- MIAddObject.SubMenuImages := ObjectManager.ObjectIcons;
- SetObjectsSubItems(PMToolBar.Items);
- PMToolBar.Images := ObjectManager.ObjectIcons;
- SetBehavioursSubItems(MIAddBehaviour, nil);
- SetBehavioursSubItems(PMBehavioursToolbar.Items, nil);
- SetEffectsSubItems(MIAddEffect, nil);
- SetEffectsSubItems(PMEffectsToolbar.Items, nil);
- reg := TRegistry.Create;
- try
- if reg.OpenKey(cRegistryKey, true) then
- begin
- if reg.ValueExists('CharacterPanels') then
- TBCharacterPanels.Down := reg.ReadBool('CharacterPanels');
- TBCharacterPanelsClick(Self);
- if reg.ValueExists('ExpandTree') then
- TBExpand.Down := reg.ReadBool('ExpandTree');
- ACExpandExecute(Self);
- Left := ReadRegistryInteger(reg, 'Left', Left);
- Top := ReadRegistryInteger(reg, 'Top', Top);
- Width := ReadRegistryInteger(reg, 'Width', 250);
- Height := ReadRegistryInteger(reg, 'Height', Height);
- end;
- finally
- reg.Free;
- end;
- // Trigger the event OnEdited manualy
- Tree.OnEdited := TreeEdited;
- end;
- procedure TGLSceneEditorForm.FormDestroy(Sender: TObject);
- var
- reg: TRegistry;
- begin
- DeRegisterGLBaseSceneObjectNameChangeEvent(OnBaseSceneObjectNameChanged);
- reg := TRegistry.Create;
- try
- if reg.OpenKey(cRegistryKey, true) then
- begin
- reg.WriteBool('CharacterPanels', TBCharacterPanels.Down);
- reg.WriteBool('ExpandTree', TBExpand.Down);
- reg.WriteInteger('Left', Left);
- reg.WriteInteger('Top', Top);
- reg.WriteInteger('Width', Width);
- reg.WriteInteger('Height', Height);
- end;
- finally
- reg.Free;
- end;
- end;
- procedure TGLSceneEditorForm.FormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- begin
- if Key = VK_F12 then
- end;
- // ----------------------------------------------------------------------------------------------------------------------
- procedure TGLSceneEditorForm.ReadScene;
- var
- I: Integer;
- begin
- Tree.Items.BeginUpdate;
- with FScene do
- begin
- if Assigned(Objects) then
- begin
- FObjectNode.data := Objects;
- with Objects do
- for I := 0 to Count - 1 do
- AddNodes(FObjectNode, Children[I]);
- FObjectNode.Expand(False);
- end;
- end;
- Tree.Items.EndUpdate;
- end;
- // ----------------------------------------------------------------------------------------------------------------------
- procedure TGLSceneEditorForm.ResetTree;
- begin
- // delete all subtrees (empty tree)
- Tree.Items.BeginUpdate;
- try
- with FObjectNode do
- begin
- DeleteChildren;
- data := nil;
- parent.Expand(true);
- end;
- finally
- Tree.Items.EndUpdate;
- end;
- end;
- // ----------------------------------------------------------------------------------------------------------------------
- function TGLSceneEditorForm.AddNodes(ANode: TTreeNode;
- AObject: TGLBaseSceneObject): TTreeNode;
- var
- I: Integer;
- CurrentNode: TTreeNode;
- begin
- if IsSubComponent(AObject) then
- begin
- Result := Tree.Selected;
- Exit;
- end
- else
- begin
- Result := Tree.Items.AddChildObject(ANode, AObject.Name, AObject);
- Result.ImageIndex := ObjectManager.GetImageIndex
- (TGLSceneObjectClass(AObject.ClassType));
- Result.SelectedIndex := Result.ImageIndex;
- CurrentNode := Result;
- for I := 0 to AObject.Count - 1 do
- Result := AddNodes(CurrentNode, AObject[I]);
- end;
- end;
- procedure TGLSceneEditorForm.SetObjectsSubItems(parent: TMenuItem);
- var
- objectList: TStringList;
- i, j: Integer;
- Item, currentParent: TMenuItem;
- currentCategory: string;
- soc: TGLSceneObjectClass;
- begin
- objectList := TStringList.Create;
- try
- ObjectManager.GetRegisteredSceneObjects(objectList);
- for i := 0 to objectList.Count - 1 do
- if objectList[i] <> '' then
- begin
- with ObjectManager do
- currentCategory :=
- GetCategory(TGLSceneObjectClass(objectList.Objects[i]));
- if currentCategory = '' then
- currentParent := parent
- else
- begin
- currentParent := NewItem(currentCategory, 0, False, true, nil, 0, '');
- parent.Add(currentParent);
- end;
- for j := I to objectList.Count - 1 do
- if objectList[j] <> '' then
- with ObjectManager do
- begin
- soc := TGLSceneObjectClass(objectList.Objects[j]);
- if currentCategory = GetCategory(soc) then
- begin
- Item := NewItem(objectList[j], 0, False, true,
- AddObjectClick, 0, '');
- Item.ImageIndex := GetImageIndex(soc);
- Item.Tag := Integer(soc);
- currentParent.Add(Item);
- objectList[j] := '';
- if currentCategory = '' then
- Break;
- end;
- end;
- end;
- finally
- objectList.Free;
- end;
- end;
- procedure TGLSceneEditorForm.SetXCollectionSubItems(parent: TMenuItem;
- XCollection: TXCollection; Event: TSetSubItemsEvent);
- var
- i: Integer;
- list: TList;
- XCollectionItemClass: TXCollectionItemClass;
- mi: TMenuItem;
- begin
- parent.Clear;
- if Assigned(XCollection) then
- begin
- list := GetXCollectionItemClassesList(XCollection.ItemsClass);
- try
- for i := 0 to list.Count - 1 do
- begin
- XCollectionItemClass := TXCollectionItemClass(list[i]);
- mi := TMenuItem.Create(owner);
- mi.Caption := XCollectionItemClass.FriendlyName;
- mi.OnClick := Event; // AddBehaviourClick;
- mi.Tag := Integer(XCollectionItemClass);
- if Assigned(XCollection) then
- mi.Enabled := XCollection.CanAdd(XCollectionItemClass)
- else
- mi.Enabled := TBAddBehaviours.Enabled;
- parent.Add(mi);
- end;
- finally
- list.Free;
- end;
- end;
- end;
- procedure TGLSceneEditorForm.SetBehavioursSubItems(parent: TMenuItem;
- XCollection: TXCollection);
- begin
- SetXCollectionSubItems(parent, XCollection, AddBehaviourClick);
- end;
- procedure TGLSceneEditorForm.SetEffectsSubItems(parent: TMenuItem;
- XCollection: TXCollection);
- begin
- SetXCollectionSubItems(parent, XCollection, AddEffectClick);
- end;
- procedure TGLSceneEditorForm.AddObjectClick(Sender: TObject);
- var
- AParent, AObject: TGLBaseSceneObject;
- Node: TTreeNode;
- begin
- if Assigned(FCurrentDesigner) then
- with Tree do
- if Assigned(Selected) and (Selected.Level > 0) then
- begin
- AParent := TGLBaseSceneObject(Selected.data);
- // FCurrentDesigner.cr
- AObject := TGLBaseSceneObject
- (FCurrentDesigner.CreateComponent
- (TGLSceneObjectClass(TMenuItem(Sender).Tag), AParent, 0, 0, 0, 0));
- TComponent(AObject).DesignInfo := 0;
- AParent.AddChild(AObject);
- Node := AddNodes(Selected, AObject);
- Node.Selected := true;
- FCurrentDesigner.Modified;
- end;
- end;
- procedure TGLSceneEditorForm.AddBehaviourClick(Sender: TObject);
- var
- XCollectionItemClass: TXCollectionItemClass;
- AParent: TGLBaseSceneObject;
- begin
- if Assigned(Tree.Selected) then
- begin
- AParent := TGLBaseSceneObject(Tree.Selected.data);
- XCollectionItemClass := TXCollectionItemClass((Sender as TMenuItem).Tag);
- XCollectionItemClass.Create(AParent.Behaviours);
- // PrepareListView;
- ShowBehaviours(AParent);
- // ListView.Selected:=ListView.FindData(0, XCollectionItem, True, False);
- FCurrentDesigner.Modified;
- end;
- end;
- procedure TGLSceneEditorForm.AddEffectClick(Sender: TObject);
- var
- XCollectionItemClass: TXCollectionItemClass;
- AParent: TGLBaseSceneObject;
- begin
- if Assigned(Tree.Selected) then
- begin
- AParent := TGLBaseSceneObject(Tree.Selected.data);
- XCollectionItemClass := TXCollectionItemClass((Sender as TMenuItem).Tag);
- XCollectionItemClass.Create(AParent.Effects);
- // PrepareListView;
- ShowEffects(AParent);
- // ListView.Selected:=ListView.FindData(0, XCollectionItem, True, False);
- FCurrentDesigner.Modified;
- end;
- end;
- procedure TGLSceneEditorForm.TreeDragOver(Sender, Source: TObject;
- X, Y: Integer; State: TDragState; var Accept: Boolean);
- var
- Target: TTreeNode;
- begin
- Accept := False;
- if Source = Tree then
- with Tree do
- begin
- Target := DropTarget;
- Accept := Assigned(Target) and (Selected <> Target) and
- Assigned(Target.data) and (not Target.HasAsParent(Selected));
- end;
- end;
- procedure TGLSceneEditorForm.TreeDragDrop(Sender, Source: TObject;
- X, Y: Integer);
- var
- SourceNode, DestinationNode: TTreeNode;
- SourceObject, DestinationObject: TGLBaseSceneObject;
- begin
- if Assigned(FCurrentDesigner) then
- begin
- DestinationNode := Tree.DropTarget;
- if Assigned(DestinationNode) and (Source = Tree) then
- begin
- SourceNode := TTreeView(Source).Selected;
- SourceObject := SourceNode.data;
- DestinationObject := DestinationNode.data;
- DestinationObject.Insert(0, SourceObject);
- SourceNode.MoveTo(DestinationNode, naAddChildFirst);
- TreeChange(Self, nil);
- FCurrentDesigner.Modified;
- end;
- end;
- end;
- procedure TGLSceneEditorForm.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- if (FScene = AComponent) and (Operation = opRemove) then
- begin
- FScene := nil;
- SetScene(nil, nil);
- end;
- inherited;
- end;
- procedure TGLSceneEditorForm.OnBaseSceneObjectNameChanged(Sender: TObject);
- var
- n: TTreeNode;
- begin
- n := FindNodeByData(Tree.Items, Sender);
- if Assigned(n) then
- n.Text := (Sender as TGLBaseSceneObject).Name;
- end;
- procedure TGLSceneEditorForm.TreeAllChange(Sender: TObject; Node: TTreeNode);
- var
- selNode : TTreeNode;
- BaseSceneObject1: TGLBaseSceneObject;
- begin
- // not implemented yet
- (*
- if Assigned(FCurrentDesigner) then
- begin
- if Node <> nil then
- begin
- BaseSceneObject1 := TGLBaseSceneObject(Node.data);
- end;
- EnableAndDisableActions();
- end;
- *)
- end;
- procedure TGLSceneEditorForm.TreeChange(Sender: TObject; Node: TTreeNode);
- var
- // selNode : TTreeNode;
- BaseSceneObject1: TGLBaseSceneObject;
- begin
- if Assigned(FCurrentDesigner) then
- begin
- if Node <> nil then
- begin
- BaseSceneObject1 := TGLBaseSceneObject(Node.data);
- if BaseSceneObject1 <> nil then
- begin
- ShowBehavioursAndEffects(BaseSceneObject1);
- end;
- end;
- EnableAndDisableActions();
- end;
- end;
- procedure TGLSceneEditorForm.TreeEditing(Sender: TObject; Node: TTreeNode;
- var AllowEdit: Boolean);
- begin
- AllowEdit := (Node.Level > 1);
- end;
- procedure TGLSceneEditorForm.ShowBehaviours(BaseSceneObject
- : TGLBaseSceneObject);
- var
- I: Integer;
- DisplayedName: string;
- begin
- BehavioursListView.Items.Clear;
- BehavioursListView.Items.BeginUpdate;
- if Assigned(BaseSceneObject) then
- begin
- for I := 0 to BaseSceneObject.Behaviours.Count - 1 do
- begin
- with BehavioursListView.Items.Add do
- begin
- DisplayedName := BaseSceneObject.Behaviours[I].Name;
- if DisplayedName = '' then
- DisplayedName := '(unnamed)';
- Caption := IntToStr(I) + ' - ' + DisplayedName;
- SubItems.Add(BaseSceneObject.Behaviours[I].FriendlyName);
- data := BaseSceneObject.Behaviours[I];
- end;
- end;
- end;
- BehavioursListView.Items.EndUpdate;
- end;
- procedure TGLSceneEditorForm.ShowEffects(BaseSceneObject: TGLBaseSceneObject);
- var
- I: Integer;
- DisplayedName: string;
- begin
- EffectsListView.Items.Clear;
- EffectsListView.Items.BeginUpdate;
- if Assigned(BaseSceneObject) then
- begin
- for I := 0 to BaseSceneObject.Effects.Count - 1 do
- begin
- with EffectsListView.Items.Add do
- begin
- DisplayedName := BaseSceneObject.Effects[I].Name;
- if DisplayedName = '' then
- DisplayedName := '(unnamed)';
- Caption := IntToStr(I) + ' - ' + DisplayedName;
- SubItems.Add(BaseSceneObject.Effects[I].FriendlyName);
- Data := BaseSceneObject.Effects[I];
- end;
- end;
- end;
- EffectsListView.Items.EndUpdate;
- end;
- function TGLSceneEditorForm.AddNodesAll(ANode: TTreeNode; AObject: TGLBaseSceneObject): TTreeNode;
- var
- I: Integer;
- CurrentNode: TTreeNode;
- begin
- if IsSubComponent(AObject) then
- begin
- Result := Tree.Selected;
- Exit;
- end
- else
- begin
- Result := Tree.Items.AddChildObject(ANode, AObject.Name, AObject);
- Result.ImageIndex := ObjectManager.GetImageIndex
- (TGLSceneObjectClass(AObject.ClassType));
- Result.SelectedIndex := Result.ImageIndex;
- CurrentNode := Result;
- for I := 0 to AObject.Count - 1 do
- Result := AddNodes(CurrentNode, AObject[I]);
- end;
- end;
- procedure TGLSceneEditorForm.ShowBehavioursAndEffects(BaseSceneObject
- : TGLBaseSceneObject);
- begin
- ShowBehaviours(BaseSceneObject);
- ShowEffects(BaseSceneObject);
- end;
- procedure TGLSceneEditorForm.TreeEdited(Sender: TObject; Node: TTreeNode;
- var S: string);
- var
- BaseSceneObject1: TGLBaseSceneObject;
- begin
- if Assigned(FCurrentDesigner) then
- begin
- // renaming a node means renaming a scene object
- BaseSceneObject1 := TGLBaseSceneObject(Node.data);
- if FScene.FindSceneObject(S) = nil then
- BaseSceneObject1.Name := S
- else
- begin
- Messagedlg('A component named ' + S + ' already exists', mtWarning,
- [mbok], 0);
- S := BaseSceneObject1.Name;
- end;
- ShowBehavioursAndEffects(BaseSceneObject1);
- FCurrentDesigner.Modified;
- end;
- end;
- procedure TGLSceneEditorForm.TreeMouseDown(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- FLastMouseDownPos := Point(X, Y);
- end;
- procedure TGLSceneEditorForm.TreeMouseMove(Sender: TObject; Shift: TShiftState;
- X, Y: Integer);
- var
- Node: TTreeNode;
- begin
- if Shift = [ssLeft] then
- begin
- Node := Tree.Selected;
- if Assigned(Node) and (Node.Level > 1) then
- if (Abs(FLastMouseDownPos.X - X) > 4) or (Abs(FLastMouseDownPos.Y - Y) > 4)
- then
- Tree.BeginDrag(False);
- end;
- end;
- procedure TGLSceneEditorForm.TreeEnter(Sender: TObject);
- begin
- if Assigned(FCurrentDesigner) and Assigned(Tree.Selected) then
- FCurrentDesigner.SelectComponent(TGLBaseSceneObject(Tree.Selected.data));
- FSelectedItems := SCENE_SELECTED;
- EnableAndDisableActions();
- end;
- procedure TGLSceneEditorForm.acDeleteObjectExecute(Sender: TObject);
- var
- anObject: TGLBaseSceneObject;
- allowed, keepChildren: Boolean;
- confirmMsg: string;
- buttons: TMsgDlgButtons;
- begin
- if FSelectedItems = BEHAVIOURS_SELECTED then
- begin
- DeleteBaseBehaviour(BehavioursListView);
- FCurrentDesigner.SelectComponent(TGLBaseSceneObject(Tree.Selected.data));
- ShowBehaviours(TGLBaseSceneObject(Tree.Selected.data));
- end
- else if FSelectedItems = EFFECTS_SELECTED then
- begin
- DeleteBaseBehaviour(EffectsListView);
- FCurrentDesigner.SelectComponent(TGLBaseSceneObject(Tree.Selected.data));
- ShowEffects(TGLBaseSceneObject(Tree.Selected.data));
- end
- else if FSelectedItems = SCENE_SELECTED then
- begin
- if Assigned(Tree.Selected) and (Tree.Selected.Level > 1) then
- begin
- anObject := TGLBaseSceneObject(Tree.Selected.data);
- // ask for confirmation
- if anObject.Name <> '' then
- confirmMsg := 'Delete ' + anObject.Name
- else
- confirmMsg := 'Delete the marked object';
- buttons := [mbok, mbCancel];
- // are there children to care for?
- // mbAll exist only on Windows ...
- if (anObject.Count > 0) and (not anObject.HasSubChildren) then
- begin
- confirmMsg := confirmMsg + ' only or with ALL its children?';
- buttons := [mbAll] + buttons;
- end
- else
- confirmMsg := confirmMsg + '?';
- case Messagedlg(confirmMsg, mtConfirmation, buttons, 0) of
- mrAll:
- begin
- keepChildren := False;
- allowed := true;
- end;
- mrOK:
- begin
- keepChildren := true;
- allowed := true;
- end;
- mrCancel:
- begin
- allowed := False;
- keepChildren := true;
- end;
- else
- allowed := False;
- keepChildren := true;
- end;
- // deletion allowed?
- if allowed then
- begin
- if keepChildren = true then
- while Tree.Selected.Count > 0 do
- Tree.Selected.Item[0].MoveTo(Tree.Selected, naAdd);
- // previous line should be "naInsert" if children are to remain in position of parent
- // (would require changes to TGLBaseSceneObject.Remove)
- Tree.Selected.Free;
- FCurrentDesigner.SelectComponent(nil);
- anObject.parent.Remove(anObject, keepChildren);
- anObject.Free;
- end
- end;
- end;
- end;
- procedure TGLSceneEditorForm.acExpandExecute(Sender: TObject);
- begin
- if FSceneObjects <> nil then
- try
- Tree.Items.BeginUpdate;
- if TBExpand.Down then
- Tree.FullExpand
- else
- begin
- FSceneObjects.Collapse(True);
- FSceneObjects.Expand(False);
- end;
- finally
- Tree.Items.EndUpdate;
- end;
- end;
- procedure TGLSceneEditorForm.acMoveUpExecute(Sender: TObject);
- var
- Node: TTreeNode;
- prevData: Pointer;
- begin
- if FSelectedItems = BEHAVIOURS_SELECTED then
- begin
- prevData := BehavioursListView.Selected.data;
- TGLBaseBehaviour(prevData).MoveUp;
- ShowBehaviours(TGLBaseSceneObject(Tree.Selected.data));
- BehavioursListView.Selected := BehavioursListView.FindData(0, prevData,
- true, False);
- FCurrentDesigner.Modified;
- end
- else if FSelectedItems = EFFECTS_SELECTED then
- begin
- prevData := EffectsListView.Selected.data;
- TGLBaseBehaviour(prevData).MoveUp;
- ShowEffects(TGLBaseSceneObject(Tree.Selected.data));
- EffectsListView.Selected := EffectsListView.FindData(0, prevData,
- true, False);
- FCurrentDesigner.Modified;
- end
- else if FSelectedItems = SCENE_SELECTED then
- begin
- if ACMoveUp.Enabled then
- begin
- Node := Tree.Selected;
- if Assigned(Node) then
- begin
- Node.MoveTo(Node.GetPrevSibling, naInsert);
- with TGLBaseSceneObject(Node.data) do
- begin
- MoveUp;
- Update;
- end;
- TreeChange(Self, Node);
- FCurrentDesigner.Modified;
- end;
- end;
- end;
- end;
- procedure TGLSceneEditorForm.acMoveDownExecute(Sender: TObject);
- var
- Node: TTreeNode;
- prevData: Pointer;
- begin
- if FSelectedItems = BEHAVIOURS_SELECTED then
- begin
- prevData := BehavioursListView.Selected.data;
- TGLBaseBehaviour(prevData).MoveDown;
- ShowBehaviours(TGLBaseSceneObject(Tree.Selected.data));
- BehavioursListView.Selected := BehavioursListView.FindData(0, prevData,
- true, False);
- FCurrentDesigner.Modified;
- end
- else if FSelectedItems = EFFECTS_SELECTED then
- begin
- prevData := EffectsListView.Selected.data;
- TGLBaseBehaviour(prevData).MoveDown;
- ShowEffects(TGLBaseSceneObject(Tree.Selected.data));
- EffectsListView.Selected := EffectsListView.FindData(0, prevData,
- true, False);
- FCurrentDesigner.Modified;
- end
- else if FSelectedItems = SCENE_SELECTED then
- begin
- if ACMoveDown.Enabled then
- begin
- Node := Tree.Selected;
- if Assigned(Node) then
- begin
- Node.getNextSibling.MoveTo(Node, naInsert);
- with TGLBaseSceneObject(Node.data) do
- begin
- MoveDown;
- Update;
- end;
- TreeChange(Self, Node);
- FCurrentDesigner.Modified;
- end;
- end;
- end;
- end;
- procedure TGLSceneEditorForm.acAddObjectExecute(Sender: TObject);
- begin
- TBAddObjects.CheckMenuDropdown;
- end;
- procedure TGLSceneEditorForm.acStayOnTopExecute(Sender: TObject);
- begin
- if TBStayOnTop.Down then
- FormStyle := fsStayOnTop
- else
- FormStyle := fsNormal;
- end;
- procedure TGLSceneEditorForm.acSaveSceneExecute(Sender: TObject);
- begin
- if SaveDialog.Execute then
- FScene.SaveToFile(SaveDialog.FileName);
- end;
- procedure TGLSceneEditorForm.acLoadSceneExecute(Sender: TObject);
- begin
- if OpenDialog.Execute then
- begin
- FScene.LoadFromFile(OpenDialog.FileName);
- ResetTree;
- ReadScene;
- ShowBehavioursAndEffects(nil);
- end;
- end;
- procedure TGLSceneEditorForm.acInfoExecute(Sender: TObject);
- var
- AScene: TGLSceneViewer;
- begin
- AScene := TGLSceneViewer.Create(Self);
- AScene.Name := 'GLSceneEditor';
- AScene.Width := 0;
- AScene.Height := 0;
- AScene.parent := Self;
- try
- AScene.Buffer.ShowInfo;
- finally
- AScene.Free;
- end;
- end;
- function TGLSceneEditorForm.IsValidClipBoardNode: Boolean;
- var
- selNode: TTreeNode;
- begin
- selNode := Tree.Selected;
- Result := ((selNode <> nil) and (selNode.parent <> nil) and
- (selNode.parent.parent <> nil));
- end;
- function TGLSceneEditorForm.IsPastePossible: Boolean;
- function PossibleStream(const S: string): Boolean;
- var
- I: Integer;
- begin
- Result := true;
- for I := 1 to Length(S) - 6 do
- begin
- if CharInSet(S[I], ['O', 'o']) and
- (CompareText(Copy(S, I, 6), 'OBJECT') = 0) then
- Exit;
- if not CharInSet(S[I], [' ', #9, #13, #10]) then
- Break;
- end;
- Result := False;
- end;
- var
- selNode: TTreeNode;
- anObject, destination: TGLBaseSceneObject;
- ComponentList: IDesignerSelections;
- TmpContainer: TComponent;
- begin
- selNode := Tree.Selected;
- if (selNode <> nil) and (selNode.parent <> nil)
- and (ClipBoard.HasFormat(CF_COMPONENT) or (ClipBoard.HasFormat(CF_TEXT) and
- PossibleStream(ClipBoard.AsText))) then
- begin
- TmpContainer := TComponent.Create(Self);
- try
- ComponentList := TDesignerSelections.Create;
- if PasteComponents(TmpContainer, TmpContainer, ComponentList) then
- if (ComponentList.Count > 0) and (ComponentList[0] is TGLBaseSceneObject)
- then
- begin
- anObject := TGLBaseSceneObject(ComponentList[0]);
- destination := TGLBaseSceneObject(selNode.data);
- Result := CanPaste(anObject, destination);
- end
- else
- Result := False
- else
- Result := False;
- finally
- TmpContainer.Free;
- end;
- end
- else
- Result := False;
- end;
- function TGLSceneEditorForm.CanPaste(obj, destination
- : TGLBaseSceneObject): Boolean;
- begin
- Result := Assigned(obj) and Assigned(destination);
- end;
- procedure TGLSceneEditorForm.acCopyExecute(Sender: TObject);
- var
- ComponentList: IDesignerSelections;
- begin
- ComponentList := TDesignerSelections.Create;
- ComponentList.Add(TGLBaseSceneObject(Tree.Selected.data));
- CopyComponents(FScene.owner, ComponentList);
- ACPaste.Enabled := IsPastePossible;
- end;
- procedure TGLSceneEditorForm.acCutExecute(Sender: TObject);
- var
- AObject: TGLBaseSceneObject;
- ComponentList: IDesignerSelections;
- begin
- if IsValidClipBoardNode then
- begin
- AObject := TGLBaseSceneObject(Tree.Selected.data);
- ComponentList := TDesignerSelections.Create;
- ComponentList.Add(TGLBaseSceneObject(Tree.Selected.data));
- CopyComponents(FScene.owner, ComponentList);
- AObject.parent.Remove(AObject, False);
- AObject.Free;
- Tree.Selected.Free;
- ACPaste.Enabled := IsPastePossible;
- end;
- end;
- procedure TGLSceneEditorForm.acPasteExecute(Sender: TObject);
- var
- selNode: TTreeNode;
- destination: TGLBaseSceneObject;
- ComponentList: IDesignerSelections;
- t: Integer;
- begin
- selNode := Tree.Selected;
- if (selNode <> nil) and (selNode.parent <> nil) then
- begin
- destination := TGLBaseSceneObject(selNode.data);
- ComponentList := TDesignerSelections.Create;
- PasteComponents(FScene.owner, destination, ComponentList);
- if (ComponentList.Count > 0) and
- (CanPaste(TGLBaseSceneObject(ComponentList[0]), destination)) then
- begin
- for t := 0 to ComponentList.Count - 1 do
- AddNodes(selNode, TGLBaseSceneObject(ComponentList[t]));
- selNode.Expand(False);
- end;
- FCurrentDesigner.Modified;
- end;
- end;
- procedure TGLSceneEditorForm.CopyComponents(Root: TComponent;
- const Components: IDesignerSelections);
- var
- S: TMemoryStream;
- W: TWriter;
- I: Integer;
- begin
- S := TMemoryStream.Create;
- try
- W := TWriter.Create(S, 1024);
- try
- W.Root := Root;
- for I := 0 to Components.Count - 1 do
- begin
- W.WriteSignature;
- W.WriteComponent(TComponent(Components[I]));
- end;
- W.WriteListEnd;
- finally
- W.Free;
- end;
- CopyStreamToClipboard(S);
- finally
- S.Free;
- end;
- end;
- procedure TGLSceneEditorForm.MethodError(Reader: TReader;
- const MethodName: string; var Address: Pointer; var Error: Boolean);
- begin
- // error is true because Address is nil in csDesigning
- Error := False;
- end;
- function TGLSceneEditorForm.PasteComponents(AOwner, AParent: TComponent;
- const Components: IDesignerSelections): Boolean;
- var
- S: TStream;
- R: TReader;
- begin
- // catch GetClipboardStream exceptions that can easilly occured
- try
- S := GetClipboardStream;
- try
- R := TReader.Create(S, 1024);
- try
- R.OnSetName := ReaderSetName;
- R.OnFindMethod := MethodError;
- FPasteOwner := AOwner;
- FPasteSelection := Components;
- R.ReadComponents(AOwner, AParent, ComponentRead);
- Result := true;
- finally
- R.Free;
- end;
- finally
- S.Free;
- end;
- finally
- end;
- end;
- procedure TGLSceneEditorForm.ReaderSetName(Reader: TReader;
- Component: TComponent; var Name: string);
- begin
- if (Reader.Root = FPasteOwner) and (FPasteOwner.FindComponent(Name) <> nil)
- then
- Name := UniqueName(Component);
- end;
- function TGLSceneEditorForm.UniqueName(Component: TComponent): string;
- begin
- Result := FCurrentDesigner.UniqueName(Component.ClassName);
- end;
- procedure TGLSceneEditorForm.ComponentRead(Component: TComponent);
- begin
- FPasteSelection.Add(Component);
- end;
- procedure TGLSceneEditorForm.BehavioursListViewEnter(Sender: TObject);
- begin
- if Assigned(FCurrentDesigner) and Assigned(BehavioursListView.Selected) then
- FCurrentDesigner.SelectComponent
- (TGLBaseBehaviour(BehavioursListView.Selected.data));
- FSelectedItems := BEHAVIOURS_SELECTED;
- EnableAndDisableActions();
- end;
- procedure TGLSceneEditorForm.EffectsListViewEnter(Sender: TObject);
- begin
- if Assigned(FCurrentDesigner) and Assigned(EffectsListView.Selected) then
- FCurrentDesigner.SelectComponent
- (TGLBaseBehaviour(EffectsListView.Selected.data));
- FSelectedItems := EFFECTS_SELECTED;
- EnableAndDisableActions();
- end;
- procedure TGLSceneEditorForm.acAddBehaviourExecute(Sender: TObject);
- begin
- TBAddBehaviours.CheckMenuDropdown
- end;
- procedure TGLSceneEditorForm.DeleteBaseBehaviour(ListView: TListView);
- begin
- if ListView.Selected <> nil then
- begin
- FCurrentDesigner.Modified;
- FCurrentDesigner.NoSelection;
- TXCollectionItem(ListView.Selected.data).Free;
- ListView.Selected.Free;
- // ListViewChange(Self, nil, ctState);
- ShowBehavioursAndEffects(TGLBaseSceneObject(Tree.Selected.data));
- end;
- end;
- procedure TGLSceneEditorForm.pmBehavioursToolbarPopup(Sender: TObject);
- var
- object1: TGLBaseSceneObject;
- begin
- if (Tree.Selected) <> nil then
- begin
- object1 := TGLBaseSceneObject(Tree.Selected.data);
- SetBehavioursSubItems(PMBehavioursToolbar.Items, object1.Behaviours);
- end;
- end;
- procedure TGLSceneEditorForm.pmEffectsToolbarPopup(Sender: TObject);
- var
- object1: TGLBaseSceneObject;
- begin
- if (Tree.Selected) <> nil then
- begin
- object1 := TGLBaseSceneObject(Tree.Selected.data);
- SetEffectsSubItems(PMEffectsToolbar.Items, object1.Effects);
- end;
- end;
- procedure TGLSceneEditorForm.BehavioursListViewSelectItem(Sender: TObject;
- Item: TListItem; Selected: Boolean);
- begin
- EnableAndDisableActions();
- end;
- procedure TGLSceneEditorForm.acAddEffectExecute(Sender: TObject);
- begin
- TBAddEffects.CheckMenuDropdown;
- end;
- procedure TGLSceneEditorForm.EnableAndDisableActions();
- var
- selNode: TTreeNode;
- begin
- if FSelectedItems = SCENE_SELECTED then
- begin
- selNode := Tree.Selected;
- // select in Delphi IDE
- if Assigned(selNode) then
- begin
- if Assigned(selNode.data) then
- FCurrentDesigner.SelectComponent(TGLBaseSceneObject(selNode.data))
- else
- FCurrentDesigner.SelectComponent(FScene);
- // enablings
- ACAddObject.Enabled := ((selNode = FObjectNode) or selNode.HasAsParent(FObjectNode));
- ACAddBehaviour.Enabled := (selNode.HasAsParent(FObjectNode));
- ACAddEffect.Enabled := (selNode.HasAsParent(FObjectNode));
- ACDeleteObject.Enabled := (selNode.Level > 1);
- ACMoveUp.Enabled := ((selNode.Index > 0) and (selNode.Level > 1));
- ACMoveDown.Enabled := ((selNode.getNextSibling <> nil) and (selNode.Level > 1));
- ACCut.Enabled := IsValidClipBoardNode;
- ACPaste.Enabled := IsPastePossible;
- end
- else
- begin
- ACAddObject.Enabled := False;
- ACAddBehaviour.Enabled := False;
- ACAddEffect.Enabled := False;
- ACDeleteObject.Enabled := False;
- ACMoveUp.Enabled := False;
- ACMoveDown.Enabled := False;
- ACCut.Enabled := False;
- ACPaste.Enabled := False;
- end;
- // end;
- ACCopy.Enabled := ACCut.Enabled;
- end
- else if FSelectedItems = BEHAVIOURS_SELECTED then
- begin
- if (BehavioursListView.Selected <> nil) then
- begin
- FCurrentDesigner.SelectComponent
- (TGLBaseBehaviour(BehavioursListView.Selected.data));
- ACDeleteObject.Enabled := true;
- ACMoveUp.Enabled := (BehavioursListView.Selected.Index > 0);
- ACMoveDown.Enabled := (BehavioursListView.Selected.
- Index < BehavioursListView.Selected.owner.Count - 1);
- ACCut.Enabled := False;
- ACCopy.Enabled := False;
- ACPaste.Enabled := False;
- end
- else
- begin
- ACDeleteObject.Enabled := False;
- ACMoveUp.Enabled := False;
- ACMoveDown.Enabled := False;
- ACCut.Enabled := False;
- ACCopy.Enabled := False;
- ACPaste.Enabled := False;
- end;
- end
- else if FSelectedItems = EFFECTS_SELECTED then
- begin
- if (EffectsListView.Selected <> nil) then
- begin
- FCurrentDesigner.SelectComponent
- (TGLBaseBehaviour(EffectsListView.Selected.data));
- ACDeleteObject.Enabled := true;
- ACMoveUp.Enabled := (EffectsListView.Selected.Index > 0);
- ACMoveDown.Enabled := (EffectsListView.Selected.
- Index < EffectsListView.Selected.owner.Count - 1);
- ACCut.Enabled := False;
- ACCopy.Enabled := False;
- ACPaste.Enabled := False;
- end
- else
- begin
- ACDeleteObject.Enabled := False;
- ACMoveUp.Enabled := False;
- ACMoveDown.Enabled := False;
- ACCut.Enabled := False;
- ACCopy.Enabled := False;
- ACPaste.Enabled := False;
- end;
- end;
- end;
- procedure TGLSceneEditorForm.PopupMenuPopup(Sender: TObject);
- var
- obj: TObject;
- sceneObj: TGLBaseSceneObject;
- begin
- if (Tree.Selected) <> nil then
- begin
- obj := TObject(Tree.Selected.data);
- if Assigned(obj) and (obj is TGLBaseSceneObject) then
- begin
- sceneObj := TGLBaseSceneObject(obj);
- SetBehavioursSubItems(MIAddBehaviour, sceneObj.Behaviours);
- SetEffectsSubItems(MIAddEffect, sceneObj.Effects);
- end
- else
- begin
- SetBehavioursSubItems(MIAddBehaviour, nil);
- SetEffectsSubItems(MIAddEffect, nil);
- end;
- end;
- end;
- procedure TGLSceneEditorForm.TBCharacterPanelsClick(Sender: TObject);
- begin
- PABehaviours.Visible := TBCharacterPanels.Down;
- PAEffects.Visible := TBCharacterPanels.Down;
- if PABehaviours.Visible then
- Height := Height + PABehaviours.Height + PAEffects.Height
- else
- Height := Height - PABehaviours.Height - PAEffects.Height;
- end;
- procedure TGLSceneEditorForm.TreeKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- var
- FNode: TTreeNode;
- begin
- if (Key = VK_DELETE) and not Tree.IsEditing then
- begin
- Key := 0;
- ACDeleteObject.Execute;
- end;
- if Key = VK_F2 then
- begin
- FNode := Tree.Selected;
- if FNode.Level > 1 then
- begin
- FNode.EditText;
- end;
- end;
- end;
- //--------------------------------------------------------------
- initialization
- //--------------------------------------------------------------
- finalization
- ReleaseGLSceneEditorForm;
- end.
|