FmSceneEditor.pas 42 KB

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