GLS.SceneRegister.pas 61 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846
  1. //
  2. // The graphics rendering engine GLScene http://glscene.org
  3. //
  4. unit GLS.SceneRegister;
  5. (*
  6. Registration unit for library components, property editors and
  7. IDE experts.
  8. *)
  9. interface
  10. {$I GLScene.inc}
  11. uses
  12. WinApi.Windows,
  13. System.Classes,
  14. System.SysUtils,
  15. System.TypInfo,
  16. VCL.Forms,
  17. VCL.Dialogs,
  18. VCL.Controls,
  19. VCL.StdCtrls,
  20. VCL.Graphics,
  21. ToolsAPI,
  22. DesignIntf,
  23. DesignEditors,
  24. VCLEditors,
  25. GLS.Context,
  26. GLS.Scene,
  27. GLS.Color,
  28. GLS.ObjectManager,
  29. GLS.PluginManager,
  30. GLS.Strings;
  31. type
  32. TGLLibMaterialNameProperty = class(TStringProperty)
  33. public
  34. function GetAttributes: TPropertyAttributes; override;
  35. procedure Edit; override;
  36. end;
  37. TGLSceneViewerEditor = class(TComponentEditor)
  38. public
  39. procedure ExecuteVerb(Index: Integer); override;
  40. function GetVerb(Index: Integer): string; override;
  41. function GetVerbCount: Integer; override;
  42. end;
  43. TGLSceneEditor = class(TComponentEditor)
  44. public
  45. procedure Edit; override;
  46. procedure ExecuteVerb(Index: Integer); override;
  47. function GetVerb(Index: Integer): string; override;
  48. function GetVerbCount: Integer; override;
  49. end;
  50. TGLResolutionProperty = class(TPropertyEditor)
  51. public
  52. function GetAttributes: TPropertyAttributes; override;
  53. function GetValue: string; override;
  54. procedure GetValues(Proc: TGetStrProc); override;
  55. procedure SetValue(const Value: string); override;
  56. end;
  57. TGLTextureProperty = class(TClassProperty)
  58. public
  59. function GetAttributes: TPropertyAttributes; override;
  60. end;
  61. TGLTextureImageProperty = class(TClassProperty)
  62. public
  63. function GetAttributes: TPropertyAttributes; override;
  64. procedure Edit; override;
  65. end;
  66. TGLImageClassProperty = class(TClassProperty)
  67. public
  68. function GetAttributes: TPropertyAttributes; override;
  69. procedure GetValues(Proc: TGetStrProc); override;
  70. function GetValue: string; override;
  71. procedure SetValue(const Value: string); override;
  72. end;
  73. TGLColorProperty = class(TClassProperty, ICustomPropertyDrawing,
  74. ICustomPropertyListDrawing)
  75. protected
  76. function ColorToBorderColor(aColor: TGLColorVector; selected: Boolean): TColor;
  77. public
  78. function GetAttributes: TPropertyAttributes; override;
  79. procedure GetValues(Proc: TGetStrProc); override;
  80. procedure Edit; override;
  81. // ICustomPropertyListDrawing stuff
  82. procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas; var AHeight: Integer);
  83. procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer);
  84. procedure ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  85. // CustomPropertyDrawing
  86. procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  87. procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  88. function GetValue: string; override;
  89. procedure SetValue(const Value: string); override;
  90. end;
  91. TGLSoundFileProperty = class(TClassProperty)
  92. public
  93. function GetAttributes: TPropertyAttributes; override;
  94. function GetValue: string; override;
  95. procedure Edit; override;
  96. end;
  97. TGLSoundNameProperty = class(TStringProperty)
  98. public
  99. function GetAttributes: TPropertyAttributes; override;
  100. procedure GetValues(Proc: TGetStrProc); override;
  101. end;
  102. TGLCoordinatesProperty = class(TClassProperty)
  103. public
  104. function GetAttributes: TPropertyAttributes; override;
  105. procedure Edit; override;
  106. end;
  107. TGLMaterialProperty = class(TClassProperty)
  108. public
  109. function GetAttributes: TPropertyAttributes; override;
  110. procedure Edit; override;
  111. end;
  112. TGLGUILayoutEditor = class(TComponentEditor)
  113. public
  114. procedure Edit; override;
  115. procedure ExecuteVerb(Index: Integer); override;
  116. function GetVerb(Index: Integer): string; override;
  117. function GetVerbCount: Integer; override;
  118. end;
  119. (* Editor copied from DsgnIntf.
  120. Could have been avoided, if only that guy at Borland didn't chose to
  121. publish only half of the stuff (and that's not the only class with
  122. that problem, most of the subitems handling code in TGLSceneBaseObject is
  123. here for the same reason...), the "protected" wasn't meant just to lure
  124. programmers into code they can't reuse... Arrr! and he did that again
  125. in D6! Grrr... *)
  126. TGLReuseableDefaultEditor = class(TComponentEditor, IDefaultEditor)
  127. protected
  128. FFirst: IProperty;
  129. FBest: IProperty;
  130. FContinue: Boolean;
  131. procedure CheckEdit(const Prop: IProperty);
  132. procedure EditProperty(const Prop: IProperty; var Continue: Boolean); virtual;
  133. public
  134. procedure Edit; override;
  135. end;
  136. // Editor for material library.
  137. TGLMaterialLibraryEditor = class(TGLReuseableDefaultEditor, IDefaultEditor)
  138. protected
  139. procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override;
  140. public
  141. procedure ExecuteVerb(Index: Integer); override;
  142. function GetVerb(Index: Integer): string; override;
  143. function GetVerbCount: Integer; override;
  144. end;
  145. TGLAnimationNameProperty = class(TStringProperty)
  146. public
  147. function GetAttributes: TPropertyAttributes; override;
  148. procedure GetValues(Proc: TGetStrProc); override;
  149. end;
  150. (* Selection editor for TGLSoundLibrary
  151. Allows units to be added to the uses clause automatically when
  152. sound files are loaded into a TGLSoundLibrary at design-time. *)
  153. TGLSoundLibrarySelectionEditor = class(TSelectionEditor)
  154. public
  155. procedure RequiresUnits(Proc: TGetStrProc); override;
  156. end;
  157. (* Selection editor for TGLBaseSceneObject.
  158. Allows units to be added to the uses clause automatically when
  159. behaviours/effects are added to a TGLBaseSceneObject at design-time. *)
  160. TGLBaseSceneObjectSelectionEditor = class(TSelectionEditor)
  161. public
  162. procedure RequiresUnits(Proc: TGetStrProc); override;
  163. end;
  164. // Editor for Archive Manager
  165. TGLSArchiveManagerEditor = class(TGLReuseableDefaultEditor, IDefaultEditor)
  166. protected
  167. procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override;
  168. public
  169. procedure ExecuteVerb(Index: Integer); override;
  170. function GetVerb(Index: Integer): string; override;
  171. function GetVerbCount: Integer; override;
  172. end;
  173. TGLMaterialComponentNameProperty = class(TStringProperty)
  174. public
  175. function GetAttributes: TPropertyAttributes; override;
  176. procedure Edit; override;
  177. end;
  178. TGLLibTextureNameProperty = class(TGLMaterialComponentNameProperty)
  179. public
  180. procedure GetValues(Proc: TGetStrProc); override;
  181. end;
  182. TGLLibSamplerNameProperty = class(TGLMaterialComponentNameProperty)
  183. public
  184. procedure GetValues(Proc: TGetStrProc); override;
  185. end;
  186. TGLLibCombinerNameProperty = class(TGLMaterialComponentNameProperty)
  187. public
  188. procedure GetValues(Proc: TGetStrProc); override;
  189. end;
  190. TGLLibShaderNameProperty = class(TGLMaterialComponentNameProperty)
  191. public
  192. procedure GetValues(Proc: TGetStrProc); override;
  193. end;
  194. TGLLibAttachmentNameProperty = class(TGLMaterialComponentNameProperty)
  195. public
  196. procedure GetValues(Proc: TGetStrProc); override;
  197. end;
  198. TGLLibAsmProgNameProperty = class(TGLMaterialComponentNameProperty)
  199. public
  200. procedure GetValues(Proc: TGetStrProc); override;
  201. end;
  202. TPictureFileProperty = class(TStringProperty)
  203. public
  204. function GetAttributes: TPropertyAttributes; override;
  205. procedure Edit; override;
  206. end;
  207. TShaderFileProperty = class(TStringProperty)
  208. public
  209. function GetAttributes: TPropertyAttributes; override;
  210. procedure Edit; override;
  211. end;
  212. TAsmProgFileProperty = class(TStringProperty)
  213. public
  214. function GetAttributes: TPropertyAttributes; override;
  215. procedure Edit; override;
  216. end;
  217. TUniformAutoSetProperty = class(TPropertyEditor)
  218. private
  219. procedure PassUniform(const S: string);
  220. public
  221. function GetAttributes: TPropertyAttributes; override;
  222. procedure Edit; override;
  223. end;
  224. TGLShaderEditorProperty = class(TClassProperty)
  225. protected
  226. function GetStrings: TStrings;
  227. procedure SetStrings(const Value: TStrings);
  228. procedure OnShaderCheck(Sender: TObject);
  229. public
  230. function GetAttributes: TPropertyAttributes; override;
  231. procedure Edit; override;
  232. end;
  233. // Register Components
  234. procedure Register;
  235. // Auto-create for object manager
  236. function ObjectManager: TGLObjectManager;
  237. // ------------------------------------------------------------------
  238. implementation
  239. // ------------------------------------------------------------------
  240. uses
  241. FmLibMaterialPicker,
  242. FmGUILayoutEditor,
  243. FmMaterialEditor,
  244. FmShaderMemo,
  245. FmShaderUniformEditor,
  246. FmVectorEditor,
  247. FmSceneEditor,
  248. GLS.ApplicationFileIO,
  249. GLS.VectorGeometry,
  250. GLS.ScriptBase,
  251. GLS.AnimatedSprite,
  252. GLS.AsyncHDS,
  253. GLS.AsyncTimer,
  254. GLS.Atmosphere,
  255. GLS.AVIRecorder,
  256. GLS.BaseClasses,
  257. GLS.BitmapFont,
  258. GLS.Blur,
  259. GLS.BumpMapHDS,
  260. GLS.Cadencer,
  261. GLS.CameraController,
  262. GLS.Collision,
  263. GLS.CompositeImage,
  264. GLS.Console,
  265. GLS.Coordinates,
  266. GLS.DCE,
  267. GLS.DynamicTexture,
  268. GLS.EParticleMasksManager,
  269. GLS.ExplosionFx,
  270. GLS.Extrusion,
  271. GLS.FBORenderer,
  272. GLS.Feedback,
  273. GLS.FireFX,
  274. GLS.FPSMovement,
  275. GLS.GameMenu,
  276. GLS.GeomObjects,
  277. GLS.Gizmo,
  278. GLS.Graph,
  279. GLS.Graphics,
  280. GLS.Gui,
  281. GLS.HeightData,
  282. GLS.HeightTileFileHDS,
  283. GLS.HudObjects,
  284. GLS.Imposter,
  285. GLS.LensFlare,
  286. GLS.LinePFX,
  287. GLS.Material,
  288. GLS.MaterialEx,
  289. GLS.MaterialMultiProxy,
  290. GLS.MaterialScript,
  291. GLS.Mesh,
  292. GLS.Mirror,
  293. GLS.MultiPolygon,
  294. GLS.MultiProxy,
  295. GLS.Navigator,
  296. GLS.Nodes,
  297. GLS.Objects,
  298. GLS.ParticleFX,
  299. GLS.Particles,
  300. GLS.Perlin,
  301. GLS.PerlinPFX,
  302. GLS.Portal,
  303. GLS.Screen,
  304. GLS.ShadowHDS,
  305. GLS.ShadowPlane,
  306. GLS.ShadowVolume,
  307. GLS.SimpleNavigation,
  308. GLS.SkyDome,
  309. GLS.ProxyObjects,
  310. GLS.RenderContextInfo,
  311. GLS.ArchiveManager,
  312. GLS.Language,
  313. GLS.Memo,
  314. GLS.SmoothNavigator,
  315. GLS.Utils,
  316. GLSL.AsmShader,
  317. GLSL.BumpShaders,
  318. GLSL.ShapeShaders,
  319. GLSL.LineShaders,
  320. GLSL.ShaderCombiner,
  321. GLSL.PhongShader,
  322. GLSL.PostEffects,
  323. GLSL.ProjectedTextures,
  324. GLSL.DiffuseSpecularShader,
  325. GLSL.MultiMaterialShader,
  326. GLSL.PostShaders,
  327. GLSL.Shader,
  328. GLSL.TextureShaders,
  329. GLSL.UserShader,
  330. GLS.ProjectedTextures,
  331. GLS.State,
  332. GLS.TerrainRenderer,
  333. GLS.TexLensFlare,
  334. GLS.Texture,
  335. GLS.TexturedHDS,
  336. GLS.TextureImageEditors,
  337. GLS.ThorFX,
  338. GLS.TilePlane,
  339. GLS.TimeEventsMgr,
  340. GLS.Trail,
  341. GLS.Tree,
  342. GLS.VectorFileObjects,
  343. GLS.SceneViewer,
  344. GLS.WaterPlane,
  345. GLS.Windows,
  346. GLS.WindowsFont,
  347. GLS.zBuffer,
  348. //----------------- File formats -------------------------------
  349. GLS.FileVfsPAK,
  350. //------------ Vector file formats
  351. GLS.File3DS,
  352. GLS.FileASE,
  353. GLS.FileB3D,
  354. GLS.FileGL2,
  355. GLS.FileGLTF,
  356. GLS.FileGTS,
  357. GLS.FileLMTS,
  358. GLS.FileLWO,
  359. GLS.FileMD2,
  360. GLS.FileMD3,
  361. GLS.FileMD5,
  362. GLS.FileMDC,
  363. GLS.FileMS3D,
  364. GLS.FileNMF,
  365. GLS.FileNurbs,
  366. GLS.FileObj,
  367. GLS.FileOCT,
  368. GLS.FilePLY,
  369. GLS.FileQ3BSP,
  370. GLS.FileSMD,
  371. GLS.FileSTL,
  372. GLS.FileVRML,
  373. //----------------- Sound file formats
  374. GLS.FileWAV,
  375. GLS.FileMP3,
  376. //----------------- Raster file format
  377. GLS.FileDDS,
  378. GLS.FileO3TC,
  379. GLS.FileHDR,
  380. GLS.FileJPEG,
  381. GLS.FilePNG,
  382. GLS.FileBMP,
  383. GLS.FileTGA,
  384. GLS.Sound,
  385. GLS.SoundFileObjects,
  386. GLS.SpaceText,
  387. GLS.Joystick,
  388. GLS.ScreenSaver,
  389. GLS.FullScreenViewer,
  390. GLS.Logger;
  391. var
  392. vObjectManager: TGLObjectManager;
  393. function ObjectManager: TGLObjectManager;
  394. begin
  395. if not Assigned(vObjectManager) then
  396. vObjectManager := TGLObjectManager.Create(nil);
  397. Result := vObjectManager;
  398. end;
  399. //----------------- TGLSceneViewerEditor ---------------------------------------
  400. procedure TGLSceneViewerEditor.ExecuteVerb(Index: Integer);
  401. var
  402. source: TGLSceneViewer;
  403. begin
  404. source := Component as TGLSceneViewer;
  405. case Index of
  406. 0: source.Buffer.ShowInfo;
  407. end;
  408. end;
  409. function TGLSceneViewerEditor.GetVerb(Index: Integer): string;
  410. begin
  411. case Index of
  412. 0: Result := 'Show context info';
  413. end;
  414. end;
  415. function TGLSceneViewerEditor.GetVerbCount: Integer;
  416. begin
  417. Result := 1;
  418. end;
  419. //----------------- TGLSceneEditor ---------------------------------------------
  420. procedure TGLSceneEditor.Edit;
  421. begin
  422. with GLSceneEditorForm do
  423. begin
  424. SetScene(Self.Component as TGLScene, Self.Designer);
  425. Show;
  426. end;
  427. end;
  428. procedure TGLSceneEditor.ExecuteVerb(Index: Integer);
  429. begin
  430. case Index of
  431. 0: Edit;
  432. end;
  433. end;
  434. function TGLSceneEditor.GetVerb(Index: Integer): string;
  435. begin
  436. case Index of
  437. 0: Result := 'Show Scene Editor';
  438. end;
  439. end;
  440. function TGLSceneEditor.GetVerbCount: Integer;
  441. begin
  442. Result := 1;
  443. end;
  444. //----------------- TGLResolutionProperty ----------------------------------------
  445. function TGLResolutionProperty.GetAttributes: TPropertyAttributes;
  446. begin
  447. Result := [paValueList];
  448. end;
  449. function TGLResolutionProperty.GetValue: string;
  450. begin
  451. Result := vVideoModes[GetOrdValue].Description;
  452. end;
  453. procedure TGLResolutionProperty.GetValues(Proc: TGetStrProc);
  454. var
  455. i: Integer;
  456. begin
  457. for i := 0 to vNumberVideoModes - 1 do
  458. Proc(vVideoModes[i].Description);
  459. end;
  460. procedure TGLResolutionProperty.SetValue(const Value: string);
  461. const
  462. Nums = ['0' .. '9'];
  463. var
  464. XRes, YRes, BPP: Integer;
  465. Pos, SLength: Integer;
  466. TempStr: string;
  467. begin
  468. if CompareText(Value, 'default') <> 0 then
  469. begin
  470. // initialize scanning
  471. TempStr := Trim(Value) + '|'; // ensure at least one delimiter
  472. SLength := Length(TempStr);
  473. XRes := 0;
  474. YRes := 0;
  475. BPP := 0;
  476. // contains the string something?
  477. if SLength > 1 then
  478. begin
  479. // determine first number
  480. for Pos := 1 to SLength do
  481. if not(AnsiChar(TempStr[Pos]) in Nums) then
  482. Break;
  483. if Pos <= SLength then
  484. begin
  485. // found a number?
  486. XRes := StrToInt(Copy(TempStr, 1, Pos - 1));
  487. // search for following non-numerics
  488. for Pos := Pos to SLength do
  489. if AnsiChar(TempStr[Pos]) in Nums then
  490. Break;
  491. Delete(TempStr, 1, Pos - 1); // take it out of the String
  492. SLength := Length(TempStr); // rest length of String
  493. if SLength > 1 then // something to scan?
  494. begin
  495. // determine second number
  496. for Pos := 1 to SLength do
  497. if not(AnsiChar(TempStr[Pos]) in Nums) then
  498. Break;
  499. if Pos <= SLength then
  500. begin
  501. YRes := StrToInt(Copy(TempStr, 1, Pos - 1));
  502. // search for following non-numerics
  503. for Pos := Pos to SLength do
  504. if AnsiChar(TempStr[Pos]) in Nums then
  505. Break;
  506. Delete(TempStr, 1, Pos - 1); // take it out of the String
  507. SLength := Length(TempStr); // rest length of String
  508. if SLength > 1 then
  509. begin
  510. for Pos := 1 to SLength do
  511. if not(AnsiChar(TempStr[Pos]) in Nums) then
  512. Break;
  513. if Pos <= SLength then
  514. BPP := StrToInt(Copy(TempStr, 1, Pos - 1));
  515. end;
  516. end;
  517. end;
  518. end;
  519. end;
  520. SetOrdValue(GetIndexFromResolution(XRes, YRes, BPP));
  521. end
  522. else
  523. SetOrdValue(0);
  524. end;
  525. //----------------- TGLTextureProperty -----------------------------------------
  526. function TGLTextureProperty.GetAttributes: TPropertyAttributes;
  527. begin
  528. Result := [paSubProperties];
  529. end;
  530. //----------------- TGLTextureImageProperty ------------------------------------
  531. function TGLTextureImageProperty.GetAttributes: TPropertyAttributes;
  532. begin
  533. Result := [paDialog];
  534. end;
  535. procedure TGLTextureImageProperty.Edit;
  536. begin
  537. if EditGLTextureImage(TGLTextureImage(GetOrdValue)) then
  538. Designer.Modified;
  539. end;
  540. //----------------- TGLImageClassProperty --------------------------------------
  541. function TGLImageClassProperty.GetAttributes: TPropertyAttributes;
  542. begin
  543. Result := [paValueList];
  544. end;
  545. procedure TGLImageClassProperty.GetValues(Proc: TGetStrProc);
  546. var
  547. i: Integer;
  548. sl: TStrings;
  549. begin
  550. sl := GetGLTextureImageClassesAsStrings;
  551. try
  552. for i := 0 to sl.Count - 1 do
  553. Proc(sl[i]);
  554. finally
  555. sl.Free;
  556. end;
  557. end;
  558. function TGLImageClassProperty.GetValue: string;
  559. begin
  560. Result := FindGLTextureImageClass(GetStrValue).FriendlyName;
  561. end;
  562. procedure TGLImageClassProperty.SetValue(const Value: string);
  563. var
  564. tic: TGLTextureImageClass;
  565. begin
  566. tic := FindGLTextureImageClassByFriendlyName(Value);
  567. if Assigned(tic) then
  568. SetStrValue(tic.ClassName)
  569. else
  570. SetStrValue('');
  571. Modified;
  572. end;
  573. //----------------- TGLColorproperty -----------------------------------------------------------------------------------
  574. procedure TGLColorProperty.Edit;
  575. var
  576. colorDialog: TColorDialog;
  577. GLColor: TGLColor;
  578. begin
  579. colorDialog := TColorDialog.Create(nil);
  580. try
  581. GLColor := TGLColor(GetOrdValue);
  582. colorDialog.Options := [cdFullOpen];
  583. colorDialog.Color := ConvertColorVector(GLColor.Color);
  584. if colorDialog.Execute then
  585. begin
  586. GLColor.Color := ConvertWinColor(colorDialog.Color);
  587. Modified;
  588. end;
  589. finally
  590. colorDialog.Free;
  591. end;
  592. end;
  593. function TGLColorProperty.GetAttributes: TPropertyAttributes;
  594. begin
  595. Result := [paSubProperties, paValueList, paDialog];
  596. end;
  597. procedure TGLColorProperty.GetValues(Proc: TGetStrProc);
  598. begin
  599. ColorManager.EnumColors(Proc);
  600. end;
  601. function TGLColorProperty.GetValue: string;
  602. begin
  603. Result := ColorManager.GetColorName(TGLColor(GetOrdValue).Color);
  604. end;
  605. procedure TGLColorProperty.SetValue(const Value: string);
  606. begin
  607. TGLColor(GetOrdValue).Color := ColorManager.GetColor(Value);
  608. Modified;
  609. end;
  610. function TGLColorProperty.ColorToBorderColor(aColor: TGLColorVector; selected: Boolean): TColor;
  611. begin
  612. if (aColor.X > 0.75) or (aColor.Y > 0.75) or (aColor.Z > 0.75) then
  613. Result := clBlack
  614. else if selected then
  615. Result := clWhite
  616. else
  617. Result := ConvertColorVector(aColor);
  618. end;
  619. procedure TGLColorProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
  620. ASelected: Boolean);
  621. begin
  622. if GetVisualValue <> '' then
  623. ListDrawValue(GetVisualValue, ACanvas, ARect, True)
  624. else
  625. DefaultPropertyDrawValue(Self, ACanvas, ARect);
  626. end;
  627. procedure TGLColorProperty.ListDrawValue(const Value: string; ACanvas: TCanvas;
  628. const ARect: TRect; ASelected: Boolean);
  629. var
  630. vRight: Integer;
  631. vOldPenColor, vOldBrushColor: TColor;
  632. Color: TGLColorVector;
  633. begin
  634. vRight := (ARect.Bottom - ARect.Top) + ARect.Left;
  635. with ACanvas do
  636. try
  637. vOldPenColor := Pen.Color;
  638. vOldBrushColor := Brush.Color;
  639. Pen.Color := Brush.Color;
  640. Rectangle(ARect.Left, ARect.Top, vRight, ARect.Bottom);
  641. Color := ColorManager.GetColor(Value);
  642. Brush.Color := ConvertColorVector(Color);
  643. Pen.Color := ColorToBorderColor(Color, ASelected);
  644. Rectangle(ARect.Left + 1, ARect.Top + 1, vRight - 1, ARect.Bottom - 1);
  645. Brush.Color := vOldBrushColor;
  646. Pen.Color := vOldPenColor;
  647. finally
  648. DefaultPropertyListDrawValue(Value, ACanvas,
  649. Rect(vRight, ARect.Top, ARect.Right, ARect.Bottom), ASelected);
  650. end;
  651. end;
  652. procedure TGLColorProperty.ListMeasureWidth(const Value: string;
  653. ACanvas: TCanvas; var AWidth: Integer);
  654. begin
  655. AWidth := AWidth + ACanvas.TextHeight('M');
  656. end;
  657. procedure TGLColorProperty.ListMeasureHeight(const Value: string;
  658. ACanvas: TCanvas; var AHeight: Integer);
  659. begin
  660. // Nothing
  661. end;
  662. procedure TGLColorProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect;
  663. ASelected: Boolean);
  664. begin
  665. DefaultPropertyDrawName(Self, ACanvas, ARect);
  666. end;
  667. //----------------- TGLSoundFileProperty -----------------------------------------
  668. function TGLSoundFileProperty.GetAttributes: TPropertyAttributes;
  669. begin
  670. Result := [paDialog];
  671. end;
  672. function TGLSoundFileProperty.GetValue: string;
  673. var
  674. sample: TGLSoundSample;
  675. begin
  676. sample := GetComponent(0) as TGLSoundSample;
  677. if sample.Data <> nil then
  678. Result := '(' + sample.Data.ClassName + ')'
  679. else
  680. Result := '(empty)';
  681. end;
  682. procedure TGLSoundFileProperty.Edit;
  683. var
  684. ODialog: TOpenDialog;
  685. sample: TGLSoundSample;
  686. Desc, F: string;
  687. begin
  688. sample := GetComponent(0) as TGLSoundSample;
  689. ODialog := TOpenDialog.Create(nil);
  690. try
  691. GetGLSoundFileFormats.BuildFilterStrings(TGLSoundFile, Desc, F);
  692. ODialog.Filter := Desc;
  693. if ODialog.Execute then
  694. begin
  695. sample.LoadFromFile(ODialog.FileName);
  696. Modified;
  697. end;
  698. finally
  699. ODialog.Free;
  700. end;
  701. end;
  702. //----------------- TGLSoundNameProperty -----------------------------------------
  703. function TGLSoundNameProperty.GetAttributes: TPropertyAttributes;
  704. begin
  705. Result := [paValueList];
  706. end;
  707. procedure TGLSoundNameProperty.GetValues(Proc: TGetStrProc);
  708. var
  709. i: Integer;
  710. source: TGLBaseSoundSource;
  711. begin
  712. source := (GetComponent(0) as TGLBaseSoundSource);
  713. if Assigned(source.SoundLibrary) then
  714. with source.SoundLibrary do
  715. for i := 0 to Samples.Count - 1 do
  716. Proc(Samples[i].Name);
  717. end;
  718. //----------------- TGLCoordinatesProperty -------------------------------------
  719. function TGLCoordinatesProperty.GetAttributes: TPropertyAttributes;
  720. begin
  721. Result := [paDialog, paSubProperties];
  722. end;
  723. procedure TGLCoordinatesProperty.Edit;
  724. var
  725. glc: TGLCoordinates;
  726. x, y, z: Single;
  727. begin
  728. glc := TGLCoordinates(GetOrdValue);
  729. x := glc.x;
  730. y := glc.y;
  731. z := glc.z;
  732. if GLVectorEditorForm.Execute(x, y, z) then
  733. begin
  734. glc.AsVector := VectorMake(x, y, z);
  735. Modified;
  736. end;
  737. end;
  738. //----------------- TGLGUILayoutEditor -------------------------------
  739. procedure TGLGUILayoutEditor.Edit;
  740. begin
  741. GUILayoutEditorForm.Execute(TGLGuiLayout(Self.Component));
  742. end;
  743. procedure TGLGUILayoutEditor.ExecuteVerb(Index: Integer);
  744. begin
  745. case Index of
  746. 0: Edit;
  747. end;
  748. end;
  749. function TGLGUILayoutEditor.GetVerb(Index: Integer): string;
  750. begin
  751. case Index of
  752. 0:
  753. Result := 'Show Layout Editor';
  754. end;
  755. end;
  756. function TGLGUILayoutEditor.GetVerbCount: Integer;
  757. begin
  758. Result := 1;
  759. end;
  760. //----------------- TGLReuseableDefaultEditor --------------------------
  761. procedure TGLReuseableDefaultEditor.CheckEdit(const Prop: IProperty);
  762. begin
  763. if FContinue then
  764. EditProperty(Prop, FContinue);
  765. end;
  766. procedure TGLReuseableDefaultEditor.EditProperty(const Prop: IProperty;
  767. var Continue: Boolean);
  768. var
  769. PropName: string;
  770. BestName: string;
  771. MethodProperty: IMethodProperty;
  772. procedure ReplaceBest;
  773. begin
  774. FBest := Prop;
  775. if FFirst = FBest then
  776. FFirst := nil;
  777. end;
  778. begin
  779. if not Assigned(FFirst) and Supports(Prop, IMethodProperty, MethodProperty)
  780. then
  781. FFirst := Prop;
  782. PropName := Prop.GetName;
  783. BestName := '';
  784. if Assigned(FBest) then
  785. BestName := FBest.GetName;
  786. if CompareText(PropName, 'ONCREATE') = 0 then
  787. ReplaceBest
  788. else if CompareText(BestName, 'ONCREATE') <> 0 then
  789. if CompareText(PropName, 'ONCHANGE') = 0 then
  790. ReplaceBest
  791. else if CompareText(BestName, 'ONCHANGE') <> 0 then
  792. if CompareText(PropName, 'ONCLICK') = 0 then
  793. ReplaceBest;
  794. end;
  795. procedure TGLReuseableDefaultEditor.Edit;
  796. var
  797. Components: IDesignerSelections;
  798. begin
  799. Components := TDesignerSelections.Create;
  800. FContinue := True;
  801. Components.Add(Component);
  802. FFirst := nil;
  803. FBest := nil;
  804. try
  805. GetComponentProperties(Components, tkAny, Designer, CheckEdit);
  806. if FContinue then
  807. if Assigned(FBest) then
  808. FBest.Edit
  809. else if Assigned(FFirst) then
  810. FFirst.Edit;
  811. finally
  812. FFirst := nil;
  813. FBest := nil;
  814. end;
  815. end;
  816. //----------------- TGLMaterialLibraryEditor ----------------------------------
  817. procedure TGLMaterialLibraryEditor.EditProperty(const Prop: IProperty; var Continue: Boolean);
  818. begin
  819. if CompareText(Prop.GetName, 'MATERIALS') = 0 then
  820. begin
  821. FBest := Prop;
  822. end;
  823. end;
  824. procedure TGLMaterialLibraryEditor.ExecuteVerb(Index: Integer);
  825. begin
  826. case Index of
  827. 0: Edit;
  828. end;
  829. end;
  830. function TGLMaterialLibraryEditor.GetVerb(Index: Integer): string;
  831. begin
  832. case Index of
  833. 0: Result := 'Show Material Library Editor';
  834. end;
  835. end;
  836. function TGLMaterialLibraryEditor.GetVerbCount: Integer;
  837. begin
  838. Result := 1
  839. end;
  840. //----------------- TGLMaterialProperty -------------------------------
  841. function TGLMaterialProperty.GetAttributes: TPropertyAttributes;
  842. begin
  843. Result := [paDialog, paSubProperties];
  844. end;
  845. procedure TGLMaterialProperty.Edit;
  846. var
  847. buf: string;
  848. ml: TGLAbstractMaterialLibrary;
  849. obj: TPersistent;
  850. Int: IGLMaterialLibrarySupported;
  851. begin
  852. if FmMaterialEditor.GLMaterialEditorForm.Execute(TGLMaterial(GetOrdValue)) then
  853. Modified;
  854. end;
  855. //----------------- TGLLibMaterialNameProperty ---------------------------------
  856. function TGLLibMaterialNameProperty.GetAttributes: TPropertyAttributes;
  857. begin
  858. Result := [paDialog];
  859. end;
  860. procedure TGLLibMaterialNameProperty.Edit;
  861. var
  862. buf: string;
  863. ml: TGLAbstractMaterialLibrary;
  864. obj: TPersistent;
  865. Int: IGLMaterialLibrarySupported;
  866. begin
  867. buf := GetStrValue;
  868. obj := GetComponent(0);
  869. if Supports(obj, IGLMaterialLibrarySupported, Int) then
  870. ml := Int.GetMaterialLibrary
  871. else
  872. begin
  873. ml := nil;
  874. Assert(False, 'oops, unsupported...');
  875. end;
  876. if not Assigned(ml) then
  877. ShowMessage('Select the material library first.')
  878. else
  879. if GLLibMaterialPickerForm.Execute(buf, ml) then
  880. SetStrValue(buf);
  881. end;
  882. //----------------- TGLAnimationNameProperty -----------------------------------
  883. function TGLAnimationNameProperty.GetAttributes: TPropertyAttributes;
  884. begin
  885. Result := [paValueList];
  886. end;
  887. procedure TGLAnimationNameProperty.GetValues(Proc: TGetStrProc);
  888. var
  889. i: Integer;
  890. animControler: TGLAnimationControler;
  891. actor: TGLActor;
  892. begin
  893. animControler := (GetComponent(0) as TGLAnimationControler);
  894. if Assigned(animControler) then
  895. begin
  896. actor := animControler.actor;
  897. if Assigned(actor) then
  898. with actor.Animations do
  899. begin
  900. for i := 0 to Count - 1 do
  901. Proc(Items[i].Name);
  902. end;
  903. end;
  904. end;
  905. //---------------- TGLBaseSceneObjectSelectionEditor -----------------------
  906. procedure TGLBaseSceneObjectSelectionEditor.RequiresUnits(Proc: TGetStrProc);
  907. var
  908. i, j: Integer;
  909. comp: TGLBaseSceneObject;
  910. begin
  911. if (Designer = nil) or (Designer.Root = nil) then
  912. Exit;
  913. for i := 0 to Designer.Root.ComponentCount - 1 do
  914. begin
  915. if (Designer.Root.Components[i] is TGLBaseSceneObject) then
  916. begin
  917. comp := TGLBaseSceneObject(Designer.Root.Components[i]);
  918. for j := 0 to comp.Behaviours.Count - 1 do
  919. Proc(FindUnitName(comp.Behaviours[j]));
  920. for j := 0 to comp.Effects.Count - 1 do
  921. Proc(FindUnitName(comp.Effects[j]));
  922. end;
  923. end;
  924. end;
  925. //---------------------------- TGLSoundLibrarySelectionEditor -----------------------
  926. procedure TGLSoundLibrarySelectionEditor.RequiresUnits(Proc: TGetStrProc);
  927. var
  928. i, j: Integer;
  929. comp: TGLSoundLibrary;
  930. begin
  931. if (Designer = nil) or (Designer.Root = nil) then
  932. Exit;
  933. for i := 0 to Designer.Root.ComponentCount - 1 do
  934. begin
  935. if (Designer.Root.Components[i] is TGLSoundLibrary) then
  936. begin
  937. comp := TGLSoundLibrary(Designer.Root.Components[i]);
  938. for j := 0 to comp.Samples.Count - 1 do
  939. if Assigned(comp.Samples[j].Data) then
  940. Proc(FindUnitName(comp.Samples[j].Data));
  941. end;
  942. end;
  943. end;
  944. //-------------------- TGLSArchiveManagerEditor -----------------------
  945. procedure TGLSArchiveManagerEditor.EditProperty(const Prop: IProperty;
  946. var Continue: Boolean);
  947. begin
  948. if CompareText(Prop.GetName, 'ARCHIVES') = 0 then
  949. begin
  950. FBest := Prop;
  951. end;
  952. end;
  953. procedure TGLSArchiveManagerEditor.ExecuteVerb(Index: Integer);
  954. begin
  955. case Index of
  956. 0: Edit;
  957. end;
  958. end;
  959. function TGLSArchiveManagerEditor.GetVerb(Index: Integer): string;
  960. begin
  961. case Index of
  962. 0: Result := 'Show Archive Manager Editor';
  963. end;
  964. end;
  965. function TGLSArchiveManagerEditor.GetVerbCount: Integer;
  966. begin
  967. Result := 1
  968. end;
  969. procedure TGLMaterialComponentNameProperty.Edit;
  970. var
  971. LOwner: IGLMaterialLibrarySupported;
  972. LItem: TGLBaseMaterialCollectionItem;
  973. begin
  974. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  975. begin
  976. LItem := TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  977. .Components.GetItemByName(GetStrValue);
  978. if Assigned(LItem) then
  979. Designer.SelectComponent(LItem);
  980. Modified;
  981. end;
  982. end;
  983. function TGLMaterialComponentNameProperty.GetAttributes: TPropertyAttributes;
  984. begin
  985. Result := [paValueList];
  986. end;
  987. procedure TGLLibTextureNameProperty.GetValues(Proc: TGetStrProc);
  988. var
  989. LOwner: IGLMaterialLibrarySupported;
  990. begin
  991. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  992. begin
  993. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  994. .GetNames(Proc, TGLTextureImageEx);
  995. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  996. .GetNames(Proc, TGLFrameBufferAttachment);
  997. end;
  998. end;
  999. procedure TGLLibSamplerNameProperty.GetValues(Proc: TGetStrProc);
  1000. var
  1001. LOwner: IGLMaterialLibrarySupported;
  1002. begin
  1003. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  1004. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  1005. .GetNames(Proc, TGLTextureSampler);
  1006. end;
  1007. procedure TGLLibCombinerNameProperty.GetValues(Proc: TGetStrProc);
  1008. var
  1009. LOwner: IGLMaterialLibrarySupported;
  1010. begin
  1011. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  1012. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  1013. .GetNames(Proc, TGLTextureCombiner);
  1014. end;
  1015. procedure TGLLibShaderNameProperty.GetValues(Proc: TGetStrProc);
  1016. var
  1017. LOwner: IGLMaterialLibrarySupported;
  1018. begin
  1019. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  1020. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary).GetNames(Proc, TGLShaderEx);
  1021. end;
  1022. procedure TGLLibAttachmentNameProperty.GetValues(Proc: TGetStrProc);
  1023. var
  1024. LOwner: IGLMaterialLibrarySupported;
  1025. begin
  1026. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  1027. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  1028. .GetNames(Proc, TGLFrameBufferAttachment);
  1029. end;
  1030. procedure TGLLibAsmProgNameProperty.GetValues(Proc: TGetStrProc);
  1031. var
  1032. LOwner: IGLMaterialLibrarySupported;
  1033. begin
  1034. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  1035. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  1036. .GetNames(Proc, TGLASMVertexProgram);
  1037. end;
  1038. function TPictureFileProperty.GetAttributes: TPropertyAttributes;
  1039. begin
  1040. Result := [paDialog];
  1041. end;
  1042. procedure TPictureFileProperty.Edit;
  1043. var
  1044. LFileName: string;
  1045. begin
  1046. if OpenPictureDialog(LFileName) then
  1047. begin
  1048. SetStrValue(RelativePath(LFileName));
  1049. end;
  1050. Modified;
  1051. end;
  1052. procedure TShaderFileProperty.Edit;
  1053. var
  1054. ODialog: TOpenDialog;
  1055. begin
  1056. ODialog := TOpenDialog.Create(nil);
  1057. try
  1058. ODialog.Filter := '*.glsl';
  1059. if ODialog.Execute then
  1060. begin
  1061. SetStrValue(RelativePath(ODialog.FileName));
  1062. Modified;
  1063. end;
  1064. finally
  1065. ODialog.Free;
  1066. end;
  1067. end;
  1068. function TShaderFileProperty.GetAttributes: TPropertyAttributes;
  1069. begin
  1070. Result := [paDialog];
  1071. end;
  1072. procedure TAsmProgFileProperty.Edit;
  1073. var
  1074. ODialog: TOpenDialog;
  1075. begin
  1076. ODialog := TOpenDialog.Create(nil);
  1077. try
  1078. ODialog.Filter := '*.asm';
  1079. if ODialog.Execute then
  1080. begin
  1081. SetStrValue(RelativePath(ODialog.FileName));
  1082. Modified;
  1083. end;
  1084. finally
  1085. ODialog.Free;
  1086. end;
  1087. end;
  1088. function TAsmProgFileProperty.GetAttributes: TPropertyAttributes;
  1089. begin
  1090. Result := [paDialog];
  1091. end;
  1092. function TUniformAutoSetProperty.GetAttributes: TPropertyAttributes;
  1093. begin
  1094. Result := [paDialog, paFullWidthName];
  1095. end;
  1096. procedure TUniformAutoSetProperty.PassUniform(const S: string);
  1097. begin
  1098. GLShaderUniformEditor.AddUniform(TGLBaseShaderModel(GetComponent(0))
  1099. .Uniforms[S]);
  1100. end;
  1101. procedure TUniformAutoSetProperty.Edit;
  1102. var
  1103. LOwner: TGLBaseShaderModel;
  1104. begin
  1105. LOwner := TGLBaseShaderModel(GetComponent(0));
  1106. if LOwner.Enabled and LOwner.IsValid then
  1107. begin
  1108. with GLShaderUniformEditor do
  1109. begin
  1110. Clear;
  1111. LOwner.MaterialLibrary.GetNames(AddTextureName, TGLTextureImageEx);
  1112. LOwner.MaterialLibrary.GetNames(AddTextureName, TGLFrameBufferAttachment);
  1113. LOwner.MaterialLibrary.GetNames(AddSamplerName, TGLTextureSampler);
  1114. LOwner.GetUniformNames(PassUniform);
  1115. Execute;
  1116. end;
  1117. end;
  1118. end;
  1119. function TGLShaderEditorProperty.GetAttributes: TPropertyAttributes;
  1120. begin
  1121. Result := inherited GetAttributes + [paDialog] - [paSubProperties];
  1122. end;
  1123. function TGLShaderEditorProperty.GetStrings: TStrings;
  1124. begin
  1125. Result := TStrings(GetOrdValue);
  1126. end;
  1127. procedure TGLShaderEditorProperty.OnShaderCheck(Sender: TObject);
  1128. var
  1129. LShader: TGLShaderEx;
  1130. LContext: TGLContext;
  1131. begin
  1132. SetStrings(GLShaderEditorForm.GLSLMemo.Lines);
  1133. LShader := TGLShaderEx(GetComponent(0));
  1134. LContext := LShader.Handle.RenderingContext;
  1135. if Assigned(LContext) then
  1136. begin
  1137. LContext.Activate;
  1138. try
  1139. LShader.DoOnPrepare(LContext);
  1140. GLShaderEditorForm.CompilatorLog.Lines.Add(LShader.InfoLog);
  1141. finally
  1142. LContext.Deactivate;
  1143. end;
  1144. end
  1145. else
  1146. GLShaderEditorForm.CompilatorLog.Lines.Add
  1147. ('There is no any rendering context for work with OpenGL');
  1148. end;
  1149. procedure TGLShaderEditorProperty.SetStrings(const Value: TStrings);
  1150. begin
  1151. SetOrdValue(Longint(Value));
  1152. end;
  1153. procedure TGLShaderEditorProperty.Edit;
  1154. begin
  1155. with GLShaderEditorForm do
  1156. begin
  1157. OnCheck := OnShaderCheck;
  1158. GLSLMemo.Lines.Assign(GetStrings);
  1159. GLSLMemo.CurX := 0;
  1160. GLSLMemo.CurY := 0;
  1161. if ShowModal = mrOk then
  1162. begin
  1163. SetStrings(GLSLMemo.Lines);
  1164. Modified;
  1165. end;
  1166. end;
  1167. end;
  1168. // ******************************************************
  1169. // Register Properties
  1170. //*******************************************************
  1171. procedure GLSceneRegisterPropertiesInCategories;
  1172. begin
  1173. // property types
  1174. // ScreenDepth in Win32FullScreenViewer
  1175. RegisterPropertiesInCategory(strOpenGLCategoryName,
  1176. [TypeInfo(TGLCamera), TypeInfo(TGLSceneBuffer),
  1177. TypeInfo(TGLVSyncMode), TypeInfo(TGLScreenDepth)]);
  1178. // TGLSceneViewer
  1179. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLSceneViewer, ['*Render']);
  1180. // GLScene
  1181. RegisterPropertiesInCategory(strOpenGLCategoryName,
  1182. [TypeInfo(TGLObjectsSorting), TypeInfo(TGLProgressEvent),
  1183. TypeInfo(TGLBehaviours), TypeInfo(TGLEffects),
  1184. TypeInfo(TGLDirectRenderEvent), TypeInfo(TGLCameraStyle),
  1185. TypeInfo(TOnCustomPerspective), TypeInfo(TGLScene)]);
  1186. RegisterPropertiesInCategory(strLayoutCategoryName,
  1187. [TypeInfo(TGLObjectsSorting), TypeInfo(TGLNormalDirection)]);
  1188. RegisterPropertiesInCategory(strVisualCategoryName,
  1189. [TypeInfo(TGLVisibilityCulling), TypeInfo(TGLLightStyle), TypeInfo(TGLColor),
  1190. TypeInfo(TGLNormalDirection), TypeInfo(TGLCameraStyle)]);
  1191. RegisterPropertiesInCategory(strVisualCategoryName, TGLBaseSceneObject,
  1192. ['Rotation', 'Direction', 'Position', 'Up', 'Scale', '*Angle', 'ShowAxes', 'FocalLength']);
  1193. RegisterPropertiesInCategory(strVisualCategoryName, TGLSceneObject, ['Parts']);
  1194. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLDirectOpenGL, ['UseBuildList']);
  1195. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLProxyObjectOptions)]);
  1196. RegisterPropertiesInCategory(strVisualCategoryName, TGLLightSource, ['*Attenuation', 'Shining', 'Spot*']);
  1197. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLCamera, ['TargetObject']);
  1198. RegisterPropertiesInCategory(strVisualCategoryName, TGLCamera, ['DepthOfView', 'SceneScale']);
  1199. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLNonVisualViewer, ['*Render']);
  1200. // GLObjects
  1201. RegisterPropertiesInCategory(strOpenGLCategoryName,
  1202. [TypeInfo(TGLLinesNodes), TypeInfo(TGLLineNodesAspect),
  1203. TypeInfo(TGLLineSplineMode), TypeInfo(TGLLinesOptions)]);
  1204. // GLDummyCube
  1205. RegisterPropertiesInCategory(strLayoutCategoryName, TGLDummyCube, ['VisibleAtRunTime']);
  1206. RegisterPropertiesInCategory(strVisualCategoryName, TGLDummyCube, ['CubeSize', 'VisibleAtRunTime']);
  1207. RegisterPropertiesInCategory(strVisualCategoryName, TGLPlane, ['*Offset', '*Tiles']);
  1208. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLSprite, ['NoZWrite']);
  1209. RegisterPropertiesInCategory(strLayoutCategoryName, TGLSprite, ['NoZWrite']);
  1210. RegisterPropertiesInCategory(strVisualCategoryName, TGLSprite, ['AlphaChannel', 'Rotation']);
  1211. RegisterPropertiesInCategory(strVisualCategoryName, TGLNode, ['X', 'Y', 'Z']);
  1212. RegisterPropertiesInCategory(strVisualCategoryName, TGLLines,
  1213. ['Antialiased', 'Division', 'Line*', 'NodeSize']);
  1214. RegisterPropertiesInCategory(strVisualCategoryName, TGLCube, ['Cube*']);
  1215. RegisterPropertiesInCategory(strVisualCategoryName, TGLFrustrum, ['ApexHeight', 'Base*']);
  1216. // GLSpaceText
  1217. RegisterPropertiesInCategory(strLayoutCategoryName, [TypeInfo(TGLTextAdjust)]);
  1218. RegisterPropertiesInCategory(strLocalizableCategoryName, [TypeInfo(TGLSpaceTextCharRange)]);
  1219. RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TGLLineSplineMode),
  1220. TypeInfo(TGLCapType), TypeInfo(TGLNormalSmoothing),
  1221. TypeInfo(TGLArrowHeadStyle), TypeInfo(TGLTextAdjust)]);
  1222. RegisterPropertiesInCategory(strVisualCategoryName, TGLSpaceText,
  1223. ['AllowedDeviation', 'AspectRatio', 'Extrusion', 'Oblique', 'TextHeight']);
  1224. RegisterPropertiesInCategory(strVisualCategoryName, TGLSphere,
  1225. ['Bottom', 'Radius', 'Slices', 'Stacks', 'Start', 'Stop']);
  1226. RegisterPropertiesInCategory(strVisualCategoryName, TGLDisk,
  1227. ['*Radius', 'Loops', 'Slices']);
  1228. RegisterPropertiesInCategory(strVisualCategoryName, TGLCone,
  1229. ['BottomRadius', 'Loops', 'Slices', 'Stacks']);
  1230. RegisterPropertiesInCategory(strVisualCategoryName, TGLCylinder,
  1231. ['*Radius', 'Loops', 'Slices', 'Stacks']);
  1232. RegisterPropertiesInCategory(strVisualCategoryName, TGLCapsule,
  1233. ['*Radius', 'Loops', 'Slices', 'Stacks']);
  1234. RegisterPropertiesInCategory(strVisualCategoryName, TGLAnnulus,
  1235. ['Bottom*', 'Loops', 'Slices', 'Stacks', 'Top*']);
  1236. RegisterPropertiesInCategory(strVisualCategoryName, TGLTorus,
  1237. ['*Radius', 'Rings', 'Sides']);
  1238. RegisterPropertiesInCategory(strVisualCategoryName, TGLArrowLine,
  1239. ['Bottom*', 'Loops', 'Slices', 'Stacks', 'Top*']);
  1240. RegisterPropertiesInCategory(strVisualCategoryName, TGLPolygon, ['Division']);
  1241. // GLMultiPolygon
  1242. RegisterPropertiesInCategory(strVisualCategoryName, TGLContour, ['Division']);
  1243. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLContourNodes), TypeInfo(TGLContours)]);
  1244. // GLExtrusion
  1245. RegisterPropertiesInCategory(strVisualCategoryName, TGLExtrusionSolid, ['Stacks']);
  1246. RegisterPropertiesInCategory(strVisualCategoryName, TGLPipeNode, ['RadiusFactor']);
  1247. RegisterPropertiesInCategory(strVisualCategoryName, TGLPipe, ['Division', 'Radius', 'Slices']);
  1248. RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TGLNodes), TypeInfo(TPipeNodesColorMode)]);
  1249. RegisterPropertiesInCategory(strVisualCategoryName, TGLRevolutionSolid, ['Division', 'Slices', 'YOffsetPerTurn']);
  1250. // GLVectorFileObjects
  1251. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLActorAnimationMode), TypeInfo(TGLActorAnimations),
  1252. TypeInfo(TGLMeshAutoCenterings), TypeInfo(TGLActorFrameInterpolation),
  1253. TypeInfo(TGLActorAnimationReference), TypeInfo(TGLActor)]);
  1254. RegisterPropertiesInCategory(strLayoutCategoryName, [TypeInfo(TGLMeshNormalsOrientation)]);
  1255. RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TGLMeshAutoCenterings), TypeInfo(TGLActorAnimationReference),
  1256. TypeInfo(TGLMeshNormalsOrientation)]);
  1257. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLFreeForm, ['UseMeshmaterials']);
  1258. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLAnimationControler, ['AnimationName']);
  1259. RegisterPropertiesInCategory(sLinkageCategoryName, TGLAnimationControler, ['AnimationName']);
  1260. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLActorAnimation, ['*Frame']);
  1261. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLActor,
  1262. ['*Frame*', 'Interval', 'OverlaySkeleton', 'UseMeshmaterials']);
  1263. RegisterPropertiesInCategory(strVisualCategoryName, TGLActor, ['OverlaySkeleton']);
  1264. // GLMesh
  1265. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLMeshMode), TypeInfo(TGLVertexMode)]);
  1266. // GLGraph
  1267. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLHeightFieldOptions)]);
  1268. RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TGLHeightFieldColorMode), TypeInfo(TGLSamplingScale),
  1269. TypeInfo(TGLXYZGridLinesStyle), TypeInfo(TGLXYZGridParts)]);
  1270. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLXYZGrid, ['Antialiased']);
  1271. RegisterPropertiesInCategory(strVisualCategoryName, TGLXYZGrid, ['Antialiased', 'Line*']);
  1272. // GLParticles
  1273. RegisterPropertiesInCategory(strLayoutCategoryName, TGLParticles, ['VisibleAtRunTime']);
  1274. RegisterPropertiesInCategory(strVisualCategoryName, TGLParticles, ['*Size', 'VisibleAtRunTime']);
  1275. // GLSkydome
  1276. RegisterPropertiesInCategory(strOpenGLCategoryName,
  1277. [TypeInfo(TGLSkyDomeBands), TypeInfo(TGLSkyDomeOptions), TypeInfo(TGLSkyDomeStars)]);
  1278. RegisterPropertiesInCategory(strVisualCategoryName, TGLSkyDomeBand, ['Slices', 'Stacks', '*Angle']);
  1279. RegisterPropertiesInCategory(strVisualCategoryName, TGLSkyDomeStar, ['Dec', 'Magnitude', 'RA']);
  1280. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLEarthSkyDome,
  1281. ['Slices', 'Stacks', 'SunElevation', 'Turbidity']);
  1282. // GLMirror
  1283. RegisterPropertiesInCategory(strOpenGLCategoryName,
  1284. [TypeInfo(TGLMirrorOptions), TypeInfo(TGLBaseSceneObject)]);
  1285. // GLParticleFX
  1286. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLBlendingMode)]);
  1287. RegisterPropertiesInCategory(strVisualCategoryName,
  1288. [TypeInfo(TGLBlendingMode), TypeInfo(TPFXLifeColors), TypeInfo(TSpriteColorMode)]);
  1289. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLParticleFXRenderer, ['ZWrite']);
  1290. RegisterPropertiesInCategory(strVisualCategoryName, TGLParticleFXRenderer, ['ZWrite']);
  1291. RegisterPropertiesInCategory(strOpenGLCategoryName, TPFXLifeColor, ['LifeTime']);
  1292. RegisterPropertiesInCategory(strVisualCategoryName, TPFXLifeColor, ['LifeTime']);
  1293. RegisterPropertiesInCategory(strVisualCategoryName, TGLLifeColoredPFXManager, ['Acceleration', 'ParticleSize']);
  1294. RegisterPropertiesInCategory(strVisualCategoryName, TGLPolygonPFXManager, ['NbSides']);
  1295. RegisterPropertiesInCategory(strVisualCategoryName, TGLPointLightPFXManager, ['TexMapSize']);
  1296. // GLTerrainRenderer
  1297. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLHeightDataSource)]);
  1298. RegisterPropertiesInCategory(strVisualCategoryName, TGLTerrainRenderer, ['*CLOD*', 'QualityDistance', 'Tile*']);
  1299. // GLzBuffer
  1300. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLMemoryViewer),
  1301. TypeInfo(TGLSceneViewer), TypeInfo(TOptimise)]);
  1302. RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TOptimise)]);
  1303. RegisterPropertiesInCategory(strVisualCategoryName, TGLZShadows, ['DepthFade', '*Shadow', 'Soft', 'Tolerance']);
  1304. // GLHUDObjects
  1305. RegisterPropertiesInCategory(strLayoutCategoryName, [TypeInfo(TTextLayout)]);
  1306. RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TGLBitmapFont), TypeInfo(TTextLayout)]);
  1307. RegisterPropertiesInCategory(strLocalizableCategoryName,[TypeInfo(TGLBitmapFont)]);
  1308. // GLTexture
  1309. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLMaterial), TypeInfo(TGLMaterialLibrary),
  1310. TypeInfo(TGLLibMaterials), TypeInfo(TGLTextureNeededEvent)]);
  1311. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLLibMaterial, ['Texture2Name']);
  1312. RegisterPropertiesInCategory(strVisualCategoryName, TGLLibMaterial, ['TextureOffset', 'TextureScale']);
  1313. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLMaterialLibrary, ['TexturePaths']);
  1314. // GLCadencer
  1315. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLCadencer)]);
  1316. // GLCollision
  1317. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TObjectCollisionEvent)]);
  1318. // GLFireFX
  1319. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLFireFXManager,
  1320. ['MaxParticles', 'NoZWrite', 'Paused', 'UseInterval']);
  1321. RegisterPropertiesInCategory(strVisualCategoryName, TGLFireFXManager,
  1322. ['Fire*', 'InitialDir', 'NoZWrite', 'Particle*', 'Paused']);
  1323. // GLThorFX
  1324. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TCalcPointEvent)]);
  1325. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLThorFXManager,
  1326. ['Maxpoints', 'Paused']);
  1327. RegisterPropertiesInCategory(strVisualCategoryName, TGLThorFXManager,
  1328. ['Core', 'Glow*', 'Paused', 'Target', 'Vibrate', 'Wildness']);
  1329. // GLBitmapFont
  1330. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLMagFilter), TypeInfo(TGLMinFilter)]);
  1331. RegisterPropertiesInCategory(strLocalizableCategoryName, [TypeInfo(TGLBitmapFontRanges)]);
  1332. RegisterPropertiesInCategory(strLocalizableCategoryName, TGLBitmapFontRange, ['*ASCII']);
  1333. RegisterPropertiesInCategory(strLayoutCategoryName, TGLBitmapFont, ['Char*', '*Interval*', '*Space']);
  1334. RegisterPropertiesInCategory(strLocalizableCategoryName, TGLBitmapFont, ['Glyphs']);
  1335. RegisterPropertiesInCategory(strVisualCategoryName, TGLBitmapFont,
  1336. ['Char*', '*Interval*', '*Space', 'Glyphs']);
  1337. // GLHeightData
  1338. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLBitmapHDS, ['MaxPoolSize']);
  1339. RegisterPropertiesInCategory(strVisualCategoryName, TGLBitmapHDS, ['Picture']);
  1340. end;
  1341. // ******************************************************
  1342. // Register Components
  1343. //*******************************************************
  1344. procedure Register;
  1345. begin
  1346. RegisterComponents('GLScene', [TGLScene, TGLSceneViewer, TGLMemoryViewer,
  1347. TGLMaterialLibrary, TGLMaterialLibraryEx, TGLCadencer, TGLGuiLayout,
  1348. TGLBitmapFont, TGLWindowsBitmapFont, TGLScriptLibrary, TGLSoundLibrary,
  1349. TGLFullScreenViewer]);
  1350. RegisterComponents('GLScene PFX',
  1351. [TGLCustomPFXManager, TGLPolygonPFXManager,
  1352. TGLPointLightPFXManager, TGLCustomSpritePFXManager, TGLPerlinPFXManager,
  1353. TGLLinePFXManager, TGLFireFXManager, TGLThorFXManager,
  1354. TGLEParticleMasksManager]);
  1355. RegisterComponents('GLScene Utils', [TGLAsyncTimer, TGLStaticImposterBuilder,
  1356. TGLCollisionManager, TGLAnimationControler, TGLAVIRecorder, TGLDCEManager,
  1357. TGLFPSMovementManager, TGLMaterialScripter, TGLUserInterface, TGLNavigator,
  1358. TGLSmoothNavigator, TGLSmoothUserInterface, TGLTimeEventsMGR,
  1359. TGLApplicationFileIO, TGLVfsPAK, TGLSimpleNavigation, TGLGizmo,
  1360. TGLCameraController, TGLSLanguage, TGLSLogger, TGLSArchiveManager,
  1361. TGLJoystick, TGLScreenSaver, TGLSSynHiMemo]);
  1362. RegisterComponents('GLScene Terrain', [TGLBitmapHDS, TGLCustomHDS,
  1363. TGLHeightTileFileHDS, TGLBumpmapHDS, TGLPerlinHDS, TGLTexturedHDS,
  1364. TGLAsyncHDS, TGLShadowHDS]);
  1365. RegisterComponents('GLScene Shaders', [TGLTexCombineShader, TGLPhongShader,
  1366. TGLUserShader, TGLHiddenLineShader, TGLCelShader, TGLOutlineShader,
  1367. TGLMultiMaterialShader, TGLBumpShader, TGLSLShader,
  1368. TGLSLDiffuseSpecularShader, TGLSLBumpShader, TGLAsmShader,
  1369. TGLShaderCombiner, TGLTextureSharingShader, TGLSLPostBlurShader,
  1370. TGLSLPostThermalVisionShader, TGLSLPostDreamVisionShader, TGLSLPostNightVisionShader,
  1371. TGLSLPostPixelateShader, TGLSLPostPosterizeShader, TGLSLPostFrostShader,
  1372. TGLSLPostTroubleShader]);
  1373. RegisterComponentEditor(TGLSceneViewer, TGLSceneViewerEditor);
  1374. RegisterComponentEditor(TGLScene, TGLSceneEditor);
  1375. RegisterComponentEditor(TGLMaterialLibrary, TGLMaterialLibraryEditor);
  1376. RegisterComponentEditor(TGLMaterialLibraryEx, TGLMaterialLibraryEditor);
  1377. RegisterComponentEditor(TGLSArchiveManager, TGLSArchiveManagerEditor);
  1378. GLSceneRegisterPropertiesInCategories;
  1379. RegisterPropertyEditor(TypeInfo(TResolution), nil, '', TGLResolutionProperty);
  1380. RegisterPropertyEditor(TypeInfo(TGLTexture), TGLMaterial, '', TGLTextureProperty);
  1381. RegisterPropertyEditor(TypeInfo(TGLTextureImage), TGLTexture, '', TGLTextureImageProperty);
  1382. RegisterPropertyEditor(TypeInfo(string), TGLTexture, 'ImageClassName', TGLImageClassProperty);
  1383. RegisterPropertyEditor(TypeInfo(TGLSoundFile), TGLSoundSample, '', TGLSoundFileProperty);
  1384. RegisterPropertyEditor(TypeInfo(string), TGLBaseSoundSource, 'SoundName', TGLSoundNameProperty);
  1385. RegisterPropertyEditor(TypeInfo(TGLCoordinates), nil, '', TGLCoordinatesProperty);
  1386. RegisterPropertyEditor(TypeInfo(TGLColor), nil, '', TGLColorProperty);
  1387. RegisterPropertyEditor(TypeInfo(TGLMaterial), nil, '', TGLMaterialProperty);
  1388. RegisterComponentEditor(TGLGuiLayout, TGLGUILayoutEditor);
  1389. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLMaterial, '', TGLLibMaterialNameProperty);
  1390. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLLibMaterial, 'Texture2Name', TGLLibMaterialNameProperty);
  1391. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLSkyBox, '', TGLLibMaterialNameProperty);
  1392. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLEParticleMask, '', TGLLibMaterialNameProperty);
  1393. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLGameMenu, '', TGLLibMaterialNameProperty);
  1394. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLMaterialMultiProxyMaster, '', TGLLibMaterialNameProperty);
  1395. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLSLBumpShader, '', TGLLibMaterialNameProperty);
  1396. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLSpriteAnimation, '', TGLLibMaterialNameProperty);
  1397. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLMaterialProxy, '', TGLLibMaterialNameProperty);
  1398. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLActorProxy, '', TGLLibMaterialNameProperty);
  1399. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLFBORenderer, '', TGLLibMaterialNameProperty);
  1400. RegisterPropertyEditor(TypeInfo(TGLActorAnimationName), TGLAnimationControler, '', TGLAnimationNameProperty);
  1401. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLTextureSharingShaderMaterial, 'LibMaterialName',
  1402. TGLLibMaterialNameProperty);
  1403. RegisterSelectionEditor(TGLBaseSceneObject, TGLBaseSceneObjectSelectionEditor);
  1404. RegisterSelectionEditor(TGLSoundLibrary, TGLSoundLibrarySelectionEditor);
  1405. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLLibMaterialProperty,
  1406. 'NextPass', TGLLibMaterialNameProperty);
  1407. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName),
  1408. TGLTextureProperties, 'LibTextureName', TGLLibTextureNameProperty);
  1409. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName),
  1410. TGLTextureProperties, 'LibSamplerName', TGLLibSamplerNameProperty);
  1411. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName),
  1412. TGLMultitexturingProperties, 'LibCombinerName', TGLLibCombinerNameProperty);
  1413. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName),
  1414. TGLMultitexturingProperties, 'LibAsmProgName', TGLLibAsmProgNameProperty);
  1415. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel3,
  1416. 'LibVertexShaderName', TGLLibShaderNameProperty);
  1417. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel3,
  1418. 'LibFragmentShaderName', TGLLibShaderNameProperty);
  1419. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel4,
  1420. 'LibVertexShaderName', TGLLibShaderNameProperty);
  1421. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel4,
  1422. 'LibFragmentShaderName', TGLLibShaderNameProperty);
  1423. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel4,
  1424. 'LibGeometryShaderName', TGLLibShaderNameProperty);
  1425. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel5,
  1426. 'LibVertexShaderName', TGLLibShaderNameProperty);
  1427. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel5,
  1428. 'LibFragmentShaderName', TGLLibShaderNameProperty);
  1429. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel5,
  1430. 'LibGeometryShaderName', TGLLibShaderNameProperty);
  1431. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel5,
  1432. 'LibTessControlShaderName', TGLLibShaderNameProperty);
  1433. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel5,
  1434. 'LibTessEvalShaderName', TGLLibShaderNameProperty);
  1435. RegisterPropertyEditor(TypeInfo(string), TGLTextureImageEx, 'SourceFile', TPictureFileProperty);
  1436. RegisterPropertyEditor(TypeInfo(string), TGLShaderEx, 'SourceFile', TShaderFileProperty);
  1437. RegisterPropertyEditor(TypeInfo(string), TGLASMVertexProgram, 'SourceFile', TAsmProgFileProperty);
  1438. RegisterPropertyEditor(TypeInfo(Boolean), TGLBaseShaderModel, 'AutoFillOfUniforms', TUniformAutoSetProperty);
  1439. RegisterPropertyEditor(TypeInfo(TStringList), TGLShaderEx, 'Source', TGLShaderEditorProperty);
  1440. end;
  1441. function GetGLSceneVersion: string;
  1442. var
  1443. LProject: IOTAProject;
  1444. LExePath, LProjectPath, LSVN, LRevision: string;
  1445. begin
  1446. LRevision := Copy(GLSCENE_REVISION, 20, 5);
  1447. // will be assigned after project compilation
  1448. // after each compilation get it from file \.svn\entries in 4-th line
  1449. // and write to file GLSceneRevision
  1450. // in both fail (no \.svn\entries or GLSceneRevision file) get a version value from GLScene.pas
  1451. LProject := GetActiveProject;
  1452. LExePath := ExtractFilePath(ParamStr(0));
  1453. if Assigned(LProject) then
  1454. begin
  1455. LProjectPath := ExtractFilePath(LProject.FileName);
  1456. LSVN := LProjectPath + '.svn\entries';
  1457. if FileExists(LSVN) then
  1458. with TStringList.Create do
  1459. try
  1460. // Load
  1461. LoadFromFile(LSVN);
  1462. if (Count >= 4) and (Trim(Strings[3]) <> '') and
  1463. IsDirectoryWriteable(LExePath) then
  1464. begin
  1465. LRevision := Trim(Strings[3]);
  1466. // Save
  1467. Clear;
  1468. Add(LRevision);
  1469. SaveToFile(LExePath + 'GLSceneRevision');
  1470. end;
  1471. finally
  1472. Free;
  1473. end;
  1474. end
  1475. else if FileExists(LExePath + 'GLSceneRevision') then
  1476. try
  1477. with TStringList.Create do
  1478. try
  1479. LoadFromFile(LExePath + 'GLSceneRevision');
  1480. if (Count >= 1) and (Trim(Strings[0]) <> '') then
  1481. LRevision := Trim(Strings[0]);
  1482. finally
  1483. Free;
  1484. end;
  1485. except
  1486. end;
  1487. // Finally
  1488. Result := Format(GLSCENE_VERSION, [LRevision]);
  1489. end;
  1490. function GetProjectTargetName: string;
  1491. var
  1492. Project: IOTAProject;
  1493. begin
  1494. Result := '';
  1495. Project := GetActiveProject;
  1496. if Assigned(Project) then
  1497. begin
  1498. Result := Project.ProjectOptions.TargetName;
  1499. if Length(Result) > 0 then
  1500. ForceDirectories(ExtractFilePath(Result));
  1501. end;
  1502. end;
  1503. // ------------------------------------------------------------------
  1504. initialization
  1505. // ------------------------------------------------------------------
  1506. SplashScreenServices.AddPluginBitmap(GetGLSceneVersion, LoadBitmap(HInstance, 'TGLScene'),
  1507. False, 'MPL 2.0 license', 'VCL version');
  1508. GLS.Utils.IsDesignTime := True;
  1509. GLS.Utils.vProjectTargetName := GetProjectTargetName;
  1510. GLS.Color.vUseDefaultColorSets := True;
  1511. GLS.Coordinates.vUseDefaultCoordinateSets := True;
  1512. ReadVideoModes;
  1513. with ObjectManager do
  1514. begin
  1515. CreateDefaultObjectIcons(HInstance);
  1516. RegisterSceneObject(TGLCamera, 'Camera', '', HInstance);
  1517. RegisterSceneObject(TGLLightSource, 'LightSource', '', HInstance);
  1518. RegisterSceneObject(TGLDummyCube, 'DummyCube', '', HInstance);
  1519. // Basic geometry
  1520. RegisterSceneObject(TGLSprite, 'Sprite', strOCBasicGeometry, HInstance);
  1521. RegisterSceneObject(TGLPoints, 'Points', strOCBasicGeometry, HInstance);
  1522. RegisterSceneObject(TGLLines, 'Lines', strOCBasicGeometry, HInstance);
  1523. RegisterSceneObject(TGLPlane, 'Plane', strOCBasicGeometry, HInstance);
  1524. RegisterSceneObject(TGLPolygon, 'Polygon', strOCBasicGeometry, HInstance);
  1525. RegisterSceneObject(TGLCube, 'Cube', strOCBasicGeometry, HInstance);
  1526. RegisterSceneObject(TGLFrustrum, 'Frustrum', strOCBasicGeometry, HInstance);
  1527. RegisterSceneObject(TGLSphere, 'Sphere', strOCBasicGeometry, HInstance);
  1528. RegisterSceneObject(TGLDisk, 'Disk', strOCBasicGeometry, HInstance);
  1529. RegisterSceneObject(TGLCone, 'Cone', strOCBasicGeometry, HInstance);
  1530. RegisterSceneObject(TGLCylinder, 'Cylinder', strOCBasicGeometry, HInstance);
  1531. RegisterSceneObject(TGLCapsule, 'Capsule', strOCBasicGeometry, HInstance);
  1532. RegisterSceneObject(TGLDodecahedron, 'Dodecahedron', strOCBasicGeometry, HInstance);
  1533. RegisterSceneObject(TGLIcosahedron, 'Icosahedron', strOCBasicGeometry, HInstance);
  1534. RegisterSceneObject(TGLHexahedron, 'Hexahedron', strOCBasicGeometry, HInstance);
  1535. RegisterSceneObject(TGLOctahedron, 'Octahedron', strOCBasicGeometry, HInstance);
  1536. RegisterSceneObject(TGLTetrahedron, 'Tetrahedron', strOCBasicGeometry, HInstance);
  1537. RegisterSceneObject(TGLSuperellipsoid, 'Superellipsoid', strOCBasicGeometry, HInstance);
  1538. // Advanced geometry
  1539. RegisterSceneObject(TGLAnimatedSprite, 'Animated Sprite', strOCAdvancedGeometry, HInstance);
  1540. RegisterSceneObject(TGLArrowLine, 'ArrowLine', strOCAdvancedGeometry, HInstance);
  1541. RegisterSceneObject(TGLArrowArc, 'ArrowArc', strOCAdvancedGeometry, HInstance);
  1542. RegisterSceneObject(TGLAnnulus, 'Annulus', strOCAdvancedGeometry, HInstance);
  1543. RegisterSceneObject(TGLExtrusionSolid, 'ExtrusionSolid', strOCAdvancedGeometry, HInstance);
  1544. RegisterSceneObject(TGLMultiPolygon, 'MultiPolygon', strOCAdvancedGeometry, HInstance);
  1545. RegisterSceneObject(TGLPipe, 'Pipe', strOCAdvancedGeometry, HInstance);
  1546. RegisterSceneObject(TGLRevolutionSolid, 'RevolutionSolid', strOCAdvancedGeometry, HInstance);
  1547. RegisterSceneObject(TGLTorus, 'Torus', strOCAdvancedGeometry, HInstance);
  1548. // Mesh objects
  1549. RegisterSceneObject(TGLActor, 'Actor', strOCMeshObjects, HInstance);
  1550. RegisterSceneObject(TGLFreeForm, 'FreeForm', strOCMeshObjects, HInstance);
  1551. RegisterSceneObject(TGLMesh, 'Mesh', strOCMeshObjects, HInstance);
  1552. RegisterSceneObject(TGLTilePlane, 'TilePlane', strOCMeshObjects, HInstance);
  1553. RegisterSceneObject(TGLPortal, 'Portal', strOCMeshObjects, HInstance);
  1554. RegisterSceneObject(TGLTerrainRenderer, 'TerrainRenderer', strOCMeshObjects, HInstance);
  1555. // Graph-plotting objects
  1556. RegisterSceneObject(TGLFlatText, 'FlatText', strOCGraphPlottingObjects, HInstance);
  1557. RegisterSceneObject(TGLHeightField, 'HeightField', strOCGraphPlottingObjects, HInstance);
  1558. RegisterSceneObject(TGLXYZGrid, 'XYZGrid', strOCGraphPlottingObjects, HInstance);
  1559. // Particle systems
  1560. RegisterSceneObject(TGLParticles, 'Particles', strOCParticleSystems, HInstance);
  1561. RegisterSceneObject(TGLParticleFXRenderer, 'PFX Renderer', strOCParticleSystems, HInstance);
  1562. // Environment objects
  1563. RegisterSceneObject(TGLEarthSkyDome, 'EarthSkyDome', strOCEnvironmentObjects, HInstance);
  1564. RegisterSceneObject(TGLSkyDome, 'SkyDome', strOCEnvironmentObjects, HInstance);
  1565. RegisterSceneObject(TGLSkyBox, 'SkyBox', strOCEnvironmentObjects, HInstance);
  1566. RegisterSceneObject(TGLAtmosphere, 'Atmosphere', strOCEnvironmentObjects, HInstance);
  1567. // HUD objects.
  1568. RegisterSceneObject(TGLHUDSprite, 'HUD Sprite', strOCHUDObjects, HInstance);
  1569. RegisterSceneObject(TGLHUDText, 'HUD Text', strOCHUDObjects, HInstance);
  1570. RegisterSceneObject(TGLResolutionIndependantHUDText,
  1571. 'Resolution Independant HUD Text', strOCHUDObjects, HInstance);
  1572. RegisterSceneObject(TGLAbsoluteHUDText, 'Absolute HUD Text', strOCHUDObjects, HInstance);
  1573. RegisterSceneObject(TGLGameMenu, 'GameMenu', strOCHUDObjects, HInstance);
  1574. RegisterSceneObject(TGLConsole, 'Console', strOCHUDObjects, HInstance);
  1575. // GUI objects.
  1576. RegisterSceneObject(TGLBaseControl, 'Root Control', strOCGuiObjects, HInstance);
  1577. RegisterSceneObject(TGLPopupMenu, 'GLPopupMenu', strOCGuiObjects, HInstance);
  1578. RegisterSceneObject(TGLForm, 'GLForm', strOCGuiObjects, HInstance);
  1579. RegisterSceneObject(TGLPanel, 'GLPanel', strOCGuiObjects, HInstance);
  1580. RegisterSceneObject(TGLButton, 'GLButton', strOCGuiObjects, HInstance);
  1581. RegisterSceneObject(TGLCheckBox, 'GLCheckBox', strOCGuiObjects, HInstance);
  1582. RegisterSceneObject(TGLEdit, 'GLEdit', strOCGuiObjects, HInstance);
  1583. RegisterSceneObject(TGLLabel, 'GLLabel', strOCGuiObjects, HInstance);
  1584. RegisterSceneObject(TGLAdvancedLabel, 'GLAdvancedLabel', strOCGuiObjects, HInstance);
  1585. RegisterSceneObject(TGLScrollbar, 'GLScrollbar', strOCGuiObjects, HInstance);
  1586. RegisterSceneObject(TGLStringGrid, 'GLStringGrid', strOCGuiObjects, HInstance);
  1587. RegisterSceneObject(TGLCustomControl, 'GLBitmapControl', strOCGuiObjects, HInstance);
  1588. // Special objects
  1589. RegisterSceneObject(TGLLensFlare, 'LensFlare', strOCSpecialObjects, HInstance);
  1590. RegisterSceneObject(TGLTextureLensFlare, 'TextureLensFlare', strOCSpecialObjects, HInstance);
  1591. RegisterSceneObject(TGLMirror, 'Mirror', strOCSpecialObjects, HInstance);
  1592. RegisterSceneObject(TGLShadowPlane, 'ShadowPlane', strOCSpecialObjects, HInstance);
  1593. RegisterSceneObject(TGLShadowVolume, 'ShadowVolume', strOCSpecialObjects, HInstance);
  1594. RegisterSceneObject(TGLZShadows, 'ZShadows', strOCSpecialObjects, HInstance);
  1595. // Texture objects
  1596. RegisterSceneObject(TGLSLTextureEmitter, 'GLSL Texture Emitter', strOCSpecialObjects, HInstance);
  1597. RegisterSceneObject(TGLSLProjectedTextures, 'GLSL Projected Textures', strOCSpecialObjects, HInstance);
  1598. RegisterSceneObject(TGLTextureEmitter, 'Texture Emitter', strOCSpecialObjects, HInstance);
  1599. RegisterSceneObject(TGLProjectedTextures, 'Projected Textures', strOCSpecialObjects, HInstance);
  1600. RegisterSceneObject(TGLBlur, 'Blur', strOCSpecialObjects, HInstance);
  1601. RegisterSceneObject(TGLMotionBlur, 'MotionBlur', strOCSpecialObjects, HInstance);
  1602. RegisterSceneObject(TGLSpaceText, 'SpaceText', strOCDoodad, HInstance);
  1603. RegisterSceneObject(TGLTrail, 'GLTrail', strOCSpecialObjects, HInstance);
  1604. RegisterSceneObject(TGLPostEffect, 'PostEffect', strOCSpecialObjects, HInstance);
  1605. RegisterSceneObject(TGLPostShaderHolder, 'PostShaderHolder', strOCSpecialObjects, HInstance);
  1606. // Doodad objects.
  1607. RegisterSceneObject(TGLTeapot, 'Teapot', strOCDoodad, HInstance);
  1608. RegisterSceneObject(TGLTree, 'Tree', strOCDoodad, HInstance);
  1609. RegisterSceneObject(TGLWaterPlane, 'WaterPlane', strOCDoodad, HInstance);
  1610. // Proxy objects.
  1611. RegisterSceneObject(TGLProxyObject, 'ProxyObject', strOCProxyObjects, HInstance);
  1612. RegisterSceneObject(TGLColorProxy, 'ColorProxy', strOCProxyObjects, HInstance);
  1613. RegisterSceneObject(TGLFreeFormProxy, 'FreeFormProxy', strOCProxyObjects, HInstance);
  1614. RegisterSceneObject(TGLMaterialProxy, 'MaterialProxy', strOCProxyObjects, HInstance);
  1615. RegisterSceneObject(TGLActorProxy, 'ActorProxy', strOCProxyObjects, HInstance);
  1616. RegisterSceneObject(TGLMultiProxy, 'MultiProxy', strOCProxyObjects, HInstance);
  1617. RegisterSceneObject(TGLMaterialMultiProxy, 'MaterialMultiProxy', strOCProxyObjects, HInstance);
  1618. // Other objects.
  1619. RegisterSceneObject(TGLDirectOpenGL, 'Direct OpenGL', '', HInstance);
  1620. RegisterSceneObject(TGLRenderPoint, 'Render Point', '', HInstance);
  1621. RegisterSceneObject(TGLImposter, 'Imposter Sprite', '', HInstance);
  1622. RegisterSceneObject(TGLFeedback, 'OpenGL Feedback', '', HInstance);
  1623. RegisterSceneObject(TGLFBORenderer, 'OpenGL FrameBuffer', '', HInstance);
  1624. end;
  1625. //------------------------------------------------------
  1626. finalization
  1627. //------------------------------------------------------
  1628. ObjectManager.Free;
  1629. end.