FSceneEditor.pas 44 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514
  1. //
  2. // This unit is part of the GLScene Engine, http://glscene.org
  3. //
  4. (*
  5. Scene Editor, for adding + removing scene objects within the Delphi IDE.
  6. *)
  7. unit FSceneEditor;
  8. interface
  9. {$I GLScene.inc}
  10. uses
  11. WinApi.Windows,
  12. System.Classes,
  13. System.SysUtils,
  14. System.Win.Registry,
  15. System.ImageList,
  16. System.Actions,
  17. VCL.ActnList,
  18. VCL.Controls,
  19. VCL.Forms,
  20. VCL.ComCtrls,
  21. VCL.ImgList,
  22. VCL.Dialogs,
  23. VCL.Menus,
  24. VCL.ToolWin,
  25. VCL.ExtCtrls,
  26. VCL.StdCtrls,
  27. VCL.ClipBrd,
  28. DesignIntf,
  29. VCLEditors,
  30. GLScene,
  31. GLWin32Viewer,
  32. GLSceneRegister,
  33. GLStrings,
  34. FInfo,
  35. XCollection,
  36. GLCrossPlatform;
  37. const
  38. SCENE_SELECTED = 0;
  39. BEHAVIOURS_SELECTED = 1;
  40. EFFECTS_SELECTED = 2;
  41. type
  42. TSetSubItemsEvent = procedure(Sender: TObject) of object;
  43. TGLSceneEditorForm = class(TForm)
  44. PopupMenu: TPopupMenu;
  45. MIAddObject: TMenuItem;
  46. N1: TMenuItem;
  47. MIDelObject: TMenuItem;
  48. ToolBar: TToolBar;
  49. ActionList: TActionList;
  50. TBAddObjects: TToolButton;
  51. TBMoveUp: TToolButton;
  52. pmToolBar: TPopupMenu;
  53. TBDeleteObject: TToolButton;
  54. TBMoveDown: TToolButton;
  55. acAddObject: TAction;
  56. ImageList: TImageList;
  57. acDeleteObject: TAction;
  58. acMoveUp: TAction;
  59. acMoveDown: TAction;
  60. N2: TMenuItem;
  61. MIMoveUp: TMenuItem;
  62. MIMoveDown: TMenuItem;
  63. acSaveScene: TAction;
  64. acLoadScene: TAction;
  65. OpenDialog: TOpenDialog;
  66. SaveDialog: TSaveDialog;
  67. TBLoadScene: TToolButton;
  68. TBSaveScene: TToolButton;
  69. acInfo: TAction;
  70. acCopy: TAction;
  71. acCut: TAction;
  72. acPaste: TAction;
  73. MICopy: TMenuItem;
  74. MIPaste: TMenuItem;
  75. MICut: TMenuItem;
  76. TBCut: TToolButton;
  77. TBCopy: TToolButton;
  78. TBPaste: TToolButton;
  79. pmBehavioursToolbar: TPopupMenu;
  80. acAddBehaviour: TAction;
  81. MIAddBehaviour: TMenuItem;
  82. MIAddEffect: TMenuItem;
  83. MIBehaviourSeparator: TMenuItem;
  84. acDeleteBehaviour: TAction;
  85. pmBehaviours: TPopupMenu;
  86. Delete1: TMenuItem;
  87. MoveUp1: TMenuItem;
  88. MoveDown1: TMenuItem;
  89. N4: TMenuItem;
  90. pmEffectsToolbar: TPopupMenu;
  91. acAddEffect: TAction;
  92. TBCharacterPanels: TToolButton;
  93. TBStayOnTop: TToolButton;
  94. acStayOnTop: TAction;
  95. TBSeparator4: TToolButton;
  96. TBExpand: TToolButton;
  97. acExpand: TAction;
  98. PAGallery: TPanel;
  99. PATree: TPanel;
  100. Tree: TTreeView;
  101. TBInfo: TToolButton;
  102. GalleryListView: TListView;
  103. PABehaviours: TPanel;
  104. ToolBarBehaviours: TToolBar;
  105. TBAddBehaviours: TToolButton;
  106. BehavioursListView: TListView;
  107. PAEffects: TPanel;
  108. EffectsListView: TListView;
  109. ToolBarEffects: TToolBar;
  110. TBAddEffects: TToolButton;
  111. TBGalleryPanel: TToolButton;
  112. procedure FormCreate(Sender: TObject);
  113. procedure TreeEditing(Sender: TObject; Node: TTreeNode; var AllowEdit: Boolean);
  114. procedure TreeDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
  115. procedure TreeDragDrop(Sender, Source: TObject; X, Y: Integer);
  116. procedure TreeChange(Sender: TObject; Node: TTreeNode);
  117. procedure TreeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  118. procedure TreeEnter(Sender: TObject);
  119. procedure TreeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  120. procedure acDeleteObjectExecute(Sender: TObject);
  121. procedure acMoveUpExecute(Sender: TObject);
  122. procedure acMoveDownExecute(Sender: TObject);
  123. procedure acAddObjectExecute(Sender: TObject);
  124. procedure acSaveSceneExecute(Sender: TObject);
  125. procedure acLoadSceneExecute(Sender: TObject);
  126. procedure FormDestroy(Sender: TObject);
  127. procedure acInfoExecute(Sender: TObject);
  128. procedure acCopyExecute(Sender: TObject);
  129. procedure acCutExecute(Sender: TObject);
  130. procedure acPasteExecute(Sender: TObject);
  131. procedure BehavioursListViewEnter(Sender: TObject);
  132. procedure EffectsListViewEnter(Sender: TObject);
  133. procedure acAddBehaviourExecute(Sender: TObject);
  134. procedure DeleteBaseBehaviour(ListView: TListView);
  135. procedure pmBehavioursToolbarPopup(Sender: TObject);
  136. procedure pmEffectsToolbarPopup(Sender: TObject);
  137. procedure BehavioursListViewSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
  138. procedure acAddEffectExecute(Sender: TObject);
  139. procedure PopupMenuPopup(Sender: TObject);
  140. procedure TBCharacterPanelsClick(Sender: TObject);
  141. procedure TreeKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  142. procedure acStayOnTopExecute(Sender: TObject);
  143. procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  144. procedure acExpandExecute(Sender: TObject);
  145. procedure TBGalleryPanelClick(Sender: TObject);
  146. private
  147. FSelectedItems: Integer; //
  148. FScene: TGLScene;
  149. FObjectNode, FSceneObjects: TTreeNode;
  150. FCurrentDesigner: IDesigner;
  151. FLastMouseDownPos: TPoint;
  152. FPasteOwner: TComponent;
  153. FPasteSelection: IDesignerSelections;
  154. procedure ReadScene;
  155. procedure ResetTree;
  156. // adds the given scene object as well as its children to the tree structure and returns
  157. // the last add node (e.g. for selection)
  158. function AddNodes(ANode: TTreeNode; AObject: TGLBaseSceneObject): TTreeNode;
  159. procedure AddObjectClick(Sender: TObject);
  160. procedure AddBehaviourClick(Sender: TObject);
  161. procedure AddEffectClick(Sender: TObject);
  162. procedure SetObjectsSubItems(parent: TMenuItem);
  163. procedure SetXCollectionSubItems(parent: TMenuItem; XCollection: TXCollection; Event: TSetSubItemsEvent);
  164. procedure SetBehavioursSubItems(parent: TMenuItem; XCollection: TXCollection);
  165. procedure SetEffectsSubItems(parent: TMenuItem; XCollection: TXCollection);
  166. procedure OnBaseSceneObjectNameChanged(Sender: TObject);
  167. function IsValidClipBoardNode: Boolean;
  168. function IsPastePossible: Boolean;
  169. procedure ShowBehaviours(BaseSceneObject: TGLBaseSceneObject);
  170. procedure ShowEffects(BaseSceneObject: TGLBaseSceneObject);
  171. procedure ShowGallery(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. BehavioursListView.Items.Clear;
  275. EffectsListView.Items.Clear;
  276. GalleryListView.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.TreeChange(Sender: TObject; Node: TTreeNode);
  648. var
  649. // selNode : TTreeNode;
  650. BaseSceneObject1: TGLBaseSceneObject;
  651. begin
  652. if Assigned(FCurrentDesigner) then
  653. begin
  654. if Node <> nil then
  655. begin
  656. BaseSceneObject1 := TGLBaseSceneObject(Node.data);
  657. if BaseSceneObject1 <> nil then
  658. begin
  659. ShowBehavioursAndEffects(BaseSceneObject1);
  660. end;
  661. end;
  662. EnableAndDisableActions();
  663. end;
  664. end;
  665. procedure TGLSceneEditorForm.TreeEditing(Sender: TObject; Node: TTreeNode;
  666. var AllowEdit: Boolean);
  667. begin
  668. AllowEdit := (Node.Level > 1);
  669. end;
  670. procedure TGLSceneEditorForm.ShowBehaviours(BaseSceneObject
  671. : TGLBaseSceneObject);
  672. var
  673. I: Integer;
  674. DisplayedName: string;
  675. begin
  676. BehavioursListView.Items.Clear;
  677. BehavioursListView.Items.BeginUpdate;
  678. if Assigned(BaseSceneObject) then
  679. begin
  680. for I := 0 to BaseSceneObject.Behaviours.Count - 1 do
  681. begin
  682. with BehavioursListView.Items.Add do
  683. begin
  684. DisplayedName := BaseSceneObject.Behaviours[I].Name;
  685. if DisplayedName = '' then
  686. DisplayedName := '(unnamed)';
  687. Caption := IntToStr(I) + ' - ' + DisplayedName;
  688. SubItems.Add(BaseSceneObject.Behaviours[I].FriendlyName);
  689. data := BaseSceneObject.Behaviours[I];
  690. end;
  691. end;
  692. end;
  693. BehavioursListView.Items.EndUpdate;
  694. end;
  695. procedure TGLSceneEditorForm.ShowEffects(BaseSceneObject: TGLBaseSceneObject);
  696. var
  697. I: Integer;
  698. DisplayedName: string;
  699. begin
  700. EffectsListView.Items.Clear;
  701. EffectsListView.Items.BeginUpdate;
  702. if Assigned(BaseSceneObject) then
  703. begin
  704. for I := 0 to BaseSceneObject.Effects.Count - 1 do
  705. begin
  706. with EffectsListView.Items.Add do
  707. begin
  708. DisplayedName := BaseSceneObject.Effects[I].Name;
  709. if DisplayedName = '' then
  710. DisplayedName := '(unnamed)';
  711. Caption := IntToStr(I) + ' - ' + DisplayedName;
  712. SubItems.Add(BaseSceneObject.Effects[I].FriendlyName);
  713. Data := BaseSceneObject.Effects[I];
  714. end;
  715. end;
  716. end;
  717. EffectsListView.Items.EndUpdate;
  718. end;
  719. procedure TGLSceneEditorForm.ShowGallery(BaseSceneObject: TGLBaseSceneObject);
  720. var
  721. I: Integer;
  722. DisplayedName: string;
  723. begin
  724. // GalleryListView.LargeImages := ObjectManager.ObjectIcons;
  725. GalleryListView.Items.Clear;
  726. GalleryListView.Items.BeginUpdate;
  727. if Assigned(BaseSceneObject) then
  728. begin
  729. for I := 0 to BaseSceneObject.Count - 1 do
  730. begin
  731. with GalleryListView.Items.Add do
  732. begin
  733. DisplayedName := BaseSceneObject.Name;
  734. if DisplayedName = '' then
  735. DisplayedName := '(unnamed)';
  736. Caption := IntToStr(I) + ' - ' + DisplayedName;
  737. end;
  738. end;
  739. end;
  740. GalleryListView.Items.EndUpdate;
  741. end;
  742. procedure TGLSceneEditorForm.ShowBehavioursAndEffects(BaseSceneObject
  743. : TGLBaseSceneObject);
  744. begin
  745. ShowBehaviours(BaseSceneObject);
  746. ShowEffects(BaseSceneObject);
  747. ShowGallery(BaseSceneObject);
  748. end;
  749. procedure TGLSceneEditorForm.TreeEdited(Sender: TObject; Node: TTreeNode;
  750. var S: string);
  751. var
  752. BaseSceneObject1: TGLBaseSceneObject;
  753. begin
  754. if Assigned(FCurrentDesigner) then
  755. begin
  756. // renaming a node means renaming a scene object
  757. BaseSceneObject1 := TGLBaseSceneObject(Node.data);
  758. if FScene.FindSceneObject(S) = nil then
  759. BaseSceneObject1.Name := S
  760. else
  761. begin
  762. Messagedlg('A component named ' + S + ' already exists', mtWarning,
  763. [mbok], 0);
  764. S := BaseSceneObject1.Name;
  765. end;
  766. ShowBehavioursAndEffects(BaseSceneObject1);
  767. FCurrentDesigner.Modified;
  768. end;
  769. end;
  770. procedure TGLSceneEditorForm.TreeMouseDown(Sender: TObject;
  771. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  772. begin
  773. FLastMouseDownPos := Point(X, Y);
  774. end;
  775. procedure TGLSceneEditorForm.TreeMouseMove(Sender: TObject; Shift: TShiftState;
  776. X, Y: Integer);
  777. var
  778. Node: TTreeNode;
  779. begin
  780. if Shift = [ssLeft] then
  781. begin
  782. Node := Tree.Selected;
  783. if Assigned(Node) and (Node.Level > 1) then
  784. if (Abs(FLastMouseDownPos.X - X) > 4) or (Abs(FLastMouseDownPos.Y - Y) > 4)
  785. then
  786. Tree.BeginDrag(False);
  787. end;
  788. end;
  789. procedure TGLSceneEditorForm.TreeEnter(Sender: TObject);
  790. begin
  791. if Assigned(FCurrentDesigner) and Assigned(Tree.Selected) then
  792. FCurrentDesigner.SelectComponent(TGLBaseSceneObject(Tree.Selected.data));
  793. FSelectedItems := SCENE_SELECTED;
  794. EnableAndDisableActions();
  795. end;
  796. procedure TGLSceneEditorForm.acDeleteObjectExecute(Sender: TObject);
  797. var
  798. anObject: TGLBaseSceneObject;
  799. allowed, keepChildren: Boolean;
  800. confirmMsg: string;
  801. buttons: TMsgDlgButtons;
  802. begin
  803. if FSelectedItems = BEHAVIOURS_SELECTED then
  804. begin
  805. DeleteBaseBehaviour(BehavioursListView);
  806. FCurrentDesigner.SelectComponent(TGLBaseSceneObject(Tree.Selected.data));
  807. ShowBehaviours(TGLBaseSceneObject(Tree.Selected.data));
  808. end
  809. else if FSelectedItems = EFFECTS_SELECTED then
  810. begin
  811. DeleteBaseBehaviour(EffectsListView);
  812. FCurrentDesigner.SelectComponent(TGLBaseSceneObject(Tree.Selected.data));
  813. ShowEffects(TGLBaseSceneObject(Tree.Selected.data));
  814. end
  815. else if FSelectedItems = SCENE_SELECTED then
  816. begin
  817. if Assigned(Tree.Selected) and (Tree.Selected.Level > 1) then
  818. begin
  819. anObject := TGLBaseSceneObject(Tree.Selected.data);
  820. // ask for confirmation
  821. if anObject.Name <> '' then
  822. confirmMsg := 'Delete ' + anObject.Name
  823. else
  824. confirmMsg := 'Delete the marked object';
  825. buttons := [mbok, mbCancel];
  826. // are there children to care for?
  827. // mbAll exist only on Windows ...
  828. if (anObject.Count > 0) and (not anObject.HasSubChildren) then
  829. begin
  830. confirmMsg := confirmMsg + ' only or with ALL its children?';
  831. buttons := [mbAll] + buttons;
  832. end
  833. else
  834. confirmMsg := confirmMsg + '?';
  835. case Messagedlg(confirmMsg, mtConfirmation, buttons, 0) of
  836. mrAll:
  837. begin
  838. keepChildren := False;
  839. allowed := true;
  840. end;
  841. mrOK:
  842. begin
  843. keepChildren := true;
  844. allowed := true;
  845. end;
  846. mrCancel:
  847. begin
  848. allowed := False;
  849. keepChildren := true;
  850. end;
  851. else
  852. allowed := False;
  853. keepChildren := true;
  854. end;
  855. // deletion allowed?
  856. if allowed then
  857. begin
  858. if keepChildren = true then
  859. while Tree.Selected.Count > 0 do
  860. Tree.Selected.Item[0].MoveTo(Tree.Selected, naAdd);
  861. // previous line should be "naInsert" if children are to remain in position of parent
  862. // (would require changes to TGLBaseSceneObject.Remove)
  863. Tree.Selected.Free;
  864. FCurrentDesigner.SelectComponent(nil);
  865. anObject.parent.Remove(anObject, keepChildren);
  866. anObject.Free;
  867. end
  868. end;
  869. end;
  870. end;
  871. procedure TGLSceneEditorForm.acExpandExecute(Sender: TObject);
  872. begin
  873. if FSceneObjects <> nil then
  874. try
  875. Tree.Items.BeginUpdate;
  876. if TBExpand.Down then
  877. Tree.FullExpand
  878. else
  879. begin
  880. FSceneObjects.Collapse(True);
  881. FSceneObjects.Expand(False);
  882. end;
  883. finally
  884. Tree.Items.EndUpdate;
  885. end;
  886. end;
  887. procedure TGLSceneEditorForm.acMoveUpExecute(Sender: TObject);
  888. var
  889. Node: TTreeNode;
  890. prevData: Pointer;
  891. begin
  892. if FSelectedItems = BEHAVIOURS_SELECTED then
  893. begin
  894. prevData := BehavioursListView.Selected.data;
  895. TGLBaseBehaviour(prevData).MoveUp;
  896. ShowBehaviours(TGLBaseSceneObject(Tree.Selected.data));
  897. BehavioursListView.Selected := BehavioursListView.FindData(0, prevData,
  898. true, False);
  899. FCurrentDesigner.Modified;
  900. end
  901. else if FSelectedItems = EFFECTS_SELECTED then
  902. begin
  903. prevData := EffectsListView.Selected.data;
  904. TGLBaseBehaviour(prevData).MoveUp;
  905. ShowEffects(TGLBaseSceneObject(Tree.Selected.data));
  906. EffectsListView.Selected := EffectsListView.FindData(0, prevData,
  907. true, False);
  908. FCurrentDesigner.Modified;
  909. end
  910. else if FSelectedItems = SCENE_SELECTED then
  911. begin
  912. if ACMoveUp.Enabled then
  913. begin
  914. Node := Tree.Selected;
  915. if Assigned(Node) then
  916. begin
  917. Node.MoveTo(Node.GetPrevSibling, naInsert);
  918. with TGLBaseSceneObject(Node.data) do
  919. begin
  920. MoveUp;
  921. Update;
  922. end;
  923. TreeChange(Self, Node);
  924. FCurrentDesigner.Modified;
  925. end;
  926. end;
  927. end;
  928. end;
  929. procedure TGLSceneEditorForm.acMoveDownExecute(Sender: TObject);
  930. var
  931. Node: TTreeNode;
  932. prevData: Pointer;
  933. begin
  934. if FSelectedItems = BEHAVIOURS_SELECTED then
  935. begin
  936. prevData := BehavioursListView.Selected.data;
  937. TGLBaseBehaviour(prevData).MoveDown;
  938. ShowBehaviours(TGLBaseSceneObject(Tree.Selected.data));
  939. BehavioursListView.Selected := BehavioursListView.FindData(0, prevData,
  940. true, False);
  941. FCurrentDesigner.Modified;
  942. end
  943. else if FSelectedItems = EFFECTS_SELECTED then
  944. begin
  945. prevData := EffectsListView.Selected.data;
  946. TGLBaseBehaviour(prevData).MoveDown;
  947. ShowEffects(TGLBaseSceneObject(Tree.Selected.data));
  948. EffectsListView.Selected := EffectsListView.FindData(0, prevData,
  949. true, False);
  950. FCurrentDesigner.Modified;
  951. end
  952. else if FSelectedItems = SCENE_SELECTED then
  953. begin
  954. if ACMoveDown.Enabled then
  955. begin
  956. Node := Tree.Selected;
  957. if Assigned(Node) then
  958. begin
  959. Node.getNextSibling.MoveTo(Node, naInsert);
  960. with TGLBaseSceneObject(Node.data) do
  961. begin
  962. MoveDown;
  963. Update;
  964. end;
  965. TreeChange(Self, Node);
  966. FCurrentDesigner.Modified;
  967. end;
  968. end;
  969. end;
  970. end;
  971. procedure TGLSceneEditorForm.acAddObjectExecute(Sender: TObject);
  972. begin
  973. TBAddObjects.CheckMenuDropdown;
  974. end;
  975. procedure TGLSceneEditorForm.acStayOnTopExecute(Sender: TObject);
  976. begin
  977. if TBStayOnTop.Down then
  978. FormStyle := fsStayOnTop
  979. else
  980. FormStyle := fsNormal;
  981. end;
  982. procedure TGLSceneEditorForm.acSaveSceneExecute(Sender: TObject);
  983. begin
  984. if SaveDialog.Execute then
  985. FScene.SaveToFile(SaveDialog.FileName);
  986. end;
  987. procedure TGLSceneEditorForm.acLoadSceneExecute(Sender: TObject);
  988. begin
  989. if OpenDialog.Execute then
  990. begin
  991. FScene.LoadFromFile(OpenDialog.FileName);
  992. ResetTree;
  993. ReadScene;
  994. ShowBehavioursAndEffects(nil);
  995. end;
  996. end;
  997. procedure TGLSceneEditorForm.acInfoExecute(Sender: TObject);
  998. var
  999. AScene: TGLSceneViewer;
  1000. begin
  1001. AScene := TGLSceneViewer.Create(Self);
  1002. AScene.Name := 'GLSceneEditor';
  1003. AScene.Width := 0;
  1004. AScene.Height := 0;
  1005. AScene.parent := Self;
  1006. try
  1007. AScene.Buffer.ShowInfo;
  1008. finally
  1009. AScene.Free;
  1010. end;
  1011. end;
  1012. function TGLSceneEditorForm.IsValidClipBoardNode: Boolean;
  1013. var
  1014. selNode: TTreeNode;
  1015. begin
  1016. selNode := Tree.Selected;
  1017. Result := ((selNode <> nil) and (selNode.parent <> nil) and
  1018. (selNode.parent.parent <> nil));
  1019. end;
  1020. function TGLSceneEditorForm.IsPastePossible: Boolean;
  1021. function PossibleStream(const S: string): Boolean;
  1022. var
  1023. I: Integer;
  1024. begin
  1025. Result := true;
  1026. for I := 1 to Length(S) - 6 do
  1027. begin
  1028. if CharInSet(S[I], ['O', 'o']) and
  1029. (CompareText(Copy(S, I, 6), 'OBJECT') = 0) then
  1030. Exit;
  1031. if not CharInSet(S[I], [' ', #9, #13, #10]) then
  1032. Break;
  1033. end;
  1034. Result := False;
  1035. end;
  1036. var
  1037. selNode: TTreeNode;
  1038. anObject, destination: TGLBaseSceneObject;
  1039. ComponentList: IDesignerSelections;
  1040. TmpContainer: TComponent;
  1041. begin
  1042. selNode := Tree.Selected;
  1043. if (selNode <> nil) and (selNode.parent <> nil)
  1044. and (ClipBoard.HasFormat(CF_COMPONENT) or (ClipBoard.HasFormat(CF_TEXT) and
  1045. PossibleStream(ClipBoard.AsText))) then
  1046. begin
  1047. TmpContainer := TComponent.Create(Self);
  1048. try
  1049. ComponentList := TDesignerSelections.Create;
  1050. if PasteComponents(TmpContainer, TmpContainer, ComponentList) then
  1051. if (ComponentList.Count > 0) and (ComponentList[0] is TGLBaseSceneObject)
  1052. then
  1053. begin
  1054. anObject := TGLBaseSceneObject(ComponentList[0]);
  1055. destination := TGLBaseSceneObject(selNode.data);
  1056. Result := CanPaste(anObject, destination);
  1057. end
  1058. else
  1059. Result := False
  1060. else
  1061. Result := False;
  1062. finally
  1063. TmpContainer.Free;
  1064. end;
  1065. end
  1066. else
  1067. Result := False;
  1068. end;
  1069. function TGLSceneEditorForm.CanPaste(obj, destination
  1070. : TGLBaseSceneObject): Boolean;
  1071. begin
  1072. Result := Assigned(obj) and Assigned(destination);
  1073. end;
  1074. procedure TGLSceneEditorForm.acCopyExecute(Sender: TObject);
  1075. var
  1076. ComponentList: IDesignerSelections;
  1077. begin
  1078. ComponentList := TDesignerSelections.Create;
  1079. ComponentList.Add(TGLBaseSceneObject(Tree.Selected.data));
  1080. CopyComponents(FScene.owner, ComponentList);
  1081. ACPaste.Enabled := IsPastePossible;
  1082. end;
  1083. procedure TGLSceneEditorForm.acCutExecute(Sender: TObject);
  1084. var
  1085. AObject: TGLBaseSceneObject;
  1086. ComponentList: IDesignerSelections;
  1087. begin
  1088. if IsValidClipBoardNode then
  1089. begin
  1090. AObject := TGLBaseSceneObject(Tree.Selected.data);
  1091. ComponentList := TDesignerSelections.Create;
  1092. ComponentList.Add(TGLBaseSceneObject(Tree.Selected.data));
  1093. CopyComponents(FScene.owner, ComponentList);
  1094. AObject.parent.Remove(AObject, False);
  1095. AObject.Free;
  1096. Tree.Selected.Free;
  1097. ACPaste.Enabled := IsPastePossible;
  1098. end;
  1099. end;
  1100. procedure TGLSceneEditorForm.acPasteExecute(Sender: TObject);
  1101. var
  1102. selNode: TTreeNode;
  1103. destination: TGLBaseSceneObject;
  1104. ComponentList: IDesignerSelections;
  1105. t: Integer;
  1106. begin
  1107. selNode := Tree.Selected;
  1108. if (selNode <> nil) and (selNode.parent <> nil) then
  1109. begin
  1110. destination := TGLBaseSceneObject(selNode.data);
  1111. ComponentList := TDesignerSelections.Create;
  1112. PasteComponents(FScene.owner, destination, ComponentList);
  1113. if (ComponentList.Count > 0) and
  1114. (CanPaste(TGLBaseSceneObject(ComponentList[0]), destination)) then
  1115. begin
  1116. for t := 0 to ComponentList.Count - 1 do
  1117. AddNodes(selNode, TGLBaseSceneObject(ComponentList[t]));
  1118. selNode.Expand(False);
  1119. end;
  1120. FCurrentDesigner.Modified;
  1121. end;
  1122. end;
  1123. procedure TGLSceneEditorForm.CopyComponents(Root: TComponent;
  1124. const Components: IDesignerSelections);
  1125. var
  1126. S: TMemoryStream;
  1127. W: TWriter;
  1128. I: Integer;
  1129. begin
  1130. S := TMemoryStream.Create;
  1131. try
  1132. W := TWriter.Create(S, 1024);
  1133. try
  1134. W.Root := Root;
  1135. for I := 0 to Components.Count - 1 do
  1136. begin
  1137. W.WriteSignature;
  1138. W.WriteComponent(TComponent(Components[I]));
  1139. end;
  1140. W.WriteListEnd;
  1141. finally
  1142. W.Free;
  1143. end;
  1144. CopyStreamToClipboard(S);
  1145. finally
  1146. S.Free;
  1147. end;
  1148. end;
  1149. procedure TGLSceneEditorForm.MethodError(Reader: TReader;
  1150. const MethodName: string; var Address: Pointer; var Error: Boolean);
  1151. begin
  1152. // error is true because Address is nil in csDesigning
  1153. Error := False;
  1154. end;
  1155. function TGLSceneEditorForm.PasteComponents(AOwner, AParent: TComponent;
  1156. const Components: IDesignerSelections): Boolean;
  1157. var
  1158. S: TStream;
  1159. R: TReader;
  1160. begin
  1161. // catch GetClipboardStream exceptions that can easilly occured
  1162. try
  1163. S := GetClipboardStream;
  1164. try
  1165. R := TReader.Create(S, 1024);
  1166. try
  1167. R.OnSetName := ReaderSetName;
  1168. R.OnFindMethod := MethodError;
  1169. FPasteOwner := AOwner;
  1170. FPasteSelection := Components;
  1171. R.ReadComponents(AOwner, AParent, ComponentRead);
  1172. Result := true;
  1173. finally
  1174. R.Free;
  1175. end;
  1176. finally
  1177. S.Free;
  1178. end;
  1179. finally
  1180. end;
  1181. end;
  1182. procedure TGLSceneEditorForm.ReaderSetName(Reader: TReader;
  1183. Component: TComponent; var Name: string);
  1184. begin
  1185. if (Reader.Root = FPasteOwner) and (FPasteOwner.FindComponent(Name) <> nil)
  1186. then
  1187. Name := UniqueName(Component);
  1188. end;
  1189. function TGLSceneEditorForm.UniqueName(Component: TComponent): string;
  1190. begin
  1191. Result := FCurrentDesigner.UniqueName(Component.ClassName);
  1192. end;
  1193. procedure TGLSceneEditorForm.ComponentRead(Component: TComponent);
  1194. begin
  1195. FPasteSelection.Add(Component);
  1196. end;
  1197. procedure TGLSceneEditorForm.BehavioursListViewEnter(Sender: TObject);
  1198. begin
  1199. if Assigned(FCurrentDesigner) and Assigned(BehavioursListView.Selected) then
  1200. FCurrentDesigner.SelectComponent
  1201. (TGLBaseBehaviour(BehavioursListView.Selected.data));
  1202. FSelectedItems := BEHAVIOURS_SELECTED;
  1203. EnableAndDisableActions();
  1204. end;
  1205. procedure TGLSceneEditorForm.EffectsListViewEnter(Sender: TObject);
  1206. begin
  1207. if Assigned(FCurrentDesigner) and Assigned(EffectsListView.Selected) then
  1208. FCurrentDesigner.SelectComponent
  1209. (TGLBaseBehaviour(EffectsListView.Selected.data));
  1210. FSelectedItems := EFFECTS_SELECTED;
  1211. EnableAndDisableActions();
  1212. end;
  1213. procedure TGLSceneEditorForm.acAddBehaviourExecute(Sender: TObject);
  1214. begin
  1215. TBAddBehaviours.CheckMenuDropdown
  1216. end;
  1217. procedure TGLSceneEditorForm.DeleteBaseBehaviour(ListView: TListView);
  1218. begin
  1219. if ListView.Selected <> nil then
  1220. begin
  1221. FCurrentDesigner.Modified;
  1222. FCurrentDesigner.NoSelection;
  1223. TXCollectionItem(ListView.Selected.data).Free;
  1224. ListView.Selected.Free;
  1225. // ListViewChange(Self, nil, ctState);
  1226. ShowBehavioursAndEffects(TGLBaseSceneObject(Tree.Selected.data));
  1227. end;
  1228. end;
  1229. procedure TGLSceneEditorForm.pmBehavioursToolbarPopup(Sender: TObject);
  1230. var
  1231. object1: TGLBaseSceneObject;
  1232. begin
  1233. if (Tree.Selected) <> nil then
  1234. begin
  1235. object1 := TGLBaseSceneObject(Tree.Selected.data);
  1236. SetBehavioursSubItems(PMBehavioursToolbar.Items, object1.Behaviours);
  1237. end;
  1238. end;
  1239. procedure TGLSceneEditorForm.pmEffectsToolbarPopup(Sender: TObject);
  1240. var
  1241. object1: TGLBaseSceneObject;
  1242. begin
  1243. if (Tree.Selected) <> nil then
  1244. begin
  1245. object1 := TGLBaseSceneObject(Tree.Selected.data);
  1246. SetEffectsSubItems(PMEffectsToolbar.Items, object1.Effects);
  1247. end;
  1248. end;
  1249. procedure TGLSceneEditorForm.BehavioursListViewSelectItem(Sender: TObject;
  1250. Item: TListItem; Selected: Boolean);
  1251. begin
  1252. EnableAndDisableActions();
  1253. end;
  1254. procedure TGLSceneEditorForm.acAddEffectExecute(Sender: TObject);
  1255. begin
  1256. TBAddEffects.CheckMenuDropdown;
  1257. end;
  1258. procedure TGLSceneEditorForm.EnableAndDisableActions();
  1259. var
  1260. selNode: TTreeNode;
  1261. begin
  1262. if FSelectedItems = SCENE_SELECTED then
  1263. begin
  1264. selNode := Tree.Selected;
  1265. // select in Delphi IDE
  1266. if Assigned(selNode) then
  1267. begin
  1268. if Assigned(selNode.data) then
  1269. FCurrentDesigner.SelectComponent(TGLBaseSceneObject(selNode.data))
  1270. else
  1271. FCurrentDesigner.SelectComponent(FScene);
  1272. // enablings
  1273. ACAddObject.Enabled := ((selNode = FObjectNode) or selNode.HasAsParent(FObjectNode));
  1274. ACAddBehaviour.Enabled := (selNode.HasAsParent(FObjectNode));
  1275. ACAddEffect.Enabled := (selNode.HasAsParent(FObjectNode));
  1276. ACDeleteObject.Enabled := (selNode.Level > 1);
  1277. ACMoveUp.Enabled := ((selNode.Index > 0) and (selNode.Level > 1));
  1278. ACMoveDown.Enabled := ((selNode.getNextSibling <> nil) and (selNode.Level > 1));
  1279. ACCut.Enabled := IsValidClipBoardNode;
  1280. ACPaste.Enabled := IsPastePossible;
  1281. end
  1282. else
  1283. begin
  1284. ACAddObject.Enabled := False;
  1285. ACAddBehaviour.Enabled := False;
  1286. ACAddEffect.Enabled := False;
  1287. ACDeleteObject.Enabled := False;
  1288. ACMoveUp.Enabled := False;
  1289. ACMoveDown.Enabled := False;
  1290. ACCut.Enabled := False;
  1291. ACPaste.Enabled := False;
  1292. end;
  1293. // end;
  1294. ACCopy.Enabled := ACCut.Enabled;
  1295. end
  1296. else if FSelectedItems = BEHAVIOURS_SELECTED then
  1297. begin
  1298. if (BehavioursListView.Selected <> nil) then
  1299. begin
  1300. FCurrentDesigner.SelectComponent
  1301. (TGLBaseBehaviour(BehavioursListView.Selected.data));
  1302. ACDeleteObject.Enabled := true;
  1303. ACMoveUp.Enabled := (BehavioursListView.Selected.Index > 0);
  1304. ACMoveDown.Enabled := (BehavioursListView.Selected.
  1305. Index < BehavioursListView.Selected.owner.Count - 1);
  1306. ACCut.Enabled := False;
  1307. ACCopy.Enabled := False;
  1308. ACPaste.Enabled := False;
  1309. end
  1310. else
  1311. begin
  1312. ACDeleteObject.Enabled := False;
  1313. ACMoveUp.Enabled := False;
  1314. ACMoveDown.Enabled := False;
  1315. ACCut.Enabled := False;
  1316. ACCopy.Enabled := False;
  1317. ACPaste.Enabled := False;
  1318. end;
  1319. end
  1320. else if FSelectedItems = EFFECTS_SELECTED then
  1321. begin
  1322. if (EffectsListView.Selected <> nil) then
  1323. begin
  1324. FCurrentDesigner.SelectComponent
  1325. (TGLBaseBehaviour(EffectsListView.Selected.data));
  1326. ACDeleteObject.Enabled := true;
  1327. ACMoveUp.Enabled := (EffectsListView.Selected.Index > 0);
  1328. ACMoveDown.Enabled := (EffectsListView.Selected.
  1329. Index < EffectsListView.Selected.owner.Count - 1);
  1330. ACCut.Enabled := False;
  1331. ACCopy.Enabled := False;
  1332. ACPaste.Enabled := False;
  1333. end
  1334. else
  1335. begin
  1336. ACDeleteObject.Enabled := False;
  1337. ACMoveUp.Enabled := False;
  1338. ACMoveDown.Enabled := False;
  1339. ACCut.Enabled := False;
  1340. ACCopy.Enabled := False;
  1341. ACPaste.Enabled := False;
  1342. end;
  1343. end;
  1344. end;
  1345. procedure TGLSceneEditorForm.PopupMenuPopup(Sender: TObject);
  1346. var
  1347. obj: TObject;
  1348. sceneObj: TGLBaseSceneObject;
  1349. begin
  1350. if (Tree.Selected) <> nil then
  1351. begin
  1352. obj := TObject(Tree.Selected.data);
  1353. if Assigned(obj) and (obj is TGLBaseSceneObject) then
  1354. begin
  1355. sceneObj := TGLBaseSceneObject(obj);
  1356. SetBehavioursSubItems(MIAddBehaviour, sceneObj.Behaviours);
  1357. SetEffectsSubItems(MIAddEffect, sceneObj.Effects);
  1358. end
  1359. else
  1360. begin
  1361. SetBehavioursSubItems(MIAddBehaviour, nil);
  1362. SetEffectsSubItems(MIAddEffect, nil);
  1363. end;
  1364. end;
  1365. end;
  1366. procedure TGLSceneEditorForm.TBCharacterPanelsClick(Sender: TObject);
  1367. begin
  1368. PABehaviours.Visible := TBCharacterPanels.Down;
  1369. PAEffects.Visible := TBCharacterPanels.Down;
  1370. if PABehaviours.Visible then
  1371. Height := Height + PABehaviours.Height + PAEffects.Height
  1372. else
  1373. Height := Height - PABehaviours.Height - PAEffects.Height;
  1374. end;
  1375. procedure TGLSceneEditorForm.TBGalleryPanelClick(Sender: TObject);
  1376. begin
  1377. //yet not ready to populate with LargeImages 32x32
  1378. PAGallery.Visible := TBGalleryPanel.Down;
  1379. if PAGallery.Visible then
  1380. Width := Width + PATree.Width
  1381. else
  1382. Width := Width - PATree.Width;
  1383. end;
  1384. procedure TGLSceneEditorForm.TreeKeyDown(Sender: TObject; var Key: Word;
  1385. Shift: TShiftState);
  1386. var
  1387. FNode: TTreeNode;
  1388. begin
  1389. if (Key = VK_DELETE) and not Tree.IsEditing then
  1390. begin
  1391. Key := 0;
  1392. ACDeleteObject.Execute;
  1393. end;
  1394. if Key = VK_F2 then
  1395. begin
  1396. FNode := Tree.Selected;
  1397. if FNode.Level > 1 then
  1398. begin
  1399. FNode.EditText;
  1400. end;
  1401. end;
  1402. end;
  1403. //--------------------------------------------------------------
  1404. initialization
  1405. //--------------------------------------------------------------
  1406. finalization
  1407. ReleaseGLSceneEditorForm;
  1408. end.