FmSceneEditor.pas 42 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521
  1. //
  2. // The graphics engine GLScene
  3. //
  4. unit FmSceneEditor;
  5. (* Scene Editor, for adding + removing scene objects *)
  6. interface
  7. {$I Stage.Defines.inc}
  8. uses
  9. WinApi.Windows,
  10. System.Classes,
  11. System.SysUtils,
  12. System.Win.Registry,
  13. System.ImageList,
  14. System.Actions,
  15. VCL.ActnList,
  16. VCL.Controls,
  17. VCL.Forms,
  18. VCL.ComCtrls,
  19. VCL.ImgList,
  20. VCL.Dialogs,
  21. VCL.Menus,
  22. VCL.ToolWin,
  23. VCL.ExtCtrls,
  24. VCL.StdCtrls,
  25. VCL.ClipBrd,
  26. DesignIntf,
  27. VCLEditors,
  28. GLS.Scene,
  29. GLS.SceneViewer,
  30. Stage.Strings,
  31. FmInfo,
  32. GLS.XCollection,
  33. Stage.Utils,
  34. GLS.SceneRegister;
  35. const
  36. SCENE_SELECTED = 0;
  37. BEHAVIOURS_SELECTED = 1;
  38. EFFECTS_SELECTED = 2;
  39. type
  40. TSetSubItemsEvent = procedure(Sender: TObject) of object;
  41. TGLSceneEditorForm = class(TForm)
  42. PopupMenu: TPopupMenu;
  43. MIAddObject: TMenuItem;
  44. N1: TMenuItem;
  45. MIDelObject: TMenuItem;
  46. ToolBar: TToolBar;
  47. ActionList: TActionList;
  48. TBAddObjects: TToolButton;
  49. TBMoveUp: TToolButton;
  50. pmToolBar: TPopupMenu;
  51. TBDeleteObject: TToolButton;
  52. TBMoveDown: TToolButton;
  53. acAddObject: TAction;
  54. ImageList: TImageList;
  55. acDeleteObject: TAction;
  56. acMoveUp: TAction;
  57. acMoveDown: TAction;
  58. N2: TMenuItem;
  59. MIMoveUp: TMenuItem;
  60. MIMoveDown: TMenuItem;
  61. acSaveScene: TAction;
  62. acLoadScene: TAction;
  63. OpenDialog: TOpenDialog;
  64. SaveDialog: TSaveDialog;
  65. TBLoadScene: TToolButton;
  66. TBSaveScene: TToolButton;
  67. acInfo: TAction;
  68. acCopy: TAction;
  69. acCut: TAction;
  70. acPaste: TAction;
  71. MICopy: TMenuItem;
  72. MIPaste: TMenuItem;
  73. MICut: TMenuItem;
  74. TBCut: TToolButton;
  75. TBCopy: TToolButton;
  76. TBPaste: TToolButton;
  77. pmBehavioursToolbar: TPopupMenu;
  78. acAddBehaviour: TAction;
  79. MIAddBehaviour: TMenuItem;
  80. MIAddEffect: TMenuItem;
  81. MIBehaviourSeparator: TMenuItem;
  82. acDeleteBehaviour: TAction;
  83. pmBehaviours: TPopupMenu;
  84. Delete1: TMenuItem;
  85. MoveUp1: TMenuItem;
  86. MoveDown1: TMenuItem;
  87. N4: TMenuItem;
  88. pmEffectsToolbar: TPopupMenu;
  89. acAddEffect: TAction;
  90. TBCharacterPanels: TToolButton;
  91. TBStayOnTop: TToolButton;
  92. acStayOnTop: TAction;
  93. TBSeparator4: TToolButton;
  94. TBExpand: TToolButton;
  95. acExpand: TAction;
  96. PATreeAll: TPanel;
  97. PATree: TPanel;
  98. Tree: TTreeView;
  99. TBInfo: TToolButton;
  100. PABehaviours: TPanel;
  101. ToolBarBehaviours: TToolBar;
  102. TBAddBehaviours: TToolButton;
  103. BehavioursListView: TListView;
  104. PAEffects: TPanel;
  105. EffectsListView: TListView;
  106. ToolBarEffects: TToolBar;
  107. TBAddEffects: TToolButton;
  108. TBGalleryPanel: TToolButton;
  109. TreeAll: TTreeView;
  110. procedure FormCreate(Sender: TObject);
  111. procedure TreeEditing(Sender: TObject; Node: TTreeNode; var AllowEdit: Boolean);
  112. procedure TreeDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
  113. procedure TreeDragDrop(Sender, Source: TObject; X, Y: Integer);
  114. procedure TreeAllChange(Sender: TObject; Node: TTreeNode); // or onclick to simply select
  115. procedure TreeChange(Sender: TObject; Node: TTreeNode);
  116. procedure TreeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  117. procedure TreeEnter(Sender: TObject);
  118. procedure TreeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  119. procedure acDeleteObjectExecute(Sender: TObject);
  120. procedure acMoveUpExecute(Sender: TObject);
  121. procedure acMoveDownExecute(Sender: TObject);
  122. procedure acAddObjectExecute(Sender: TObject);
  123. procedure acSaveSceneExecute(Sender: TObject);
  124. procedure acLoadSceneExecute(Sender: TObject);
  125. procedure FormDestroy(Sender: TObject);
  126. procedure acInfoExecute(Sender: TObject);
  127. procedure acCopyExecute(Sender: TObject);
  128. procedure acCutExecute(Sender: TObject);
  129. procedure acPasteExecute(Sender: TObject);
  130. procedure BehavioursListViewEnter(Sender: TObject);
  131. procedure EffectsListViewEnter(Sender: TObject);
  132. procedure acAddBehaviourExecute(Sender: TObject);
  133. procedure DeleteBaseBehaviour(ListView: TListView);
  134. procedure pmBehavioursToolbarPopup(Sender: TObject);
  135. procedure pmEffectsToolbarPopup(Sender: TObject);
  136. procedure BehavioursListViewSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
  137. procedure acAddEffectExecute(Sender: TObject);
  138. procedure PopupMenuPopup(Sender: TObject);
  139. procedure TBCharacterPanelsClick(Sender: TObject);
  140. procedure TreeKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  141. procedure acStayOnTopExecute(Sender: TObject);
  142. procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  143. procedure acExpandExecute(Sender: TObject);
  144. private
  145. FSelectedItems: Integer;
  146. FScene: TGLScene;
  147. FObjectNode, FSceneObjects: TTreeNode;
  148. FCurrentDesigner: IDesigner;
  149. FLastMouseDownPos: TPoint;
  150. FPasteOwner: TComponent;
  151. FPasteSelection: IDesignerSelections;
  152. procedure ReadScene;
  153. procedure ResetTree;
  154. (* Adds All scene objects to the TreeAll the same as in menu toolbar TBAddObjects
  155. for moving selection to current list of active objects in Tree *)
  156. function AddNodesAll(ANode: TTreeNode; AObject: TGLBaseSceneObject): TTreeNode;
  157. (* Adds the given scene object as well as its children to the Tree and returns
  158. the last add node (e.g. for selection) *)
  159. function AddNodes(ANode: TTreeNode; AObject: TGLBaseSceneObject): TTreeNode;
  160. procedure AddObjectClick(Sender: TObject);
  161. procedure AddBehaviourClick(Sender: TObject);
  162. procedure AddEffectClick(Sender: TObject);
  163. procedure SetObjectsSubItems(parent: TMenuItem);
  164. procedure SetXCollectionSubItems(parent: TMenuItem; XCollection: TXCollection; Event: TSetSubItemsEvent);
  165. procedure SetBehavioursSubItems(parent: TMenuItem; XCollection: TXCollection);
  166. procedure SetEffectsSubItems(parent: TMenuItem; XCollection: TXCollection);
  167. procedure OnBaseSceneObjectNameChanged(Sender: TObject);
  168. function IsValidClipBoardNode: Boolean;
  169. function IsPastePossible: Boolean;
  170. procedure ShowBehaviours(BaseSceneObject: TGLBaseSceneObject);
  171. procedure ShowEffects(BaseSceneObject: TGLBaseSceneObject);
  172. procedure ShowBehavioursAndEffects(BaseSceneObject: TGLBaseSceneObject);
  173. procedure EnableAndDisableActions();
  174. function CanPaste(obj, destination: TGLBaseSceneObject): Boolean;
  175. procedure CopyComponents(Root: TComponent; const Components: IDesignerSelections);
  176. procedure MethodError(Reader: TReader; const MethodName: string; var Address: Pointer; var Error: Boolean);
  177. function PasteComponents(AOwner, AParent: TComponent; const Components: IDesignerSelections): Boolean;
  178. procedure ReaderSetName(Reader: TReader; Component: TComponent; var Name: string);
  179. procedure ComponentRead(Component: TComponent);
  180. function UniqueName(Component: TComponent): string;
  181. (* We can not use the IDE to define this event because the
  182. prototype is not the same between Delphi and Kylix !! *)
  183. procedure TreeEdited(Sender: TObject; Node: TTreeNode; var S: string);
  184. protected
  185. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  186. public
  187. procedure SetScene(Scene: TGLScene; Designer: IDesigner);
  188. end;
  189. function GLSceneEditorForm: TGLSceneEditorForm;
  190. procedure ReleaseGLSceneEditorForm;
  191. // ------------------------------------------------------------------
  192. implementation
  193. // ------------------------------------------------------------------
  194. {$R *.dfm}
  195. const
  196. cRegistryKey = 'Software\GLScene\GLSceneEditor';
  197. var
  198. vGLSceneEditorForm: TGLSceneEditorForm;
  199. function GLSceneEditorForm: TGLSceneEditorForm;
  200. begin
  201. if not Assigned(vGLSceneEditorForm) then
  202. vGLSceneEditorForm := TGLSceneEditorForm.Create(nil);
  203. Result := vGLSceneEditorForm;
  204. end;
  205. procedure ReleaseGLSceneEditorForm;
  206. begin
  207. if Assigned(vGLSceneEditorForm) then
  208. begin
  209. vGLSceneEditorForm.Free;
  210. vGLSceneEditorForm := nil;
  211. end;
  212. end;
  213. function ReadRegistryInteger(reg: TRegistry; const Name: string;
  214. defaultValue: Integer): Integer;
  215. begin
  216. if reg.ValueExists(name) then
  217. Result := reg.ReadInteger(name)
  218. else
  219. Result := defaultValue;
  220. end;
  221. function FindNodeByData(treeNodes: TTreeNodes; data: Pointer;
  222. baseNode: TTreeNode = nil): TTreeNode;
  223. var
  224. n: TTreeNode;
  225. begin
  226. Result := nil;
  227. if Assigned(baseNode) then
  228. begin
  229. n := baseNode.getFirstChild;
  230. while Assigned(n) do
  231. begin
  232. if n.data = data then
  233. begin
  234. Result := n;
  235. Break;
  236. end
  237. else if n.HasChildren then
  238. begin
  239. Result := FindNodeByData(treeNodes, data, n);
  240. if Assigned(Result) then
  241. Break;
  242. end;
  243. n := baseNode.GetNextChild(n);
  244. end;
  245. end
  246. else
  247. begin
  248. n := treeNodes.GetFirstNode;
  249. while Assigned(n) do
  250. begin
  251. if n.data = data then
  252. begin
  253. Result := n;
  254. Break;
  255. end
  256. else if n.HasChildren then
  257. begin
  258. Result := FindNodeByData(treeNodes, data, n);
  259. if Assigned(Result) then
  260. Break;
  261. end;
  262. n := n.getNextSibling;
  263. end;
  264. end;
  265. end;
  266. // ----------------- TGLSceneEditorForm ---------------------------------------------------------------------------------
  267. procedure TGLSceneEditorForm.SetScene(Scene: TGLScene; Designer: IDesigner);
  268. begin
  269. if Assigned(FScene) then
  270. FScene.RemoveFreeNotification(Self);
  271. FScene := Scene;
  272. FCurrentDesigner := Designer;
  273. ResetTree;
  274. // TreeView.Items.Clear;
  275. BehavioursListView.Items.Clear;
  276. EffectsListView.Items.Clear;
  277. if Assigned(FScene) then
  278. begin
  279. FScene.FreeNotification(Self);
  280. ReadScene;
  281. Caption := strGLSceneEditor + ' : ' + FScene.Name;
  282. end
  283. else
  284. Caption := strGLSceneEditor;
  285. TreeChange(Self, nil);
  286. if Assigned(FScene) then
  287. begin
  288. Tree.Enabled := true;
  289. BehavioursListView.Enabled := true;
  290. EffectsListView.Enabled := true;
  291. ACLoadScene.Enabled := true;
  292. ACSaveScene.Enabled := true;
  293. FSelectedItems := SCENE_SELECTED;
  294. EnableAndDisableActions;
  295. end
  296. else
  297. begin
  298. Tree.Enabled := False;
  299. BehavioursListView.Enabled := False;
  300. EffectsListView.Enabled := False;
  301. ACLoadScene.Enabled := False;
  302. ACSaveScene.Enabled := False;
  303. ACAddObject.Enabled := False;
  304. ACAddBehaviour.Enabled := False;
  305. ACAddEffect.Enabled := False;
  306. ACDeleteObject.Enabled := False;
  307. ACMoveUp.Enabled := False;
  308. ACMoveDown.Enabled := False;
  309. ACCut.Enabled := False;
  310. ACCopy.Enabled := False;
  311. ACPaste.Enabled := False;
  312. end;
  313. ShowBehavioursAndEffects(nil);
  314. end;
  315. procedure TGLSceneEditorForm.FormCreate(Sender: TObject);
  316. var
  317. CurrentNode: TTreeNode;
  318. reg: TRegistry;
  319. begin
  320. RegisterGLBaseSceneObjectNameChangeEvent(OnBaseSceneObjectNameChanged);
  321. Tree.Images := ObjectManager.ObjectIcons;
  322. Tree.Indent := ObjectManager.ObjectIcons.Width;
  323. with Tree.Items do
  324. begin
  325. // first add the scene root
  326. CurrentNode := Add(nil, strSceneRoot);
  327. with CurrentNode do
  328. begin
  329. ImageIndex := ObjectManager.SceneRootIndex;
  330. SelectedIndex := ImageIndex;
  331. end;
  332. // and the root for all objects
  333. FObjectNode := AddChild(CurrentNode, strObjectRoot);
  334. FSceneObjects := FObjectNode;
  335. with FObjectNode do
  336. begin
  337. ImageIndex := ObjectManager.ObjectRootIndex;
  338. SelectedIndex := ImageIndex;
  339. end;
  340. end;
  341. // Build SubMenus
  342. SetObjectsSubItems(MIAddObject);
  343. MIAddObject.SubMenuImages := ObjectManager.ObjectIcons;
  344. SetObjectsSubItems(PMToolBar.Items);
  345. PMToolBar.Images := ObjectManager.ObjectIcons;
  346. SetBehavioursSubItems(MIAddBehaviour, nil);
  347. SetBehavioursSubItems(PMBehavioursToolbar.Items, nil);
  348. SetEffectsSubItems(MIAddEffect, nil);
  349. SetEffectsSubItems(PMEffectsToolbar.Items, nil);
  350. reg := TRegistry.Create;
  351. try
  352. if reg.OpenKey(cRegistryKey, true) then
  353. begin
  354. if reg.ValueExists('CharacterPanels') then
  355. TBCharacterPanels.Down := reg.ReadBool('CharacterPanels');
  356. TBCharacterPanelsClick(Self);
  357. if reg.ValueExists('ExpandTree') then
  358. TBExpand.Down := reg.ReadBool('ExpandTree');
  359. ACExpandExecute(Self);
  360. Left := ReadRegistryInteger(reg, 'Left', Left);
  361. Top := ReadRegistryInteger(reg, 'Top', Top);
  362. Width := ReadRegistryInteger(reg, 'Width', 250);
  363. Height := ReadRegistryInteger(reg, 'Height', Height);
  364. end;
  365. finally
  366. reg.Free;
  367. end;
  368. // Trigger the event OnEdited manualy
  369. Tree.OnEdited := TreeEdited;
  370. end;
  371. procedure TGLSceneEditorForm.FormDestroy(Sender: TObject);
  372. var
  373. reg: TRegistry;
  374. begin
  375. DeRegisterGLBaseSceneObjectNameChangeEvent(OnBaseSceneObjectNameChanged);
  376. reg := TRegistry.Create;
  377. try
  378. if reg.OpenKey(cRegistryKey, true) then
  379. begin
  380. reg.WriteBool('CharacterPanels', TBCharacterPanels.Down);
  381. reg.WriteBool('ExpandTree', TBExpand.Down);
  382. reg.WriteInteger('Left', Left);
  383. reg.WriteInteger('Top', Top);
  384. reg.WriteInteger('Width', Width);
  385. reg.WriteInteger('Height', Height);
  386. end;
  387. finally
  388. reg.Free;
  389. end;
  390. end;
  391. procedure TGLSceneEditorForm.FormKeyDown(Sender: TObject; var Key: Word;
  392. Shift: TShiftState);
  393. begin
  394. if Key = VK_F12 then
  395. end;
  396. // ----------------------------------------------------------------------------------------------------------------------
  397. procedure TGLSceneEditorForm.ReadScene;
  398. var
  399. I: Integer;
  400. begin
  401. Tree.Items.BeginUpdate;
  402. with FScene do
  403. begin
  404. if Assigned(Objects) then
  405. begin
  406. FObjectNode.data := Objects;
  407. with Objects do
  408. for I := 0 to Count - 1 do
  409. AddNodes(FObjectNode, Children[I]);
  410. FObjectNode.Expand(False);
  411. end;
  412. end;
  413. Tree.Items.EndUpdate;
  414. end;
  415. // ----------------------------------------------------------------------------------------------------------------------
  416. procedure TGLSceneEditorForm.ResetTree;
  417. begin
  418. // delete all subtrees (empty tree)
  419. Tree.Items.BeginUpdate;
  420. try
  421. with FObjectNode do
  422. begin
  423. DeleteChildren;
  424. data := nil;
  425. parent.Expand(true);
  426. end;
  427. finally
  428. Tree.Items.EndUpdate;
  429. end;
  430. end;
  431. // ----------------------------------------------------------------------------------------------------------------------
  432. function TGLSceneEditorForm.AddNodes(ANode: TTreeNode;
  433. AObject: TGLBaseSceneObject): TTreeNode;
  434. var
  435. I: Integer;
  436. CurrentNode: TTreeNode;
  437. begin
  438. if IsSubComponent(AObject) then
  439. begin
  440. Result := Tree.Selected;
  441. Exit;
  442. end
  443. else
  444. begin
  445. Result := Tree.Items.AddChildObject(ANode, AObject.Name, AObject);
  446. Result.ImageIndex := ObjectManager.GetImageIndex
  447. (TGLSceneObjectClass(AObject.ClassType));
  448. Result.SelectedIndex := Result.ImageIndex;
  449. CurrentNode := Result;
  450. for I := 0 to AObject.Count - 1 do
  451. Result := AddNodes(CurrentNode, AObject[I]);
  452. end;
  453. end;
  454. procedure TGLSceneEditorForm.SetObjectsSubItems(parent: TMenuItem);
  455. var
  456. objectList: TStringList;
  457. i, j: Integer;
  458. Item, currentParent: TMenuItem;
  459. currentCategory: string;
  460. soc: TGLSceneObjectClass;
  461. begin
  462. objectList := TStringList.Create;
  463. try
  464. ObjectManager.GetRegisteredSceneObjects(objectList);
  465. for i := 0 to objectList.Count - 1 do
  466. if objectList[i] <> '' then
  467. begin
  468. with ObjectManager do
  469. currentCategory :=
  470. GetCategory(TGLSceneObjectClass(objectList.Objects[i]));
  471. if currentCategory = '' then
  472. currentParent := parent
  473. else
  474. begin
  475. currentParent := NewItem(currentCategory, 0, False, true, nil, 0, '');
  476. parent.Add(currentParent);
  477. end;
  478. for j := I to objectList.Count - 1 do
  479. if objectList[j] <> '' then
  480. with ObjectManager do
  481. begin
  482. soc := TGLSceneObjectClass(objectList.Objects[j]);
  483. if currentCategory = GetCategory(soc) then
  484. begin
  485. Item := NewItem(objectList[j], 0, False, true,
  486. AddObjectClick, 0, '');
  487. Item.ImageIndex := GetImageIndex(soc);
  488. Item.Tag := Integer(soc);
  489. currentParent.Add(Item);
  490. objectList[j] := '';
  491. if currentCategory = '' then
  492. Break;
  493. end;
  494. end;
  495. end;
  496. finally
  497. objectList.Free;
  498. end;
  499. end;
  500. procedure TGLSceneEditorForm.SetXCollectionSubItems(parent: TMenuItem;
  501. XCollection: TXCollection; Event: TSetSubItemsEvent);
  502. var
  503. i: Integer;
  504. list: TList;
  505. XCollectionItemClass: TXCollectionItemClass;
  506. mi: TMenuItem;
  507. begin
  508. parent.Clear;
  509. if Assigned(XCollection) then
  510. begin
  511. list := GetXCollectionItemClassesList(XCollection.ItemsClass);
  512. try
  513. for i := 0 to list.Count - 1 do
  514. begin
  515. XCollectionItemClass := TXCollectionItemClass(list[i]);
  516. mi := TMenuItem.Create(owner);
  517. mi.Caption := XCollectionItemClass.FriendlyName;
  518. mi.OnClick := Event; // AddBehaviourClick;
  519. mi.Tag := Integer(XCollectionItemClass);
  520. if Assigned(XCollection) then
  521. mi.Enabled := XCollection.CanAdd(XCollectionItemClass)
  522. else
  523. mi.Enabled := TBAddBehaviours.Enabled;
  524. parent.Add(mi);
  525. end;
  526. finally
  527. list.Free;
  528. end;
  529. end;
  530. end;
  531. procedure TGLSceneEditorForm.SetBehavioursSubItems(parent: TMenuItem;
  532. XCollection: TXCollection);
  533. begin
  534. SetXCollectionSubItems(parent, XCollection, AddBehaviourClick);
  535. end;
  536. procedure TGLSceneEditorForm.SetEffectsSubItems(parent: TMenuItem;
  537. XCollection: TXCollection);
  538. begin
  539. SetXCollectionSubItems(parent, XCollection, AddEffectClick);
  540. end;
  541. procedure TGLSceneEditorForm.AddObjectClick(Sender: TObject);
  542. var
  543. AParent, AObject: TGLBaseSceneObject;
  544. Node: TTreeNode;
  545. begin
  546. if Assigned(FCurrentDesigner) then
  547. with Tree do
  548. if Assigned(Selected) and (Selected.Level > 0) then
  549. begin
  550. AParent := TGLBaseSceneObject(Selected.data);
  551. // FCurrentDesigner.cr
  552. AObject := TGLBaseSceneObject
  553. (FCurrentDesigner.CreateComponent
  554. (TGLSceneObjectClass(TMenuItem(Sender).Tag), AParent, 0, 0, 0, 0));
  555. TComponent(AObject).DesignInfo := 0;
  556. AParent.AddChild(AObject);
  557. Node := AddNodes(Selected, AObject);
  558. Node.Selected := true;
  559. FCurrentDesigner.Modified;
  560. end;
  561. end;
  562. procedure TGLSceneEditorForm.AddBehaviourClick(Sender: TObject);
  563. var
  564. XCollectionItemClass: TXCollectionItemClass;
  565. AParent: TGLBaseSceneObject;
  566. begin
  567. if Assigned(Tree.Selected) then
  568. begin
  569. AParent := TGLBaseSceneObject(Tree.Selected.data);
  570. XCollectionItemClass := TXCollectionItemClass((Sender as TMenuItem).Tag);
  571. XCollectionItemClass.Create(AParent.Behaviours);
  572. // PrepareListView;
  573. ShowBehaviours(AParent);
  574. // ListView.Selected:=ListView.FindData(0, XCollectionItem, True, False);
  575. FCurrentDesigner.Modified;
  576. end;
  577. end;
  578. procedure TGLSceneEditorForm.AddEffectClick(Sender: TObject);
  579. var
  580. XCollectionItemClass: TXCollectionItemClass;
  581. AParent: TGLBaseSceneObject;
  582. begin
  583. if Assigned(Tree.Selected) then
  584. begin
  585. AParent := TGLBaseSceneObject(Tree.Selected.data);
  586. XCollectionItemClass := TXCollectionItemClass((Sender as TMenuItem).Tag);
  587. XCollectionItemClass.Create(AParent.Effects);
  588. // PrepareListView;
  589. ShowEffects(AParent);
  590. // ListView.Selected:=ListView.FindData(0, XCollectionItem, True, False);
  591. FCurrentDesigner.Modified;
  592. end;
  593. end;
  594. procedure TGLSceneEditorForm.TreeDragOver(Sender, Source: TObject;
  595. X, Y: Integer; State: TDragState; var Accept: Boolean);
  596. var
  597. Target: TTreeNode;
  598. begin
  599. Accept := False;
  600. if Source = Tree then
  601. with Tree do
  602. begin
  603. Target := DropTarget;
  604. Accept := Assigned(Target) and (Selected <> Target) and
  605. Assigned(Target.data) and (not Target.HasAsParent(Selected));
  606. end;
  607. end;
  608. procedure TGLSceneEditorForm.TreeDragDrop(Sender, Source: TObject;
  609. X, Y: Integer);
  610. var
  611. SourceNode, DestinationNode: TTreeNode;
  612. SourceObject, DestinationObject: TGLBaseSceneObject;
  613. begin
  614. if Assigned(FCurrentDesigner) then
  615. begin
  616. DestinationNode := Tree.DropTarget;
  617. if Assigned(DestinationNode) and (Source = Tree) then
  618. begin
  619. SourceNode := TTreeView(Source).Selected;
  620. SourceObject := SourceNode.data;
  621. DestinationObject := DestinationNode.data;
  622. DestinationObject.Insert(0, SourceObject);
  623. SourceNode.MoveTo(DestinationNode, naAddChildFirst);
  624. TreeChange(Self, nil);
  625. FCurrentDesigner.Modified;
  626. end;
  627. end;
  628. end;
  629. procedure TGLSceneEditorForm.Notification(AComponent: TComponent;
  630. Operation: TOperation);
  631. begin
  632. if (FScene = AComponent) and (Operation = opRemove) then
  633. begin
  634. FScene := nil;
  635. SetScene(nil, nil);
  636. end;
  637. inherited;
  638. end;
  639. procedure TGLSceneEditorForm.OnBaseSceneObjectNameChanged(Sender: TObject);
  640. var
  641. n: TTreeNode;
  642. begin
  643. n := FindNodeByData(Tree.Items, Sender);
  644. if Assigned(n) then
  645. n.Text := (Sender as TGLBaseSceneObject).Name;
  646. end;
  647. procedure TGLSceneEditorForm.TreeAllChange(Sender: TObject; Node: TTreeNode);
  648. var
  649. selNode : TTreeNode;
  650. BaseSceneObject1: TGLBaseSceneObject;
  651. begin
  652. // not implemented yet
  653. (*
  654. if Assigned(FCurrentDesigner) then
  655. begin
  656. if Node <> nil then
  657. begin
  658. BaseSceneObject1 := TGLBaseSceneObject(Node.data);
  659. end;
  660. EnableAndDisableActions();
  661. end;
  662. *)
  663. end;
  664. procedure TGLSceneEditorForm.TreeChange(Sender: TObject; Node: TTreeNode);
  665. var
  666. // selNode : TTreeNode;
  667. BaseSceneObject1: TGLBaseSceneObject;
  668. begin
  669. if Assigned(FCurrentDesigner) then
  670. begin
  671. if Node <> nil then
  672. begin
  673. BaseSceneObject1 := TGLBaseSceneObject(Node.data);
  674. if BaseSceneObject1 <> nil then
  675. begin
  676. ShowBehavioursAndEffects(BaseSceneObject1);
  677. end;
  678. end;
  679. EnableAndDisableActions();
  680. end;
  681. end;
  682. procedure TGLSceneEditorForm.TreeEditing(Sender: TObject; Node: TTreeNode;
  683. var AllowEdit: Boolean);
  684. begin
  685. AllowEdit := (Node.Level > 1);
  686. end;
  687. procedure TGLSceneEditorForm.ShowBehaviours(BaseSceneObject
  688. : TGLBaseSceneObject);
  689. var
  690. I: Integer;
  691. DisplayedName: string;
  692. begin
  693. BehavioursListView.Items.Clear;
  694. BehavioursListView.Items.BeginUpdate;
  695. if Assigned(BaseSceneObject) then
  696. begin
  697. for I := 0 to BaseSceneObject.Behaviours.Count - 1 do
  698. begin
  699. with BehavioursListView.Items.Add do
  700. begin
  701. DisplayedName := BaseSceneObject.Behaviours[I].Name;
  702. if DisplayedName = '' then
  703. DisplayedName := '(unnamed)';
  704. Caption := IntToStr(I) + ' - ' + DisplayedName;
  705. SubItems.Add(BaseSceneObject.Behaviours[I].FriendlyName);
  706. data := BaseSceneObject.Behaviours[I];
  707. end;
  708. end;
  709. end;
  710. BehavioursListView.Items.EndUpdate;
  711. end;
  712. procedure TGLSceneEditorForm.ShowEffects(BaseSceneObject: TGLBaseSceneObject);
  713. var
  714. I: Integer;
  715. DisplayedName: string;
  716. begin
  717. EffectsListView.Items.Clear;
  718. EffectsListView.Items.BeginUpdate;
  719. if Assigned(BaseSceneObject) then
  720. begin
  721. for I := 0 to BaseSceneObject.Effects.Count - 1 do
  722. begin
  723. with EffectsListView.Items.Add do
  724. begin
  725. DisplayedName := BaseSceneObject.Effects[I].Name;
  726. if DisplayedName = '' then
  727. DisplayedName := '(unnamed)';
  728. Caption := IntToStr(I) + ' - ' + DisplayedName;
  729. SubItems.Add(BaseSceneObject.Effects[I].FriendlyName);
  730. Data := BaseSceneObject.Effects[I];
  731. end;
  732. end;
  733. end;
  734. EffectsListView.Items.EndUpdate;
  735. end;
  736. function TGLSceneEditorForm.AddNodesAll(ANode: TTreeNode; AObject: TGLBaseSceneObject): TTreeNode;
  737. var
  738. I: Integer;
  739. CurrentNode: TTreeNode;
  740. begin
  741. if IsSubComponent(AObject) then
  742. begin
  743. Result := Tree.Selected;
  744. Exit;
  745. end
  746. else
  747. begin
  748. Result := Tree.Items.AddChildObject(ANode, AObject.Name, AObject);
  749. Result.ImageIndex := ObjectManager.GetImageIndex
  750. (TGLSceneObjectClass(AObject.ClassType));
  751. Result.SelectedIndex := Result.ImageIndex;
  752. CurrentNode := Result;
  753. for I := 0 to AObject.Count - 1 do
  754. Result := AddNodes(CurrentNode, AObject[I]);
  755. end;
  756. end;
  757. procedure TGLSceneEditorForm.ShowBehavioursAndEffects(BaseSceneObject
  758. : TGLBaseSceneObject);
  759. begin
  760. ShowBehaviours(BaseSceneObject);
  761. ShowEffects(BaseSceneObject);
  762. end;
  763. procedure TGLSceneEditorForm.TreeEdited(Sender: TObject; Node: TTreeNode;
  764. var S: string);
  765. var
  766. BaseSceneObject1: TGLBaseSceneObject;
  767. begin
  768. if Assigned(FCurrentDesigner) then
  769. begin
  770. // renaming a node means renaming a scene object
  771. BaseSceneObject1 := TGLBaseSceneObject(Node.data);
  772. if FScene.FindSceneObject(S) = nil then
  773. BaseSceneObject1.Name := S
  774. else
  775. begin
  776. Messagedlg('A component named ' + S + ' already exists', mtWarning,
  777. [mbok], 0);
  778. S := BaseSceneObject1.Name;
  779. end;
  780. ShowBehavioursAndEffects(BaseSceneObject1);
  781. FCurrentDesigner.Modified;
  782. end;
  783. end;
  784. procedure TGLSceneEditorForm.TreeMouseDown(Sender: TObject;
  785. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  786. begin
  787. FLastMouseDownPos := Point(X, Y);
  788. end;
  789. procedure TGLSceneEditorForm.TreeMouseMove(Sender: TObject; Shift: TShiftState;
  790. X, Y: Integer);
  791. var
  792. Node: TTreeNode;
  793. begin
  794. if Shift = [ssLeft] then
  795. begin
  796. Node := Tree.Selected;
  797. if Assigned(Node) and (Node.Level > 1) then
  798. if (Abs(FLastMouseDownPos.X - X) > 4) or (Abs(FLastMouseDownPos.Y - Y) > 4)
  799. then
  800. Tree.BeginDrag(False);
  801. end;
  802. end;
  803. procedure TGLSceneEditorForm.TreeEnter(Sender: TObject);
  804. begin
  805. if Assigned(FCurrentDesigner) and Assigned(Tree.Selected) then
  806. FCurrentDesigner.SelectComponent(TGLBaseSceneObject(Tree.Selected.data));
  807. FSelectedItems := SCENE_SELECTED;
  808. EnableAndDisableActions();
  809. end;
  810. procedure TGLSceneEditorForm.acDeleteObjectExecute(Sender: TObject);
  811. var
  812. anObject: TGLBaseSceneObject;
  813. allowed, keepChildren: Boolean;
  814. confirmMsg: string;
  815. buttons: TMsgDlgButtons;
  816. begin
  817. if FSelectedItems = BEHAVIOURS_SELECTED then
  818. begin
  819. DeleteBaseBehaviour(BehavioursListView);
  820. FCurrentDesigner.SelectComponent(TGLBaseSceneObject(Tree.Selected.data));
  821. ShowBehaviours(TGLBaseSceneObject(Tree.Selected.data));
  822. end
  823. else if FSelectedItems = EFFECTS_SELECTED then
  824. begin
  825. DeleteBaseBehaviour(EffectsListView);
  826. FCurrentDesigner.SelectComponent(TGLBaseSceneObject(Tree.Selected.data));
  827. ShowEffects(TGLBaseSceneObject(Tree.Selected.data));
  828. end
  829. else if FSelectedItems = SCENE_SELECTED then
  830. begin
  831. if Assigned(Tree.Selected) and (Tree.Selected.Level > 1) then
  832. begin
  833. anObject := TGLBaseSceneObject(Tree.Selected.data);
  834. // ask for confirmation
  835. if anObject.Name <> '' then
  836. confirmMsg := 'Delete ' + anObject.Name
  837. else
  838. confirmMsg := 'Delete the marked object';
  839. buttons := [mbok, mbCancel];
  840. // are there children to care for?
  841. // mbAll exist only on Windows ...
  842. if (anObject.Count > 0) and (not anObject.HasSubChildren) then
  843. begin
  844. confirmMsg := confirmMsg + ' only or with ALL its children?';
  845. buttons := [mbAll] + buttons;
  846. end
  847. else
  848. confirmMsg := confirmMsg + '?';
  849. case Messagedlg(confirmMsg, mtConfirmation, buttons, 0) of
  850. mrAll:
  851. begin
  852. keepChildren := False;
  853. allowed := true;
  854. end;
  855. mrOK:
  856. begin
  857. keepChildren := true;
  858. allowed := true;
  859. end;
  860. mrCancel:
  861. begin
  862. allowed := False;
  863. keepChildren := true;
  864. end;
  865. else
  866. allowed := False;
  867. keepChildren := true;
  868. end;
  869. // deletion allowed?
  870. if allowed then
  871. begin
  872. if keepChildren = true then
  873. while Tree.Selected.Count > 0 do
  874. Tree.Selected.Item[0].MoveTo(Tree.Selected, naAdd);
  875. // previous line should be "naInsert" if children are to remain in position of parent
  876. // (would require changes to TGLBaseSceneObject.Remove)
  877. Tree.Selected.Free;
  878. FCurrentDesigner.SelectComponent(nil);
  879. anObject.parent.Remove(anObject, keepChildren);
  880. anObject.Free;
  881. end
  882. end;
  883. end;
  884. end;
  885. procedure TGLSceneEditorForm.acExpandExecute(Sender: TObject);
  886. begin
  887. if FSceneObjects <> nil then
  888. try
  889. Tree.Items.BeginUpdate;
  890. if TBExpand.Down then
  891. Tree.FullExpand
  892. else
  893. begin
  894. FSceneObjects.Collapse(True);
  895. FSceneObjects.Expand(False);
  896. end;
  897. finally
  898. Tree.Items.EndUpdate;
  899. end;
  900. end;
  901. procedure TGLSceneEditorForm.acMoveUpExecute(Sender: TObject);
  902. var
  903. Node: TTreeNode;
  904. prevData: Pointer;
  905. begin
  906. if FSelectedItems = BEHAVIOURS_SELECTED then
  907. begin
  908. prevData := BehavioursListView.Selected.data;
  909. TGLBaseBehaviour(prevData).MoveUp;
  910. ShowBehaviours(TGLBaseSceneObject(Tree.Selected.data));
  911. BehavioursListView.Selected := BehavioursListView.FindData(0, prevData,
  912. true, False);
  913. FCurrentDesigner.Modified;
  914. end
  915. else if FSelectedItems = EFFECTS_SELECTED then
  916. begin
  917. prevData := EffectsListView.Selected.data;
  918. TGLBaseBehaviour(prevData).MoveUp;
  919. ShowEffects(TGLBaseSceneObject(Tree.Selected.data));
  920. EffectsListView.Selected := EffectsListView.FindData(0, prevData,
  921. true, False);
  922. FCurrentDesigner.Modified;
  923. end
  924. else if FSelectedItems = SCENE_SELECTED then
  925. begin
  926. if ACMoveUp.Enabled then
  927. begin
  928. Node := Tree.Selected;
  929. if Assigned(Node) then
  930. begin
  931. Node.MoveTo(Node.GetPrevSibling, naInsert);
  932. with TGLBaseSceneObject(Node.data) do
  933. begin
  934. MoveUp;
  935. Update;
  936. end;
  937. TreeChange(Self, Node);
  938. FCurrentDesigner.Modified;
  939. end;
  940. end;
  941. end;
  942. end;
  943. procedure TGLSceneEditorForm.acMoveDownExecute(Sender: TObject);
  944. var
  945. Node: TTreeNode;
  946. prevData: Pointer;
  947. begin
  948. if FSelectedItems = BEHAVIOURS_SELECTED then
  949. begin
  950. prevData := BehavioursListView.Selected.data;
  951. TGLBaseBehaviour(prevData).MoveDown;
  952. ShowBehaviours(TGLBaseSceneObject(Tree.Selected.data));
  953. BehavioursListView.Selected := BehavioursListView.FindData(0, prevData,
  954. true, False);
  955. FCurrentDesigner.Modified;
  956. end
  957. else if FSelectedItems = EFFECTS_SELECTED then
  958. begin
  959. prevData := EffectsListView.Selected.data;
  960. TGLBaseBehaviour(prevData).MoveDown;
  961. ShowEffects(TGLBaseSceneObject(Tree.Selected.data));
  962. EffectsListView.Selected := EffectsListView.FindData(0, prevData,
  963. true, False);
  964. FCurrentDesigner.Modified;
  965. end
  966. else if FSelectedItems = SCENE_SELECTED then
  967. begin
  968. if ACMoveDown.Enabled then
  969. begin
  970. Node := Tree.Selected;
  971. if Assigned(Node) then
  972. begin
  973. Node.getNextSibling.MoveTo(Node, naInsert);
  974. with TGLBaseSceneObject(Node.data) do
  975. begin
  976. MoveDown;
  977. Update;
  978. end;
  979. TreeChange(Self, Node);
  980. FCurrentDesigner.Modified;
  981. end;
  982. end;
  983. end;
  984. end;
  985. procedure TGLSceneEditorForm.acAddObjectExecute(Sender: TObject);
  986. begin
  987. TBAddObjects.CheckMenuDropdown;
  988. end;
  989. procedure TGLSceneEditorForm.acStayOnTopExecute(Sender: TObject);
  990. begin
  991. if TBStayOnTop.Down then
  992. FormStyle := fsStayOnTop
  993. else
  994. FormStyle := fsNormal;
  995. end;
  996. procedure TGLSceneEditorForm.acSaveSceneExecute(Sender: TObject);
  997. begin
  998. if SaveDialog.Execute then
  999. FScene.SaveToFile(SaveDialog.FileName);
  1000. end;
  1001. procedure TGLSceneEditorForm.acLoadSceneExecute(Sender: TObject);
  1002. begin
  1003. if OpenDialog.Execute then
  1004. begin
  1005. FScene.LoadFromFile(OpenDialog.FileName);
  1006. ResetTree;
  1007. ReadScene;
  1008. ShowBehavioursAndEffects(nil);
  1009. end;
  1010. end;
  1011. procedure TGLSceneEditorForm.acInfoExecute(Sender: TObject);
  1012. var
  1013. AScene: TGLSceneViewer;
  1014. begin
  1015. AScene := TGLSceneViewer.Create(Self);
  1016. AScene.Name := 'GLSceneEditor';
  1017. AScene.Width := 0;
  1018. AScene.Height := 0;
  1019. AScene.parent := Self;
  1020. try
  1021. AScene.Buffer.ShowInfo;
  1022. finally
  1023. AScene.Free;
  1024. end;
  1025. end;
  1026. function TGLSceneEditorForm.IsValidClipBoardNode: Boolean;
  1027. var
  1028. selNode: TTreeNode;
  1029. begin
  1030. selNode := Tree.Selected;
  1031. Result := ((selNode <> nil) and (selNode.parent <> nil) and
  1032. (selNode.parent.parent <> nil));
  1033. end;
  1034. function TGLSceneEditorForm.IsPastePossible: Boolean;
  1035. function PossibleStream(const S: string): Boolean;
  1036. var
  1037. I: Integer;
  1038. begin
  1039. Result := true;
  1040. for I := 1 to Length(S) - 6 do
  1041. begin
  1042. if CharInSet(S[I], ['O', 'o']) and
  1043. (CompareText(Copy(S, I, 6), 'OBJECT') = 0) then
  1044. Exit;
  1045. if not CharInSet(S[I], [' ', #9, #13, #10]) then
  1046. Break;
  1047. end;
  1048. Result := False;
  1049. end;
  1050. var
  1051. selNode: TTreeNode;
  1052. anObject, destination: TGLBaseSceneObject;
  1053. ComponentList: IDesignerSelections;
  1054. TmpContainer: TComponent;
  1055. begin
  1056. selNode := Tree.Selected;
  1057. if (selNode <> nil) and (selNode.parent <> nil)
  1058. and (ClipBoard.HasFormat(CF_COMPONENT) or (ClipBoard.HasFormat(CF_TEXT) and
  1059. PossibleStream(ClipBoard.AsText))) then
  1060. begin
  1061. TmpContainer := TComponent.Create(Self);
  1062. try
  1063. ComponentList := TDesignerSelections.Create;
  1064. if PasteComponents(TmpContainer, TmpContainer, ComponentList) then
  1065. if (ComponentList.Count > 0) and (ComponentList[0] is TGLBaseSceneObject)
  1066. then
  1067. begin
  1068. anObject := TGLBaseSceneObject(ComponentList[0]);
  1069. destination := TGLBaseSceneObject(selNode.data);
  1070. Result := CanPaste(anObject, destination);
  1071. end
  1072. else
  1073. Result := False
  1074. else
  1075. Result := False;
  1076. finally
  1077. TmpContainer.Free;
  1078. end;
  1079. end
  1080. else
  1081. Result := False;
  1082. end;
  1083. function TGLSceneEditorForm.CanPaste(obj, destination
  1084. : TGLBaseSceneObject): Boolean;
  1085. begin
  1086. Result := Assigned(obj) and Assigned(destination);
  1087. end;
  1088. procedure TGLSceneEditorForm.acCopyExecute(Sender: TObject);
  1089. var
  1090. ComponentList: IDesignerSelections;
  1091. begin
  1092. ComponentList := TDesignerSelections.Create;
  1093. ComponentList.Add(TGLBaseSceneObject(Tree.Selected.data));
  1094. CopyComponents(FScene.owner, ComponentList);
  1095. ACPaste.Enabled := IsPastePossible;
  1096. end;
  1097. procedure TGLSceneEditorForm.acCutExecute(Sender: TObject);
  1098. var
  1099. AObject: TGLBaseSceneObject;
  1100. ComponentList: IDesignerSelections;
  1101. begin
  1102. if IsValidClipBoardNode then
  1103. begin
  1104. AObject := TGLBaseSceneObject(Tree.Selected.data);
  1105. ComponentList := TDesignerSelections.Create;
  1106. ComponentList.Add(TGLBaseSceneObject(Tree.Selected.data));
  1107. CopyComponents(FScene.owner, ComponentList);
  1108. AObject.parent.Remove(AObject, False);
  1109. AObject.Free;
  1110. Tree.Selected.Free;
  1111. ACPaste.Enabled := IsPastePossible;
  1112. end;
  1113. end;
  1114. procedure TGLSceneEditorForm.acPasteExecute(Sender: TObject);
  1115. var
  1116. selNode: TTreeNode;
  1117. destination: TGLBaseSceneObject;
  1118. ComponentList: IDesignerSelections;
  1119. t: Integer;
  1120. begin
  1121. selNode := Tree.Selected;
  1122. if (selNode <> nil) and (selNode.parent <> nil) then
  1123. begin
  1124. destination := TGLBaseSceneObject(selNode.data);
  1125. ComponentList := TDesignerSelections.Create;
  1126. PasteComponents(FScene.owner, destination, ComponentList);
  1127. if (ComponentList.Count > 0) and
  1128. (CanPaste(TGLBaseSceneObject(ComponentList[0]), destination)) then
  1129. begin
  1130. for t := 0 to ComponentList.Count - 1 do
  1131. AddNodes(selNode, TGLBaseSceneObject(ComponentList[t]));
  1132. selNode.Expand(False);
  1133. end;
  1134. FCurrentDesigner.Modified;
  1135. end;
  1136. end;
  1137. procedure TGLSceneEditorForm.CopyComponents(Root: TComponent;
  1138. const Components: IDesignerSelections);
  1139. var
  1140. S: TMemoryStream;
  1141. W: TWriter;
  1142. I: Integer;
  1143. begin
  1144. S := TMemoryStream.Create;
  1145. try
  1146. W := TWriter.Create(S, 1024);
  1147. try
  1148. W.Root := Root;
  1149. for I := 0 to Components.Count - 1 do
  1150. begin
  1151. W.WriteSignature;
  1152. W.WriteComponent(TComponent(Components[I]));
  1153. end;
  1154. W.WriteListEnd;
  1155. finally
  1156. W.Free;
  1157. end;
  1158. CopyStreamToClipboard(S);
  1159. finally
  1160. S.Free;
  1161. end;
  1162. end;
  1163. procedure TGLSceneEditorForm.MethodError(Reader: TReader;
  1164. const MethodName: string; var Address: Pointer; var Error: Boolean);
  1165. begin
  1166. // error is true because Address is nil in csDesigning
  1167. Error := False;
  1168. end;
  1169. function TGLSceneEditorForm.PasteComponents(AOwner, AParent: TComponent;
  1170. const Components: IDesignerSelections): Boolean;
  1171. var
  1172. S: TStream;
  1173. R: TReader;
  1174. begin
  1175. // catch GetClipboardStream exceptions that can easilly occured
  1176. try
  1177. S := GetClipboardStream;
  1178. try
  1179. R := TReader.Create(S, 1024);
  1180. try
  1181. R.OnSetName := ReaderSetName;
  1182. R.OnFindMethod := MethodError;
  1183. FPasteOwner := AOwner;
  1184. FPasteSelection := Components;
  1185. R.ReadComponents(AOwner, AParent, ComponentRead);
  1186. Result := true;
  1187. finally
  1188. R.Free;
  1189. end;
  1190. finally
  1191. S.Free;
  1192. end;
  1193. finally
  1194. end;
  1195. end;
  1196. procedure TGLSceneEditorForm.ReaderSetName(Reader: TReader;
  1197. Component: TComponent; var Name: string);
  1198. begin
  1199. if (Reader.Root = FPasteOwner) and (FPasteOwner.FindComponent(Name) <> nil)
  1200. then
  1201. Name := UniqueName(Component);
  1202. end;
  1203. function TGLSceneEditorForm.UniqueName(Component: TComponent): string;
  1204. begin
  1205. Result := FCurrentDesigner.UniqueName(Component.ClassName);
  1206. end;
  1207. procedure TGLSceneEditorForm.ComponentRead(Component: TComponent);
  1208. begin
  1209. FPasteSelection.Add(Component);
  1210. end;
  1211. procedure TGLSceneEditorForm.BehavioursListViewEnter(Sender: TObject);
  1212. begin
  1213. if Assigned(FCurrentDesigner) and Assigned(BehavioursListView.Selected) then
  1214. FCurrentDesigner.SelectComponent
  1215. (TGLBaseBehaviour(BehavioursListView.Selected.data));
  1216. FSelectedItems := BEHAVIOURS_SELECTED;
  1217. EnableAndDisableActions();
  1218. end;
  1219. procedure TGLSceneEditorForm.EffectsListViewEnter(Sender: TObject);
  1220. begin
  1221. if Assigned(FCurrentDesigner) and Assigned(EffectsListView.Selected) then
  1222. FCurrentDesigner.SelectComponent
  1223. (TGLBaseBehaviour(EffectsListView.Selected.data));
  1224. FSelectedItems := EFFECTS_SELECTED;
  1225. EnableAndDisableActions();
  1226. end;
  1227. procedure TGLSceneEditorForm.acAddBehaviourExecute(Sender: TObject);
  1228. begin
  1229. TBAddBehaviours.CheckMenuDropdown
  1230. end;
  1231. procedure TGLSceneEditorForm.DeleteBaseBehaviour(ListView: TListView);
  1232. begin
  1233. if ListView.Selected <> nil then
  1234. begin
  1235. FCurrentDesigner.Modified;
  1236. FCurrentDesigner.NoSelection;
  1237. TXCollectionItem(ListView.Selected.data).Free;
  1238. ListView.Selected.Free;
  1239. // ListViewChange(Self, nil, ctState);
  1240. ShowBehavioursAndEffects(TGLBaseSceneObject(Tree.Selected.data));
  1241. end;
  1242. end;
  1243. procedure TGLSceneEditorForm.pmBehavioursToolbarPopup(Sender: TObject);
  1244. var
  1245. object1: TGLBaseSceneObject;
  1246. begin
  1247. if (Tree.Selected) <> nil then
  1248. begin
  1249. object1 := TGLBaseSceneObject(Tree.Selected.data);
  1250. SetBehavioursSubItems(PMBehavioursToolbar.Items, object1.Behaviours);
  1251. end;
  1252. end;
  1253. procedure TGLSceneEditorForm.pmEffectsToolbarPopup(Sender: TObject);
  1254. var
  1255. object1: TGLBaseSceneObject;
  1256. begin
  1257. if (Tree.Selected) <> nil then
  1258. begin
  1259. object1 := TGLBaseSceneObject(Tree.Selected.data);
  1260. SetEffectsSubItems(PMEffectsToolbar.Items, object1.Effects);
  1261. end;
  1262. end;
  1263. procedure TGLSceneEditorForm.BehavioursListViewSelectItem(Sender: TObject;
  1264. Item: TListItem; Selected: Boolean);
  1265. begin
  1266. EnableAndDisableActions();
  1267. end;
  1268. procedure TGLSceneEditorForm.acAddEffectExecute(Sender: TObject);
  1269. begin
  1270. TBAddEffects.CheckMenuDropdown;
  1271. end;
  1272. procedure TGLSceneEditorForm.EnableAndDisableActions();
  1273. var
  1274. selNode: TTreeNode;
  1275. begin
  1276. if FSelectedItems = SCENE_SELECTED then
  1277. begin
  1278. selNode := Tree.Selected;
  1279. // select in Delphi IDE
  1280. if Assigned(selNode) then
  1281. begin
  1282. if Assigned(selNode.data) then
  1283. FCurrentDesigner.SelectComponent(TGLBaseSceneObject(selNode.data))
  1284. else
  1285. FCurrentDesigner.SelectComponent(FScene);
  1286. // enablings
  1287. ACAddObject.Enabled := ((selNode = FObjectNode) or selNode.HasAsParent(FObjectNode));
  1288. ACAddBehaviour.Enabled := (selNode.HasAsParent(FObjectNode));
  1289. ACAddEffect.Enabled := (selNode.HasAsParent(FObjectNode));
  1290. ACDeleteObject.Enabled := (selNode.Level > 1);
  1291. ACMoveUp.Enabled := ((selNode.Index > 0) and (selNode.Level > 1));
  1292. ACMoveDown.Enabled := ((selNode.getNextSibling <> nil) and (selNode.Level > 1));
  1293. ACCut.Enabled := IsValidClipBoardNode;
  1294. ACPaste.Enabled := IsPastePossible;
  1295. end
  1296. else
  1297. begin
  1298. ACAddObject.Enabled := False;
  1299. ACAddBehaviour.Enabled := False;
  1300. ACAddEffect.Enabled := False;
  1301. ACDeleteObject.Enabled := False;
  1302. ACMoveUp.Enabled := False;
  1303. ACMoveDown.Enabled := False;
  1304. ACCut.Enabled := False;
  1305. ACPaste.Enabled := False;
  1306. end;
  1307. // end;
  1308. ACCopy.Enabled := ACCut.Enabled;
  1309. end
  1310. else if FSelectedItems = BEHAVIOURS_SELECTED then
  1311. begin
  1312. if (BehavioursListView.Selected <> nil) then
  1313. begin
  1314. FCurrentDesigner.SelectComponent
  1315. (TGLBaseBehaviour(BehavioursListView.Selected.data));
  1316. ACDeleteObject.Enabled := true;
  1317. ACMoveUp.Enabled := (BehavioursListView.Selected.Index > 0);
  1318. ACMoveDown.Enabled := (BehavioursListView.Selected.
  1319. Index < BehavioursListView.Selected.owner.Count - 1);
  1320. ACCut.Enabled := False;
  1321. ACCopy.Enabled := False;
  1322. ACPaste.Enabled := False;
  1323. end
  1324. else
  1325. begin
  1326. ACDeleteObject.Enabled := False;
  1327. ACMoveUp.Enabled := False;
  1328. ACMoveDown.Enabled := False;
  1329. ACCut.Enabled := False;
  1330. ACCopy.Enabled := False;
  1331. ACPaste.Enabled := False;
  1332. end;
  1333. end
  1334. else if FSelectedItems = EFFECTS_SELECTED then
  1335. begin
  1336. if (EffectsListView.Selected <> nil) then
  1337. begin
  1338. FCurrentDesigner.SelectComponent
  1339. (TGLBaseBehaviour(EffectsListView.Selected.data));
  1340. ACDeleteObject.Enabled := true;
  1341. ACMoveUp.Enabled := (EffectsListView.Selected.Index > 0);
  1342. ACMoveDown.Enabled := (EffectsListView.Selected.
  1343. Index < EffectsListView.Selected.owner.Count - 1);
  1344. ACCut.Enabled := False;
  1345. ACCopy.Enabled := False;
  1346. ACPaste.Enabled := False;
  1347. end
  1348. else
  1349. begin
  1350. ACDeleteObject.Enabled := False;
  1351. ACMoveUp.Enabled := False;
  1352. ACMoveDown.Enabled := False;
  1353. ACCut.Enabled := False;
  1354. ACCopy.Enabled := False;
  1355. ACPaste.Enabled := False;
  1356. end;
  1357. end;
  1358. end;
  1359. procedure TGLSceneEditorForm.PopupMenuPopup(Sender: TObject);
  1360. var
  1361. obj: TObject;
  1362. sceneObj: TGLBaseSceneObject;
  1363. begin
  1364. if (Tree.Selected) <> nil then
  1365. begin
  1366. obj := TObject(Tree.Selected.data);
  1367. if Assigned(obj) and (obj is TGLBaseSceneObject) then
  1368. begin
  1369. sceneObj := TGLBaseSceneObject(obj);
  1370. SetBehavioursSubItems(MIAddBehaviour, sceneObj.Behaviours);
  1371. SetEffectsSubItems(MIAddEffect, sceneObj.Effects);
  1372. end
  1373. else
  1374. begin
  1375. SetBehavioursSubItems(MIAddBehaviour, nil);
  1376. SetEffectsSubItems(MIAddEffect, nil);
  1377. end;
  1378. end;
  1379. end;
  1380. procedure TGLSceneEditorForm.TBCharacterPanelsClick(Sender: TObject);
  1381. begin
  1382. PABehaviours.Visible := TBCharacterPanels.Down;
  1383. PAEffects.Visible := TBCharacterPanels.Down;
  1384. if PABehaviours.Visible then
  1385. Height := Height + PABehaviours.Height + PAEffects.Height
  1386. else
  1387. Height := Height - PABehaviours.Height - PAEffects.Height;
  1388. end;
  1389. procedure TGLSceneEditorForm.TreeKeyDown(Sender: TObject; var Key: Word;
  1390. Shift: TShiftState);
  1391. var
  1392. FNode: TTreeNode;
  1393. begin
  1394. if (Key = VK_DELETE) and not Tree.IsEditing then
  1395. begin
  1396. Key := 0;
  1397. ACDeleteObject.Execute;
  1398. end;
  1399. if Key = VK_F2 then
  1400. begin
  1401. FNode := Tree.Selected;
  1402. if FNode.Level > 1 then
  1403. begin
  1404. FNode.EditText;
  1405. end;
  1406. end;
  1407. end;
  1408. //--------------------------------------------------------------
  1409. initialization
  1410. //--------------------------------------------------------------
  1411. finalization
  1412. ReleaseGLSceneEditorForm;
  1413. end.