GLS.SceneRegister.pas 61 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845
  1. //
  2. // The graphics platform GLScene https://github.com/glscene
  3. //
  4. unit GLS.SceneRegister;
  5. (*
  6. Registration unit for library components, property editors and
  7. IDE experts.
  8. *)
  9. interface
  10. {$I Scenario.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. Scenario.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.FileHDR,
  379. GLS.FileJPEG,
  380. GLS.FilePNG,
  381. GLS.FileBMP,
  382. GLS.FileTGA,
  383. GLS.SoundManager,
  384. GLS.SoundFileObjects,
  385. GLS.SpaceText,
  386. GLS.Joystick,
  387. GLS.ScreenSaver,
  388. GLS.FullScreenViewer,
  389. GLS.Logger;
  390. var
  391. vObjectManager: TGLObjectManager;
  392. function ObjectManager: TGLObjectManager;
  393. begin
  394. if not Assigned(vObjectManager) then
  395. vObjectManager := TGLObjectManager.Create(nil);
  396. Result := vObjectManager;
  397. end;
  398. //----------------- TGLSceneViewerEditor ---------------------------------------
  399. procedure TGLSceneViewerEditor.ExecuteVerb(Index: Integer);
  400. var
  401. source: TGLSceneViewer;
  402. begin
  403. source := Component as TGLSceneViewer;
  404. case Index of
  405. 0: source.Buffer.ShowInfo;
  406. end;
  407. end;
  408. function TGLSceneViewerEditor.GetVerb(Index: Integer): string;
  409. begin
  410. case Index of
  411. 0: Result := 'Show context info';
  412. end;
  413. end;
  414. function TGLSceneViewerEditor.GetVerbCount: Integer;
  415. begin
  416. Result := 1;
  417. end;
  418. //----------------- TGLSceneEditor ---------------------------------------------
  419. procedure TGLSceneEditor.Edit;
  420. begin
  421. with GLSceneEditorForm do
  422. begin
  423. SetScene(Self.Component as TGLScene, Self.Designer);
  424. Show;
  425. end;
  426. end;
  427. procedure TGLSceneEditor.ExecuteVerb(Index: Integer);
  428. begin
  429. case Index of
  430. 0: Edit;
  431. end;
  432. end;
  433. function TGLSceneEditor.GetVerb(Index: Integer): string;
  434. begin
  435. case Index of
  436. 0: Result := 'Show Scene Editor';
  437. end;
  438. end;
  439. function TGLSceneEditor.GetVerbCount: Integer;
  440. begin
  441. Result := 1;
  442. end;
  443. //----------------- TGLResolutionProperty ----------------------------------------
  444. function TGLResolutionProperty.GetAttributes: TPropertyAttributes;
  445. begin
  446. Result := [paValueList];
  447. end;
  448. function TGLResolutionProperty.GetValue: string;
  449. begin
  450. Result := vVideoModes[GetOrdValue].Description;
  451. end;
  452. procedure TGLResolutionProperty.GetValues(Proc: TGetStrProc);
  453. var
  454. i: Integer;
  455. begin
  456. for i := 0 to vNumberVideoModes - 1 do
  457. Proc(vVideoModes[i].Description);
  458. end;
  459. procedure TGLResolutionProperty.SetValue(const Value: string);
  460. const
  461. Nums = ['0' .. '9'];
  462. var
  463. XRes, YRes, BPP: Integer;
  464. Pos, SLength: Integer;
  465. TempStr: string;
  466. begin
  467. if CompareText(Value, 'default') <> 0 then
  468. begin
  469. // initialize scanning
  470. TempStr := Trim(Value) + '|'; // ensure at least one delimiter
  471. SLength := Length(TempStr);
  472. XRes := 0;
  473. YRes := 0;
  474. BPP := 0;
  475. // contains the string something?
  476. if SLength > 1 then
  477. begin
  478. // determine first number
  479. for Pos := 1 to SLength do
  480. if not(AnsiChar(TempStr[Pos]) in Nums) then
  481. Break;
  482. if Pos <= SLength then
  483. begin
  484. // found a number?
  485. XRes := StrToInt(Copy(TempStr, 1, Pos - 1));
  486. // search for following non-numerics
  487. for Pos := Pos to SLength do
  488. if AnsiChar(TempStr[Pos]) in Nums then
  489. Break;
  490. Delete(TempStr, 1, Pos - 1); // take it out of the String
  491. SLength := Length(TempStr); // rest length of String
  492. if SLength > 1 then // something to scan?
  493. begin
  494. // determine second number
  495. for Pos := 1 to SLength do
  496. if not(AnsiChar(TempStr[Pos]) in Nums) then
  497. Break;
  498. if Pos <= SLength then
  499. begin
  500. YRes := StrToInt(Copy(TempStr, 1, Pos - 1));
  501. // search for following non-numerics
  502. for Pos := Pos to SLength do
  503. if AnsiChar(TempStr[Pos]) in Nums then
  504. Break;
  505. Delete(TempStr, 1, Pos - 1); // take it out of the String
  506. SLength := Length(TempStr); // rest length of String
  507. if SLength > 1 then
  508. begin
  509. for Pos := 1 to SLength do
  510. if not(AnsiChar(TempStr[Pos]) in Nums) then
  511. Break;
  512. if Pos <= SLength then
  513. BPP := StrToInt(Copy(TempStr, 1, Pos - 1));
  514. end;
  515. end;
  516. end;
  517. end;
  518. end;
  519. SetOrdValue(GetIndexFromResolution(XRes, YRes, BPP));
  520. end
  521. else
  522. SetOrdValue(0);
  523. end;
  524. //----------------- TGLTextureProperty -----------------------------------------
  525. function TGLTextureProperty.GetAttributes: TPropertyAttributes;
  526. begin
  527. Result := [paSubProperties];
  528. end;
  529. //----------------- TGLTextureImageProperty ------------------------------------
  530. function TGLTextureImageProperty.GetAttributes: TPropertyAttributes;
  531. begin
  532. Result := [paDialog];
  533. end;
  534. procedure TGLTextureImageProperty.Edit;
  535. begin
  536. if EditGLTextureImage(TGLTextureImage(GetOrdValue)) then
  537. Designer.Modified;
  538. end;
  539. //----------------- TGLImageClassProperty --------------------------------------
  540. function TGLImageClassProperty.GetAttributes: TPropertyAttributes;
  541. begin
  542. Result := [paValueList];
  543. end;
  544. procedure TGLImageClassProperty.GetValues(Proc: TGetStrProc);
  545. var
  546. i: Integer;
  547. sl: TStrings;
  548. begin
  549. sl := GetGLTextureImageClassesAsStrings;
  550. try
  551. for i := 0 to sl.Count - 1 do
  552. Proc(sl[i]);
  553. finally
  554. sl.Free;
  555. end;
  556. end;
  557. function TGLImageClassProperty.GetValue: string;
  558. begin
  559. Result := FindGLTextureImageClass(GetStrValue).FriendlyName;
  560. end;
  561. procedure TGLImageClassProperty.SetValue(const Value: string);
  562. var
  563. tic: TGLTextureImageClass;
  564. begin
  565. tic := FindGLTextureImageClassByFriendlyName(Value);
  566. if Assigned(tic) then
  567. SetStrValue(tic.ClassName)
  568. else
  569. SetStrValue('');
  570. Modified;
  571. end;
  572. //----------------- TGLColorproperty -----------------------------------------------------------------------------------
  573. procedure TGLColorProperty.Edit;
  574. var
  575. colorDialog: TColorDialog;
  576. GLColor: TGLColor;
  577. begin
  578. colorDialog := TColorDialog.Create(nil);
  579. try
  580. GLColor := TGLColor(GetOrdValue);
  581. colorDialog.Options := [cdFullOpen];
  582. colorDialog.Color := ConvertColorVector(GLColor.Color);
  583. if colorDialog.Execute then
  584. begin
  585. GLColor.Color := ConvertWinColor(colorDialog.Color);
  586. Modified;
  587. end;
  588. finally
  589. colorDialog.Free;
  590. end;
  591. end;
  592. function TGLColorProperty.GetAttributes: TPropertyAttributes;
  593. begin
  594. Result := [paSubProperties, paValueList, paDialog];
  595. end;
  596. procedure TGLColorProperty.GetValues(Proc: TGetStrProc);
  597. begin
  598. ColorManager.EnumColors(Proc);
  599. end;
  600. function TGLColorProperty.GetValue: string;
  601. begin
  602. Result := ColorManager.GetColorName(TGLColor(GetOrdValue).Color);
  603. end;
  604. procedure TGLColorProperty.SetValue(const Value: string);
  605. begin
  606. TGLColor(GetOrdValue).Color := ColorManager.GetColor(Value);
  607. Modified;
  608. end;
  609. function TGLColorProperty.ColorToBorderColor(aColor: TGLColorVector; selected: Boolean): TColor;
  610. begin
  611. if (aColor.X > 0.75) or (aColor.Y > 0.75) or (aColor.Z > 0.75) then
  612. Result := clBlack
  613. else if selected then
  614. Result := clWhite
  615. else
  616. Result := ConvertColorVector(aColor);
  617. end;
  618. procedure TGLColorProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
  619. ASelected: Boolean);
  620. begin
  621. if GetVisualValue <> '' then
  622. ListDrawValue(GetVisualValue, ACanvas, ARect, True)
  623. else
  624. DefaultPropertyDrawValue(Self, ACanvas, ARect);
  625. end;
  626. procedure TGLColorProperty.ListDrawValue(const Value: string; ACanvas: TCanvas;
  627. const ARect: TRect; ASelected: Boolean);
  628. var
  629. vRight: Integer;
  630. vOldPenColor, vOldBrushColor: TColor;
  631. Color: TGLColorVector;
  632. begin
  633. vRight := (ARect.Bottom - ARect.Top) + ARect.Left;
  634. with ACanvas do
  635. try
  636. vOldPenColor := Pen.Color;
  637. vOldBrushColor := Brush.Color;
  638. Pen.Color := Brush.Color;
  639. Rectangle(ARect.Left, ARect.Top, vRight, ARect.Bottom);
  640. Color := ColorManager.GetColor(Value);
  641. Brush.Color := ConvertColorVector(Color);
  642. Pen.Color := ColorToBorderColor(Color, ASelected);
  643. Rectangle(ARect.Left + 1, ARect.Top + 1, vRight - 1, ARect.Bottom - 1);
  644. Brush.Color := vOldBrushColor;
  645. Pen.Color := vOldPenColor;
  646. finally
  647. DefaultPropertyListDrawValue(Value, ACanvas,
  648. Rect(vRight, ARect.Top, ARect.Right, ARect.Bottom), ASelected);
  649. end;
  650. end;
  651. procedure TGLColorProperty.ListMeasureWidth(const Value: string;
  652. ACanvas: TCanvas; var AWidth: Integer);
  653. begin
  654. AWidth := AWidth + ACanvas.TextHeight('M');
  655. end;
  656. procedure TGLColorProperty.ListMeasureHeight(const Value: string;
  657. ACanvas: TCanvas; var AHeight: Integer);
  658. begin
  659. // Nothing
  660. end;
  661. procedure TGLColorProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect;
  662. ASelected: Boolean);
  663. begin
  664. DefaultPropertyDrawName(Self, ACanvas, ARect);
  665. end;
  666. //----------------- TGLSoundFileProperty -----------------------------------------
  667. function TGLSoundFileProperty.GetAttributes: TPropertyAttributes;
  668. begin
  669. Result := [paDialog];
  670. end;
  671. function TGLSoundFileProperty.GetValue: string;
  672. var
  673. sample: TGLSoundSample;
  674. begin
  675. sample := GetComponent(0) as TGLSoundSample;
  676. if sample.Data <> nil then
  677. Result := '(' + sample.Data.ClassName + ')'
  678. else
  679. Result := '(empty)';
  680. end;
  681. procedure TGLSoundFileProperty.Edit;
  682. var
  683. ODialog: TOpenDialog;
  684. sample: TGLSoundSample;
  685. Desc, F: string;
  686. begin
  687. sample := GetComponent(0) as TGLSoundSample;
  688. ODialog := TOpenDialog.Create(nil);
  689. try
  690. GetGLSoundFileFormats.BuildFilterStrings(TGLSoundFile, Desc, F);
  691. ODialog.Filter := Desc;
  692. if ODialog.Execute then
  693. begin
  694. sample.LoadFromFile(ODialog.FileName);
  695. Modified;
  696. end;
  697. finally
  698. ODialog.Free;
  699. end;
  700. end;
  701. //----------------- TGLSoundNameProperty -----------------------------------------
  702. function TGLSoundNameProperty.GetAttributes: TPropertyAttributes;
  703. begin
  704. Result := [paValueList];
  705. end;
  706. procedure TGLSoundNameProperty.GetValues(Proc: TGetStrProc);
  707. var
  708. i: Integer;
  709. source: TGLBaseSoundSource;
  710. begin
  711. source := (GetComponent(0) as TGLBaseSoundSource);
  712. if Assigned(source.SoundLibrary) then
  713. with source.SoundLibrary do
  714. for i := 0 to Samples.Count - 1 do
  715. Proc(Samples[i].Name);
  716. end;
  717. //----------------- TGLCoordinatesProperty -------------------------------------
  718. function TGLCoordinatesProperty.GetAttributes: TPropertyAttributes;
  719. begin
  720. Result := [paDialog, paSubProperties];
  721. end;
  722. procedure TGLCoordinatesProperty.Edit;
  723. var
  724. glc: TGLCoordinates;
  725. x, y, z: Single;
  726. begin
  727. glc := TGLCoordinates(GetOrdValue);
  728. x := glc.x;
  729. y := glc.y;
  730. z := glc.z;
  731. if GLVectorEditorForm.Execute(x, y, z) then
  732. begin
  733. glc.AsVector := VectorMake(x, y, z);
  734. Modified;
  735. end;
  736. end;
  737. //----------------- TGLGUILayoutEditor -------------------------------
  738. procedure TGLGUILayoutEditor.Edit;
  739. begin
  740. GUILayoutEditorForm.Execute(TGLGuiLayout(Self.Component));
  741. end;
  742. procedure TGLGUILayoutEditor.ExecuteVerb(Index: Integer);
  743. begin
  744. case Index of
  745. 0: Edit;
  746. end;
  747. end;
  748. function TGLGUILayoutEditor.GetVerb(Index: Integer): string;
  749. begin
  750. case Index of
  751. 0:
  752. Result := 'Show Layout Editor';
  753. end;
  754. end;
  755. function TGLGUILayoutEditor.GetVerbCount: Integer;
  756. begin
  757. Result := 1;
  758. end;
  759. //----------------- TGLReuseableDefaultEditor --------------------------
  760. procedure TGLReuseableDefaultEditor.CheckEdit(const Prop: IProperty);
  761. begin
  762. if FContinue then
  763. EditProperty(Prop, FContinue);
  764. end;
  765. procedure TGLReuseableDefaultEditor.EditProperty(const Prop: IProperty;
  766. var Continue: Boolean);
  767. var
  768. PropName: string;
  769. BestName: string;
  770. MethodProperty: IMethodProperty;
  771. procedure ReplaceBest;
  772. begin
  773. FBest := Prop;
  774. if FFirst = FBest then
  775. FFirst := nil;
  776. end;
  777. begin
  778. if not Assigned(FFirst) and Supports(Prop, IMethodProperty, MethodProperty)
  779. then
  780. FFirst := Prop;
  781. PropName := Prop.GetName;
  782. BestName := '';
  783. if Assigned(FBest) then
  784. BestName := FBest.GetName;
  785. if CompareText(PropName, 'ONCREATE') = 0 then
  786. ReplaceBest
  787. else if CompareText(BestName, 'ONCREATE') <> 0 then
  788. if CompareText(PropName, 'ONCHANGE') = 0 then
  789. ReplaceBest
  790. else if CompareText(BestName, 'ONCHANGE') <> 0 then
  791. if CompareText(PropName, 'ONCLICK') = 0 then
  792. ReplaceBest;
  793. end;
  794. procedure TGLReuseableDefaultEditor.Edit;
  795. var
  796. Components: IDesignerSelections;
  797. begin
  798. Components := TDesignerSelections.Create;
  799. FContinue := True;
  800. Components.Add(Component);
  801. FFirst := nil;
  802. FBest := nil;
  803. try
  804. GetComponentProperties(Components, tkAny, Designer, CheckEdit);
  805. if FContinue then
  806. if Assigned(FBest) then
  807. FBest.Edit
  808. else if Assigned(FFirst) then
  809. FFirst.Edit;
  810. finally
  811. FFirst := nil;
  812. FBest := nil;
  813. end;
  814. end;
  815. //----------------- TGLMaterialLibraryEditor ----------------------------------
  816. procedure TGLMaterialLibraryEditor.EditProperty(const Prop: IProperty; var Continue: Boolean);
  817. begin
  818. if CompareText(Prop.GetName, 'MATERIALS') = 0 then
  819. begin
  820. FBest := Prop;
  821. end;
  822. end;
  823. procedure TGLMaterialLibraryEditor.ExecuteVerb(Index: Integer);
  824. begin
  825. case Index of
  826. 0: Edit;
  827. end;
  828. end;
  829. function TGLMaterialLibraryEditor.GetVerb(Index: Integer): string;
  830. begin
  831. case Index of
  832. 0: Result := 'Show Material Library Editor';
  833. end;
  834. end;
  835. function TGLMaterialLibraryEditor.GetVerbCount: Integer;
  836. begin
  837. Result := 1
  838. end;
  839. //----------------- TGLMaterialProperty -------------------------------
  840. function TGLMaterialProperty.GetAttributes: TPropertyAttributes;
  841. begin
  842. Result := [paDialog, paSubProperties];
  843. end;
  844. procedure TGLMaterialProperty.Edit;
  845. var
  846. buf: string;
  847. ml: TGLAbstractMaterialLibrary;
  848. obj: TPersistent;
  849. Int: IGLMaterialLibrarySupported;
  850. begin
  851. if FmMaterialEditor.GLMaterialEditorForm.Execute(TGLMaterial(GetOrdValue)) then
  852. Modified;
  853. end;
  854. //----------------- TGLLibMaterialNameProperty ---------------------------------
  855. function TGLLibMaterialNameProperty.GetAttributes: TPropertyAttributes;
  856. begin
  857. Result := [paDialog];
  858. end;
  859. procedure TGLLibMaterialNameProperty.Edit;
  860. var
  861. buf: string;
  862. ml: TGLAbstractMaterialLibrary;
  863. obj: TPersistent;
  864. Int: IGLMaterialLibrarySupported;
  865. begin
  866. buf := GetStrValue;
  867. obj := GetComponent(0);
  868. if Supports(obj, IGLMaterialLibrarySupported, Int) then
  869. ml := Int.GetMaterialLibrary
  870. else
  871. begin
  872. ml := nil;
  873. Assert(False, 'oops, unsupported...');
  874. end;
  875. if not Assigned(ml) then
  876. ShowMessage('Select the material library first.')
  877. else
  878. if GLLibMaterialPickerForm.Execute(buf, ml) then
  879. SetStrValue(buf);
  880. end;
  881. //----------------- TGLAnimationNameProperty -----------------------------------
  882. function TGLAnimationNameProperty.GetAttributes: TPropertyAttributes;
  883. begin
  884. Result := [paValueList];
  885. end;
  886. procedure TGLAnimationNameProperty.GetValues(Proc: TGetStrProc);
  887. var
  888. i: Integer;
  889. animControler: TGLAnimationControler;
  890. actor: TGLActor;
  891. begin
  892. animControler := (GetComponent(0) as TGLAnimationControler);
  893. if Assigned(animControler) then
  894. begin
  895. actor := animControler.actor;
  896. if Assigned(actor) then
  897. with actor.Animations do
  898. begin
  899. for i := 0 to Count - 1 do
  900. Proc(Items[i].Name);
  901. end;
  902. end;
  903. end;
  904. //---------------- TGLBaseSceneObjectSelectionEditor -----------------------
  905. procedure TGLBaseSceneObjectSelectionEditor.RequiresUnits(Proc: TGetStrProc);
  906. var
  907. i, j: Integer;
  908. comp: TGLBaseSceneObject;
  909. begin
  910. if (Designer = nil) or (Designer.Root = nil) then
  911. Exit;
  912. for i := 0 to Designer.Root.ComponentCount - 1 do
  913. begin
  914. if (Designer.Root.Components[i] is TGLBaseSceneObject) then
  915. begin
  916. comp := TGLBaseSceneObject(Designer.Root.Components[i]);
  917. for j := 0 to comp.Behaviours.Count - 1 do
  918. Proc(FindUnitName(comp.Behaviours[j]));
  919. for j := 0 to comp.Effects.Count - 1 do
  920. Proc(FindUnitName(comp.Effects[j]));
  921. end;
  922. end;
  923. end;
  924. //---------------------------- TGLSoundLibrarySelectionEditor -----------------------
  925. procedure TGLSoundLibrarySelectionEditor.RequiresUnits(Proc: TGetStrProc);
  926. var
  927. i, j: Integer;
  928. comp: TGLSoundLibrary;
  929. begin
  930. if (Designer = nil) or (Designer.Root = nil) then
  931. Exit;
  932. for i := 0 to Designer.Root.ComponentCount - 1 do
  933. begin
  934. if (Designer.Root.Components[i] is TGLSoundLibrary) then
  935. begin
  936. comp := TGLSoundLibrary(Designer.Root.Components[i]);
  937. for j := 0 to comp.Samples.Count - 1 do
  938. if Assigned(comp.Samples[j].Data) then
  939. Proc(FindUnitName(comp.Samples[j].Data));
  940. end;
  941. end;
  942. end;
  943. //-------------------- TGLSArchiveManagerEditor -----------------------
  944. procedure TGLSArchiveManagerEditor.EditProperty(const Prop: IProperty;
  945. var Continue: Boolean);
  946. begin
  947. if CompareText(Prop.GetName, 'ARCHIVES') = 0 then
  948. begin
  949. FBest := Prop;
  950. end;
  951. end;
  952. procedure TGLSArchiveManagerEditor.ExecuteVerb(Index: Integer);
  953. begin
  954. case Index of
  955. 0: Edit;
  956. end;
  957. end;
  958. function TGLSArchiveManagerEditor.GetVerb(Index: Integer): string;
  959. begin
  960. case Index of
  961. 0: Result := 'Show Archive Manager Editor';
  962. end;
  963. end;
  964. function TGLSArchiveManagerEditor.GetVerbCount: Integer;
  965. begin
  966. Result := 1
  967. end;
  968. procedure TGLMaterialComponentNameProperty.Edit;
  969. var
  970. LOwner: IGLMaterialLibrarySupported;
  971. LItem: TGLBaseMaterialCollectionItem;
  972. begin
  973. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  974. begin
  975. LItem := TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  976. .Components.GetItemByName(GetStrValue);
  977. if Assigned(LItem) then
  978. Designer.SelectComponent(LItem);
  979. Modified;
  980. end;
  981. end;
  982. function TGLMaterialComponentNameProperty.GetAttributes: TPropertyAttributes;
  983. begin
  984. Result := [paValueList];
  985. end;
  986. procedure TGLLibTextureNameProperty.GetValues(Proc: TGetStrProc);
  987. var
  988. LOwner: IGLMaterialLibrarySupported;
  989. begin
  990. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  991. begin
  992. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  993. .GetNames(Proc, TGLTextureImageEx);
  994. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  995. .GetNames(Proc, TGLFrameBufferAttachment);
  996. end;
  997. end;
  998. procedure TGLLibSamplerNameProperty.GetValues(Proc: TGetStrProc);
  999. var
  1000. LOwner: IGLMaterialLibrarySupported;
  1001. begin
  1002. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  1003. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  1004. .GetNames(Proc, TGLTextureSampler);
  1005. end;
  1006. procedure TGLLibCombinerNameProperty.GetValues(Proc: TGetStrProc);
  1007. var
  1008. LOwner: IGLMaterialLibrarySupported;
  1009. begin
  1010. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  1011. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  1012. .GetNames(Proc, TGLTextureCombiner);
  1013. end;
  1014. procedure TGLLibShaderNameProperty.GetValues(Proc: TGetStrProc);
  1015. var
  1016. LOwner: IGLMaterialLibrarySupported;
  1017. begin
  1018. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  1019. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary).GetNames(Proc, TGLShaderEx);
  1020. end;
  1021. procedure TGLLibAttachmentNameProperty.GetValues(Proc: TGetStrProc);
  1022. var
  1023. LOwner: IGLMaterialLibrarySupported;
  1024. begin
  1025. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  1026. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  1027. .GetNames(Proc, TGLFrameBufferAttachment);
  1028. end;
  1029. procedure TGLLibAsmProgNameProperty.GetValues(Proc: TGetStrProc);
  1030. var
  1031. LOwner: IGLMaterialLibrarySupported;
  1032. begin
  1033. if Supports(GetComponent(0), IGLMaterialLibrarySupported, LOwner) then
  1034. TGLMaterialLibraryEx(LOwner.GetMaterialLibrary)
  1035. .GetNames(Proc, TGLASMVertexProgram);
  1036. end;
  1037. function TPictureFileProperty.GetAttributes: TPropertyAttributes;
  1038. begin
  1039. Result := [paDialog];
  1040. end;
  1041. procedure TPictureFileProperty.Edit;
  1042. var
  1043. LFileName: string;
  1044. begin
  1045. if OpenPictureDialog(LFileName) then
  1046. begin
  1047. SetStrValue(RelativePath(LFileName));
  1048. end;
  1049. Modified;
  1050. end;
  1051. procedure TShaderFileProperty.Edit;
  1052. var
  1053. ODialog: TOpenDialog;
  1054. begin
  1055. ODialog := TOpenDialog.Create(nil);
  1056. try
  1057. ODialog.Filter := '*.glsl';
  1058. if ODialog.Execute then
  1059. begin
  1060. SetStrValue(RelativePath(ODialog.FileName));
  1061. Modified;
  1062. end;
  1063. finally
  1064. ODialog.Free;
  1065. end;
  1066. end;
  1067. function TShaderFileProperty.GetAttributes: TPropertyAttributes;
  1068. begin
  1069. Result := [paDialog];
  1070. end;
  1071. procedure TAsmProgFileProperty.Edit;
  1072. var
  1073. ODialog: TOpenDialog;
  1074. begin
  1075. ODialog := TOpenDialog.Create(nil);
  1076. try
  1077. ODialog.Filter := '*.asm';
  1078. if ODialog.Execute then
  1079. begin
  1080. SetStrValue(RelativePath(ODialog.FileName));
  1081. Modified;
  1082. end;
  1083. finally
  1084. ODialog.Free;
  1085. end;
  1086. end;
  1087. function TAsmProgFileProperty.GetAttributes: TPropertyAttributes;
  1088. begin
  1089. Result := [paDialog];
  1090. end;
  1091. function TUniformAutoSetProperty.GetAttributes: TPropertyAttributes;
  1092. begin
  1093. Result := [paDialog, paFullWidthName];
  1094. end;
  1095. procedure TUniformAutoSetProperty.PassUniform(const S: string);
  1096. begin
  1097. GLShaderUniformEditor.AddUniform(TGLBaseShaderModel(GetComponent(0))
  1098. .Uniforms[S]);
  1099. end;
  1100. procedure TUniformAutoSetProperty.Edit;
  1101. var
  1102. LOwner: TGLBaseShaderModel;
  1103. begin
  1104. LOwner := TGLBaseShaderModel(GetComponent(0));
  1105. if LOwner.Enabled and LOwner.IsValid then
  1106. begin
  1107. with GLShaderUniformEditor do
  1108. begin
  1109. Clear;
  1110. LOwner.MaterialLibrary.GetNames(AddTextureName, TGLTextureImageEx);
  1111. LOwner.MaterialLibrary.GetNames(AddTextureName, TGLFrameBufferAttachment);
  1112. LOwner.MaterialLibrary.GetNames(AddSamplerName, TGLTextureSampler);
  1113. LOwner.GetUniformNames(PassUniform);
  1114. Execute;
  1115. end;
  1116. end;
  1117. end;
  1118. function TGLShaderEditorProperty.GetAttributes: TPropertyAttributes;
  1119. begin
  1120. Result := inherited GetAttributes + [paDialog] - [paSubProperties];
  1121. end;
  1122. function TGLShaderEditorProperty.GetStrings: TStrings;
  1123. begin
  1124. Result := TStrings(GetOrdValue);
  1125. end;
  1126. procedure TGLShaderEditorProperty.OnShaderCheck(Sender: TObject);
  1127. var
  1128. LShader: TGLShaderEx;
  1129. LContext: TGLContext;
  1130. begin
  1131. SetStrings(GLShaderEditorForm.GLSLMemo.Lines);
  1132. LShader := TGLShaderEx(GetComponent(0));
  1133. LContext := LShader.Handle.RenderingContext;
  1134. if Assigned(LContext) then
  1135. begin
  1136. LContext.Activate;
  1137. try
  1138. LShader.DoOnPrepare(LContext);
  1139. GLShaderEditorForm.CompilatorLog.Lines.Add(LShader.InfoLog);
  1140. finally
  1141. LContext.Deactivate;
  1142. end;
  1143. end
  1144. else
  1145. GLShaderEditorForm.CompilatorLog.Lines.Add
  1146. ('There is no any rendering context for work with OpenGL');
  1147. end;
  1148. procedure TGLShaderEditorProperty.SetStrings(const Value: TStrings);
  1149. begin
  1150. SetOrdValue(Longint(Value));
  1151. end;
  1152. procedure TGLShaderEditorProperty.Edit;
  1153. begin
  1154. with GLShaderEditorForm do
  1155. begin
  1156. OnCheck := OnShaderCheck;
  1157. GLSLMemo.Lines.Assign(GetStrings);
  1158. GLSLMemo.CurX := 0;
  1159. GLSLMemo.CurY := 0;
  1160. if ShowModal = mrOk then
  1161. begin
  1162. SetStrings(GLSLMemo.Lines);
  1163. Modified;
  1164. end;
  1165. end;
  1166. end;
  1167. // ******************************************************
  1168. // Register Properties
  1169. //*******************************************************
  1170. procedure GLSceneRegisterPropertiesInCategories;
  1171. begin
  1172. // property types
  1173. // ScreenDepth in Win32FullScreenViewer
  1174. RegisterPropertiesInCategory(strOpenGLCategoryName,
  1175. [TypeInfo(TGLCamera), TypeInfo(TGLSceneBuffer),
  1176. TypeInfo(TGLVSyncMode), TypeInfo(TGLScreenDepth)]);
  1177. // TGLSceneViewer
  1178. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLSceneViewer, ['*Render']);
  1179. // GLScene
  1180. RegisterPropertiesInCategory(strOpenGLCategoryName,
  1181. [TypeInfo(TGLObjectsSorting), TypeInfo(TGLProgressEvent),
  1182. TypeInfo(TGLBehaviours), TypeInfo(TGLEffects),
  1183. TypeInfo(TGLDirectRenderEvent), TypeInfo(TGLCameraStyle),
  1184. TypeInfo(TOnCustomPerspective), TypeInfo(TGLScene)]);
  1185. RegisterPropertiesInCategory(strLayoutCategoryName,
  1186. [TypeInfo(TGLObjectsSorting), TypeInfo(TGLNormalDirection)]);
  1187. RegisterPropertiesInCategory(strVisualCategoryName,
  1188. [TypeInfo(TGLVisibilityCulling), TypeInfo(TGLLightStyle), TypeInfo(TGLColor),
  1189. TypeInfo(TGLNormalDirection), TypeInfo(TGLCameraStyle)]);
  1190. RegisterPropertiesInCategory(strVisualCategoryName, TGLBaseSceneObject,
  1191. ['Rotation', 'Direction', 'Position', 'Up', 'Scale', '*Angle', 'ShowAxes', 'FocalLength']);
  1192. RegisterPropertiesInCategory(strVisualCategoryName, TGLSceneObject, ['Parts']);
  1193. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLDirectOpenGL, ['UseBuildList']);
  1194. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLProxyObjectOptions)]);
  1195. RegisterPropertiesInCategory(strVisualCategoryName, TGLLightSource, ['*Attenuation', 'Shining', 'Spot*']);
  1196. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLCamera, ['TargetObject']);
  1197. RegisterPropertiesInCategory(strVisualCategoryName, TGLCamera, ['DepthOfView', 'SceneScale']);
  1198. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLNonVisualViewer, ['*Render']);
  1199. // GLObjects
  1200. RegisterPropertiesInCategory(strOpenGLCategoryName,
  1201. [TypeInfo(TGLLinesNodes), TypeInfo(TGLLineNodesAspect),
  1202. TypeInfo(TGLLineSplineMode), TypeInfo(TGLLinesOptions)]);
  1203. // GLDummyCube
  1204. RegisterPropertiesInCategory(strLayoutCategoryName, TGLDummyCube, ['VisibleAtRunTime']);
  1205. RegisterPropertiesInCategory(strVisualCategoryName, TGLDummyCube, ['CubeSize', 'VisibleAtRunTime']);
  1206. RegisterPropertiesInCategory(strVisualCategoryName, TGLPlane, ['*Offset', '*Tiles']);
  1207. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLSprite, ['NoZWrite']);
  1208. RegisterPropertiesInCategory(strLayoutCategoryName, TGLSprite, ['NoZWrite']);
  1209. RegisterPropertiesInCategory(strVisualCategoryName, TGLSprite, ['AlphaChannel', 'Rotation']);
  1210. RegisterPropertiesInCategory(strVisualCategoryName, TGLNode, ['X', 'Y', 'Z']);
  1211. RegisterPropertiesInCategory(strVisualCategoryName, TGLLines,
  1212. ['Antialiased', 'Division', 'Line*', 'NodeSize']);
  1213. RegisterPropertiesInCategory(strVisualCategoryName, TGLCube, ['Cube*']);
  1214. RegisterPropertiesInCategory(strVisualCategoryName, TGLFrustrum, ['ApexHeight', 'Base*']);
  1215. // GLSpaceText
  1216. RegisterPropertiesInCategory(strLayoutCategoryName, [TypeInfo(TGLTextAdjust)]);
  1217. RegisterPropertiesInCategory(strLocalizableCategoryName, [TypeInfo(TGLSpaceTextCharRange)]);
  1218. RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TGLLineSplineMode),
  1219. TypeInfo(TGLCapType), TypeInfo(TGLNormalSmoothing),
  1220. TypeInfo(TGLArrowHeadStyle), TypeInfo(TGLTextAdjust)]);
  1221. RegisterPropertiesInCategory(strVisualCategoryName, TGLSpaceText,
  1222. ['AllowedDeviation', 'AspectRatio', 'Extrusion', 'Oblique', 'TextHeight']);
  1223. RegisterPropertiesInCategory(strVisualCategoryName, TGLSphere,
  1224. ['Bottom', 'Radius', 'Slices', 'Stacks', 'Start', 'Stop']);
  1225. RegisterPropertiesInCategory(strVisualCategoryName, TGLDisk,
  1226. ['*Radius', 'Loops', 'Slices']);
  1227. RegisterPropertiesInCategory(strVisualCategoryName, TGLCone,
  1228. ['BottomRadius', 'Loops', 'Slices', 'Stacks']);
  1229. RegisterPropertiesInCategory(strVisualCategoryName, TGLCylinder,
  1230. ['*Radius', 'Loops', 'Slices', 'Stacks']);
  1231. RegisterPropertiesInCategory(strVisualCategoryName, TGLCapsule,
  1232. ['*Radius', 'Loops', 'Slices', 'Stacks']);
  1233. RegisterPropertiesInCategory(strVisualCategoryName, TGLAnnulus,
  1234. ['Bottom*', 'Loops', 'Slices', 'Stacks', 'Top*']);
  1235. RegisterPropertiesInCategory(strVisualCategoryName, TGLTorus,
  1236. ['*Radius', 'Rings', 'Sides']);
  1237. RegisterPropertiesInCategory(strVisualCategoryName, TGLArrowLine,
  1238. ['Bottom*', 'Loops', 'Slices', 'Stacks', 'Top*']);
  1239. RegisterPropertiesInCategory(strVisualCategoryName, TGLPolygon, ['Division']);
  1240. // GLMultiPolygon
  1241. RegisterPropertiesInCategory(strVisualCategoryName, TGLContour, ['Division']);
  1242. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLContourNodes), TypeInfo(TGLContours)]);
  1243. // GLExtrusion
  1244. RegisterPropertiesInCategory(strVisualCategoryName, TGLExtrusionSolid, ['Stacks']);
  1245. RegisterPropertiesInCategory(strVisualCategoryName, TGLPipeNode, ['RadiusFactor']);
  1246. RegisterPropertiesInCategory(strVisualCategoryName, TGLPipe, ['Division', 'Radius', 'Slices']);
  1247. RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TGLNodes), TypeInfo(TPipeNodesColorMode)]);
  1248. RegisterPropertiesInCategory(strVisualCategoryName, TGLRevolutionSolid, ['Division', 'Slices', 'YOffsetPerTurn']);
  1249. // GLVectorFileObjects
  1250. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLActorAnimationMode), TypeInfo(TGLActorAnimations),
  1251. TypeInfo(TGLMeshAutoCenterings), TypeInfo(TGLActorFrameInterpolation),
  1252. TypeInfo(TGLActorAnimationReference), TypeInfo(TGLActor)]);
  1253. RegisterPropertiesInCategory(strLayoutCategoryName, [TypeInfo(TGLMeshNormalsOrientation)]);
  1254. RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TGLMeshAutoCenterings), TypeInfo(TGLActorAnimationReference),
  1255. TypeInfo(TGLMeshNormalsOrientation)]);
  1256. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLFreeForm, ['UseMeshmaterials']);
  1257. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLAnimationControler, ['AnimationName']);
  1258. RegisterPropertiesInCategory(sLinkageCategoryName, TGLAnimationControler, ['AnimationName']);
  1259. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLActorAnimation, ['*Frame']);
  1260. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLActor,
  1261. ['*Frame*', 'Interval', 'OverlaySkeleton', 'UseMeshmaterials']);
  1262. RegisterPropertiesInCategory(strVisualCategoryName, TGLActor, ['OverlaySkeleton']);
  1263. // GLMesh
  1264. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLMeshMode), TypeInfo(TGLVertexMode)]);
  1265. // GLGraph
  1266. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLHeightFieldOptions)]);
  1267. RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TGLHeightFieldColorMode), TypeInfo(TGLSamplingScale),
  1268. TypeInfo(TGLXYZGridLinesStyle), TypeInfo(TGLXYZGridParts)]);
  1269. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLXYZGrid, ['Antialiased']);
  1270. RegisterPropertiesInCategory(strVisualCategoryName, TGLXYZGrid, ['Antialiased', 'Line*']);
  1271. // GLParticles
  1272. RegisterPropertiesInCategory(strLayoutCategoryName, TGLParticles, ['VisibleAtRunTime']);
  1273. RegisterPropertiesInCategory(strVisualCategoryName, TGLParticles, ['*Size', 'VisibleAtRunTime']);
  1274. // GLSkydome
  1275. RegisterPropertiesInCategory(strOpenGLCategoryName,
  1276. [TypeInfo(TGLSkyDomeBands), TypeInfo(TGLSkyDomeOptions), TypeInfo(TGLSkyDomeStars)]);
  1277. RegisterPropertiesInCategory(strVisualCategoryName, TGLSkyDomeBand, ['Slices', 'Stacks', '*Angle']);
  1278. RegisterPropertiesInCategory(strVisualCategoryName, TGLSkyDomeStar, ['Dec', 'Magnitude', 'RA']);
  1279. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLEarthSkyDome,
  1280. ['Slices', 'Stacks', 'SunElevation', 'Turbidity']);
  1281. // GLMirror
  1282. RegisterPropertiesInCategory(strOpenGLCategoryName,
  1283. [TypeInfo(TGLMirrorOptions), TypeInfo(TGLBaseSceneObject)]);
  1284. // GLParticleFX
  1285. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLBlendingMode)]);
  1286. RegisterPropertiesInCategory(strVisualCategoryName,
  1287. [TypeInfo(TGLBlendingMode), TypeInfo(TPFXLifeColors), TypeInfo(TSpriteColorMode)]);
  1288. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLParticleFXRenderer, ['ZWrite']);
  1289. RegisterPropertiesInCategory(strVisualCategoryName, TGLParticleFXRenderer, ['ZWrite']);
  1290. RegisterPropertiesInCategory(strOpenGLCategoryName, TPFXLifeColor, ['LifeTime']);
  1291. RegisterPropertiesInCategory(strVisualCategoryName, TPFXLifeColor, ['LifeTime']);
  1292. RegisterPropertiesInCategory(strVisualCategoryName, TGLLifeColoredPFXManager, ['Acceleration', 'ParticleSize']);
  1293. RegisterPropertiesInCategory(strVisualCategoryName, TGLPolygonPFXManager, ['NbSides']);
  1294. RegisterPropertiesInCategory(strVisualCategoryName, TGLPointLightPFXManager, ['TexMapSize']);
  1295. // GLTerrainRenderer
  1296. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLHeightDataSource)]);
  1297. RegisterPropertiesInCategory(strVisualCategoryName, TGLTerrainRenderer, ['*CLOD*', 'QualityDistance', 'Tile*']);
  1298. // GLzBuffer
  1299. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLMemoryViewer),
  1300. TypeInfo(TGLSceneViewer), TypeInfo(TOptimise)]);
  1301. RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TOptimise)]);
  1302. RegisterPropertiesInCategory(strVisualCategoryName, TGLZShadows, ['DepthFade', '*Shadow', 'Soft', 'Tolerance']);
  1303. // GLHUDObjects
  1304. RegisterPropertiesInCategory(strLayoutCategoryName, [TypeInfo(TTextLayout)]);
  1305. RegisterPropertiesInCategory(strVisualCategoryName, [TypeInfo(TGLBitmapFont), TypeInfo(TTextLayout)]);
  1306. RegisterPropertiesInCategory(strLocalizableCategoryName,[TypeInfo(TGLBitmapFont)]);
  1307. // GLTexture
  1308. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLMaterial), TypeInfo(TGLMaterialLibrary),
  1309. TypeInfo(TGLLibMaterials), TypeInfo(TGLTextureNeededEvent)]);
  1310. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLLibMaterial, ['Texture2Name']);
  1311. RegisterPropertiesInCategory(strVisualCategoryName, TGLLibMaterial, ['TextureOffset', 'TextureScale']);
  1312. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLMaterialLibrary, ['TexturePaths']);
  1313. // GLCadencer
  1314. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLCadencer)]);
  1315. // GLCollision
  1316. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TObjectCollisionEvent)]);
  1317. // GLFireFX
  1318. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLFireFXManager,
  1319. ['MaxParticles', 'NoZWrite', 'Paused', 'UseInterval']);
  1320. RegisterPropertiesInCategory(strVisualCategoryName, TGLFireFXManager,
  1321. ['Fire*', 'InitialDir', 'NoZWrite', 'Particle*', 'Paused']);
  1322. // GLThorFX
  1323. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TCalcPointEvent)]);
  1324. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLThorFXManager,
  1325. ['Maxpoints', 'Paused']);
  1326. RegisterPropertiesInCategory(strVisualCategoryName, TGLThorFXManager,
  1327. ['Core', 'Glow*', 'Paused', 'Target', 'Vibrate', 'Wildness']);
  1328. // GLBitmapFont
  1329. RegisterPropertiesInCategory(strOpenGLCategoryName, [TypeInfo(TGLMagFilter), TypeInfo(TGLMinFilter)]);
  1330. RegisterPropertiesInCategory(strLocalizableCategoryName, [TypeInfo(TGLBitmapFontRanges)]);
  1331. RegisterPropertiesInCategory(strLocalizableCategoryName, TGLBitmapFontRange, ['*ASCII']);
  1332. RegisterPropertiesInCategory(strLayoutCategoryName, TGLBitmapFont, ['Char*', '*Interval*', '*Space']);
  1333. RegisterPropertiesInCategory(strLocalizableCategoryName, TGLBitmapFont, ['Glyphs']);
  1334. RegisterPropertiesInCategory(strVisualCategoryName, TGLBitmapFont,
  1335. ['Char*', '*Interval*', '*Space', 'Glyphs']);
  1336. // GLHeightData
  1337. RegisterPropertiesInCategory(strOpenGLCategoryName, TGLBitmapHDS, ['MaxPoolSize']);
  1338. RegisterPropertiesInCategory(strVisualCategoryName, TGLBitmapHDS, ['Picture']);
  1339. end;
  1340. // ******************************************************
  1341. // Register Components
  1342. //*******************************************************
  1343. procedure Register;
  1344. begin
  1345. RegisterComponents('GLScene', [TGLScene, TGLSceneViewer, TGLMemoryViewer,
  1346. TGLMaterialLibrary, TGLMaterialLibraryEx, TGLCadencer, TGLGuiLayout,
  1347. TGLBitmapFont, TGLWindowsBitmapFont, TGLScriptLibrary, TGLSoundLibrary,
  1348. TGLFullScreenViewer]);
  1349. RegisterComponents('GLScene PFX',
  1350. [TGLCustomPFXManager, TGLPolygonPFXManager,
  1351. TGLPointLightPFXManager, TGLCustomSpritePFXManager, TGLPerlinPFXManager,
  1352. TGLLinePFXManager, TGLFireFXManager, TGLThorFXManager,
  1353. TGLEParticleMasksManager]);
  1354. RegisterComponents('GLScene Utils', [TGLAsyncTimer, TGLStaticImposterBuilder,
  1355. TGLCollisionManager, TGLAnimationControler, TGLAVIRecorder, TGLDCEManager,
  1356. TGLFPSMovementManager, TGLMaterialScripter, TGLUserInterface, TGLNavigator,
  1357. TGLSmoothNavigator, TGLSmoothUserInterface, TGLTimeEventsMGR,
  1358. TGLApplicationFileIO, TGLVfsPAK, TGLSimpleNavigation, TGLGizmo,
  1359. TGLCameraController, TGLSLanguage, TGLSLogger, TGLSArchiveManager,
  1360. TGLJoystick, TGLScreenSaver, TGLSSynHiMemo]);
  1361. RegisterComponents('GLScene Terrain', [TGLBitmapHDS, TGLCustomHDS,
  1362. TGLHeightTileFileHDS, TGLBumpmapHDS, TGLPerlinHDS, TGLTexturedHDS,
  1363. TGLAsyncHDS, TGLShadowHDS]);
  1364. RegisterComponents('GLScene Shaders', [TGLTexCombineShader, TGLPhongShader,
  1365. TGLUserShader, TGLHiddenLineShader, TGLCelShader, TGLOutlineShader,
  1366. TGLMultiMaterialShader, TGLBumpShader, TGLSLShader,
  1367. TGLSLDiffuseSpecularShader, TGLSLBumpShader, TGLAsmShader,
  1368. TGLShaderCombiner, TGLTextureSharingShader, TGLSLPostBlurShader,
  1369. TGLSLPostThermalVisionShader, TGLSLPostDreamVisionShader, TGLSLPostNightVisionShader,
  1370. TGLSLPostPixelateShader, TGLSLPostPosterizeShader, TGLSLPostFrostShader,
  1371. TGLSLPostTroubleShader]);
  1372. RegisterComponentEditor(TGLSceneViewer, TGLSceneViewerEditor);
  1373. RegisterComponentEditor(TGLScene, TGLSceneEditor);
  1374. RegisterComponentEditor(TGLMaterialLibrary, TGLMaterialLibraryEditor);
  1375. RegisterComponentEditor(TGLMaterialLibraryEx, TGLMaterialLibraryEditor);
  1376. RegisterComponentEditor(TGLSArchiveManager, TGLSArchiveManagerEditor);
  1377. GLSceneRegisterPropertiesInCategories;
  1378. RegisterPropertyEditor(TypeInfo(TResolution), nil, '', TGLResolutionProperty);
  1379. RegisterPropertyEditor(TypeInfo(TGLTexture), TGLMaterial, '', TGLTextureProperty);
  1380. RegisterPropertyEditor(TypeInfo(TGLTextureImage), TGLTexture, '', TGLTextureImageProperty);
  1381. RegisterPropertyEditor(TypeInfo(string), TGLTexture, 'ImageClassName', TGLImageClassProperty);
  1382. RegisterPropertyEditor(TypeInfo(TGLSoundFile), TGLSoundSample, '', TGLSoundFileProperty);
  1383. RegisterPropertyEditor(TypeInfo(string), TGLBaseSoundSource, 'SoundName', TGLSoundNameProperty);
  1384. RegisterPropertyEditor(TypeInfo(TGLCoordinates), nil, '', TGLCoordinatesProperty);
  1385. RegisterPropertyEditor(TypeInfo(TGLColor), nil, '', TGLColorProperty);
  1386. RegisterPropertyEditor(TypeInfo(TGLMaterial), nil, '', TGLMaterialProperty);
  1387. RegisterComponentEditor(TGLGuiLayout, TGLGUILayoutEditor);
  1388. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLMaterial, '', TGLLibMaterialNameProperty);
  1389. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLLibMaterial, 'Texture2Name', TGLLibMaterialNameProperty);
  1390. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLSkyBox, '', TGLLibMaterialNameProperty);
  1391. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLEParticleMask, '', TGLLibMaterialNameProperty);
  1392. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLGameMenu, '', TGLLibMaterialNameProperty);
  1393. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLMaterialMultiProxyMaster, '', TGLLibMaterialNameProperty);
  1394. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLSLBumpShader, '', TGLLibMaterialNameProperty);
  1395. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLSpriteAnimation, '', TGLLibMaterialNameProperty);
  1396. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLMaterialProxy, '', TGLLibMaterialNameProperty);
  1397. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLActorProxy, '', TGLLibMaterialNameProperty);
  1398. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLFBORenderer, '', TGLLibMaterialNameProperty);
  1399. RegisterPropertyEditor(TypeInfo(TGLActorAnimationName), TGLAnimationControler, '', TGLAnimationNameProperty);
  1400. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLTextureSharingShaderMaterial, 'LibMaterialName',
  1401. TGLLibMaterialNameProperty);
  1402. RegisterSelectionEditor(TGLBaseSceneObject, TGLBaseSceneObjectSelectionEditor);
  1403. RegisterSelectionEditor(TGLSoundLibrary, TGLSoundLibrarySelectionEditor);
  1404. RegisterPropertyEditor(TypeInfo(TGLLibMaterialName), TGLLibMaterialProperty,
  1405. 'NextPass', TGLLibMaterialNameProperty);
  1406. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName),
  1407. TGLTextureProperties, 'LibTextureName', TGLLibTextureNameProperty);
  1408. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName),
  1409. TGLTextureProperties, 'LibSamplerName', TGLLibSamplerNameProperty);
  1410. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName),
  1411. TGLMultitexturingProperties, 'LibCombinerName', TGLLibCombinerNameProperty);
  1412. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName),
  1413. TGLMultitexturingProperties, 'LibAsmProgName', TGLLibAsmProgNameProperty);
  1414. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel3,
  1415. 'LibVertexShaderName', TGLLibShaderNameProperty);
  1416. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel3,
  1417. 'LibFragmentShaderName', TGLLibShaderNameProperty);
  1418. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel4,
  1419. 'LibVertexShaderName', TGLLibShaderNameProperty);
  1420. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel4,
  1421. 'LibFragmentShaderName', TGLLibShaderNameProperty);
  1422. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel4,
  1423. 'LibGeometryShaderName', TGLLibShaderNameProperty);
  1424. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel5,
  1425. 'LibVertexShaderName', TGLLibShaderNameProperty);
  1426. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel5,
  1427. 'LibFragmentShaderName', TGLLibShaderNameProperty);
  1428. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel5,
  1429. 'LibGeometryShaderName', TGLLibShaderNameProperty);
  1430. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel5,
  1431. 'LibTessControlShaderName', TGLLibShaderNameProperty);
  1432. RegisterPropertyEditor(TypeInfo(TGLMaterialComponentName), TGLShaderModel5,
  1433. 'LibTessEvalShaderName', TGLLibShaderNameProperty);
  1434. RegisterPropertyEditor(TypeInfo(string), TGLTextureImageEx, 'SourceFile', TPictureFileProperty);
  1435. RegisterPropertyEditor(TypeInfo(string), TGLShaderEx, 'SourceFile', TShaderFileProperty);
  1436. RegisterPropertyEditor(TypeInfo(string), TGLASMVertexProgram, 'SourceFile', TAsmProgFileProperty);
  1437. RegisterPropertyEditor(TypeInfo(Boolean), TGLBaseShaderModel, 'AutoFillOfUniforms', TUniformAutoSetProperty);
  1438. RegisterPropertyEditor(TypeInfo(TStringList), TGLShaderEx, 'Source', TGLShaderEditorProperty);
  1439. end;
  1440. function GetGLSceneVersion: string;
  1441. var
  1442. LProject: IOTAProject;
  1443. LExePath, LProjectPath, LSVN, LRevision: string;
  1444. begin
  1445. LRevision := Copy(GLSCENE_REVISION, 20, 5);
  1446. // will be assigned after project compilation
  1447. // after each compilation get it from file \.svn\entries in 4-th line
  1448. // and write to file GLSceneRevision
  1449. // in both fail (no \.svn\entries or GLSceneRevision file) get a version value from GLScene.pas
  1450. LProject := GetActiveProject;
  1451. LExePath := ExtractFilePath(ParamStr(0));
  1452. if Assigned(LProject) then
  1453. begin
  1454. LProjectPath := ExtractFilePath(LProject.FileName);
  1455. LSVN := LProjectPath + '.svn\entries';
  1456. if FileExists(LSVN) then
  1457. with TStringList.Create do
  1458. try
  1459. // Load
  1460. LoadFromFile(LSVN);
  1461. if (Count >= 4) and (Trim(Strings[3]) <> '') and
  1462. IsDirectoryWriteable(LExePath) then
  1463. begin
  1464. LRevision := Trim(Strings[3]);
  1465. // Save
  1466. Clear;
  1467. Add(LRevision);
  1468. SaveToFile(LExePath + 'GLSceneRevision');
  1469. end;
  1470. finally
  1471. Free;
  1472. end;
  1473. end
  1474. else if FileExists(LExePath + 'GLSceneRevision') then
  1475. try
  1476. with TStringList.Create do
  1477. try
  1478. LoadFromFile(LExePath + 'GLSceneRevision');
  1479. if (Count >= 1) and (Trim(Strings[0]) <> '') then
  1480. LRevision := Trim(Strings[0]);
  1481. finally
  1482. Free;
  1483. end;
  1484. except
  1485. end;
  1486. // Finally
  1487. Result := Format(GLSCENE_VERSION, [LRevision]);
  1488. end;
  1489. function GetProjectTargetName: string;
  1490. var
  1491. Project: IOTAProject;
  1492. begin
  1493. Result := '';
  1494. Project := GetActiveProject;
  1495. if Assigned(Project) then
  1496. begin
  1497. Result := Project.ProjectOptions.TargetName;
  1498. if Length(Result) > 0 then
  1499. ForceDirectories(ExtractFilePath(Result));
  1500. end;
  1501. end;
  1502. // ------------------------------------------------------------------
  1503. initialization
  1504. // ------------------------------------------------------------------
  1505. SplashScreenServices.AddPluginBitmap(GetGLSceneVersion, LoadBitmap(HInstance, 'TGLScene'),
  1506. False, 'MPL 2.0 license', 'VCL version');
  1507. GLS.Utils.IsDesignTime := True;
  1508. GLS.Utils.vProjectTargetName := GetProjectTargetName;
  1509. GLS.Color.vUseDefaultColorSets := True;
  1510. GLS.Coordinates.vUseDefaultCoordinateSets := True;
  1511. ReadVideoModes;
  1512. with ObjectManager do
  1513. begin
  1514. CreateDefaultObjectIcons(HInstance);
  1515. RegisterSceneObject(TGLCamera, 'Camera', '', HInstance);
  1516. RegisterSceneObject(TGLLightSource, 'LightSource', '', HInstance);
  1517. RegisterSceneObject(TGLDummyCube, 'DummyCube', '', HInstance);
  1518. // Basic geometry
  1519. RegisterSceneObject(TGLSprite, 'Sprite', strOCBasicGeometry, HInstance);
  1520. RegisterSceneObject(TGLPoints, 'Points', strOCBasicGeometry, HInstance);
  1521. RegisterSceneObject(TGLLines, 'Lines', strOCBasicGeometry, HInstance);
  1522. RegisterSceneObject(TGLPlane, 'Plane', strOCBasicGeometry, HInstance);
  1523. RegisterSceneObject(TGLPolygon, 'Polygon', strOCBasicGeometry, HInstance);
  1524. RegisterSceneObject(TGLCube, 'Cube', strOCBasicGeometry, HInstance);
  1525. RegisterSceneObject(TGLFrustrum, 'Frustrum', strOCBasicGeometry, HInstance);
  1526. RegisterSceneObject(TGLSphere, 'Sphere', strOCBasicGeometry, HInstance);
  1527. RegisterSceneObject(TGLDisk, 'Disk', strOCBasicGeometry, HInstance);
  1528. RegisterSceneObject(TGLCone, 'Cone', strOCBasicGeometry, HInstance);
  1529. RegisterSceneObject(TGLCylinder, 'Cylinder', strOCBasicGeometry, HInstance);
  1530. RegisterSceneObject(TGLCapsule, 'Capsule', strOCBasicGeometry, HInstance);
  1531. RegisterSceneObject(TGLDodecahedron, 'Dodecahedron', strOCBasicGeometry, HInstance);
  1532. RegisterSceneObject(TGLIcosahedron, 'Icosahedron', strOCBasicGeometry, HInstance);
  1533. RegisterSceneObject(TGLHexahedron, 'Hexahedron', strOCBasicGeometry, HInstance);
  1534. RegisterSceneObject(TGLOctahedron, 'Octahedron', strOCBasicGeometry, HInstance);
  1535. RegisterSceneObject(TGLTetrahedron, 'Tetrahedron', strOCBasicGeometry, HInstance);
  1536. RegisterSceneObject(TGLSuperellipsoid, 'Superellipsoid', strOCBasicGeometry, HInstance);
  1537. // Advanced geometry
  1538. RegisterSceneObject(TGLAnimatedSprite, 'Animated Sprite', strOCAdvancedGeometry, HInstance);
  1539. RegisterSceneObject(TGLArrowLine, 'ArrowLine', strOCAdvancedGeometry, HInstance);
  1540. RegisterSceneObject(TGLArrowArc, 'ArrowArc', strOCAdvancedGeometry, HInstance);
  1541. RegisterSceneObject(TGLAnnulus, 'Annulus', strOCAdvancedGeometry, HInstance);
  1542. RegisterSceneObject(TGLExtrusionSolid, 'ExtrusionSolid', strOCAdvancedGeometry, HInstance);
  1543. RegisterSceneObject(TGLMultiPolygon, 'MultiPolygon', strOCAdvancedGeometry, HInstance);
  1544. RegisterSceneObject(TGLPipe, 'Pipe', strOCAdvancedGeometry, HInstance);
  1545. RegisterSceneObject(TGLRevolutionSolid, 'RevolutionSolid', strOCAdvancedGeometry, HInstance);
  1546. RegisterSceneObject(TGLTorus, 'Torus', strOCAdvancedGeometry, HInstance);
  1547. // Mesh objects
  1548. RegisterSceneObject(TGLActor, 'Actor', strOCMeshObjects, HInstance);
  1549. RegisterSceneObject(TGLFreeForm, 'FreeForm', strOCMeshObjects, HInstance);
  1550. RegisterSceneObject(TGLMesh, 'Mesh', strOCMeshObjects, HInstance);
  1551. RegisterSceneObject(TGLTilePlane, 'TilePlane', strOCMeshObjects, HInstance);
  1552. RegisterSceneObject(TGLPortal, 'Portal', strOCMeshObjects, HInstance);
  1553. RegisterSceneObject(TGLTerrainRenderer, 'TerrainRenderer', strOCMeshObjects, HInstance);
  1554. // Graph-plotting objects
  1555. RegisterSceneObject(TGLFlatText, 'FlatText', strOCGraphPlottingObjects, HInstance);
  1556. RegisterSceneObject(TGLHeightField, 'HeightField', strOCGraphPlottingObjects, HInstance);
  1557. RegisterSceneObject(TGLXYZGrid, 'XYZGrid', strOCGraphPlottingObjects, HInstance);
  1558. // Particle systems
  1559. RegisterSceneObject(TGLParticles, 'Particles', strOCParticleSystems, HInstance);
  1560. RegisterSceneObject(TGLParticleFXRenderer, 'PFX Renderer', strOCParticleSystems, HInstance);
  1561. // Environment objects
  1562. RegisterSceneObject(TGLEarthSkyDome, 'EarthSkyDome', strOCEnvironmentObjects, HInstance);
  1563. RegisterSceneObject(TGLSkyDome, 'SkyDome', strOCEnvironmentObjects, HInstance);
  1564. RegisterSceneObject(TGLSkyBox, 'SkyBox', strOCEnvironmentObjects, HInstance);
  1565. RegisterSceneObject(TGLAtmosphere, 'Atmosphere', strOCEnvironmentObjects, HInstance);
  1566. // HUD objects.
  1567. RegisterSceneObject(TGLHUDSprite, 'HUD Sprite', strOCHUDObjects, HInstance);
  1568. RegisterSceneObject(TGLHUDText, 'HUD Text', strOCHUDObjects, HInstance);
  1569. RegisterSceneObject(TGLResolutionIndependantHUDText,
  1570. 'Resolution Independant HUD Text', strOCHUDObjects, HInstance);
  1571. RegisterSceneObject(TGLAbsoluteHUDText, 'Absolute HUD Text', strOCHUDObjects, HInstance);
  1572. RegisterSceneObject(TGLGameMenu, 'GameMenu', strOCHUDObjects, HInstance);
  1573. RegisterSceneObject(TGLConsole, 'Console', strOCHUDObjects, HInstance);
  1574. // GUI objects.
  1575. RegisterSceneObject(TGLBaseControl, 'Root Control', strOCGuiObjects, HInstance);
  1576. RegisterSceneObject(TGLPopupMenu, 'GLPopupMenu', strOCGuiObjects, HInstance);
  1577. RegisterSceneObject(TGLForm, 'GLForm', strOCGuiObjects, HInstance);
  1578. RegisterSceneObject(TGLPanel, 'GLPanel', strOCGuiObjects, HInstance);
  1579. RegisterSceneObject(TGLButton, 'GLButton', strOCGuiObjects, HInstance);
  1580. RegisterSceneObject(TGLCheckBox, 'GLCheckBox', strOCGuiObjects, HInstance);
  1581. RegisterSceneObject(TGLEdit, 'GLEdit', strOCGuiObjects, HInstance);
  1582. RegisterSceneObject(TGLLabel, 'GLLabel', strOCGuiObjects, HInstance);
  1583. RegisterSceneObject(TGLAdvancedLabel, 'GLAdvancedLabel', strOCGuiObjects, HInstance);
  1584. RegisterSceneObject(TGLScrollbar, 'GLScrollbar', strOCGuiObjects, HInstance);
  1585. RegisterSceneObject(TGLStringGrid, 'GLStringGrid', strOCGuiObjects, HInstance);
  1586. RegisterSceneObject(TGLCustomControl, 'GLBitmapControl', strOCGuiObjects, HInstance);
  1587. // Special objects
  1588. RegisterSceneObject(TGLLensFlare, 'LensFlare', strOCSpecialObjects, HInstance);
  1589. RegisterSceneObject(TGLTextureLensFlare, 'TextureLensFlare', strOCSpecialObjects, HInstance);
  1590. RegisterSceneObject(TGLMirror, 'Mirror', strOCSpecialObjects, HInstance);
  1591. RegisterSceneObject(TGLShadowPlane, 'ShadowPlane', strOCSpecialObjects, HInstance);
  1592. RegisterSceneObject(TGLShadowVolume, 'ShadowVolume', strOCSpecialObjects, HInstance);
  1593. RegisterSceneObject(TGLZShadows, 'ZShadows', strOCSpecialObjects, HInstance);
  1594. // Texture objects
  1595. RegisterSceneObject(TGLSLTextureEmitter, 'GLSL Texture Emitter', strOCSpecialObjects, HInstance);
  1596. RegisterSceneObject(TGLSLProjectedTextures, 'GLSL Projected Textures', strOCSpecialObjects, HInstance);
  1597. RegisterSceneObject(TGLTextureEmitter, 'Texture Emitter', strOCSpecialObjects, HInstance);
  1598. RegisterSceneObject(TGLProjectedTextures, 'Projected Textures', strOCSpecialObjects, HInstance);
  1599. RegisterSceneObject(TGLBlur, 'Blur', strOCSpecialObjects, HInstance);
  1600. RegisterSceneObject(TGLMotionBlur, 'MotionBlur', strOCSpecialObjects, HInstance);
  1601. RegisterSceneObject(TGLSpaceText, 'SpaceText', strOCDoodad, HInstance);
  1602. RegisterSceneObject(TGLTrail, 'GLTrail', strOCSpecialObjects, HInstance);
  1603. RegisterSceneObject(TGLPostEffect, 'PostEffect', strOCSpecialObjects, HInstance);
  1604. RegisterSceneObject(TGLPostShaderHolder, 'PostShaderHolder', strOCSpecialObjects, HInstance);
  1605. // Doodad objects.
  1606. RegisterSceneObject(TGLTeapot, 'Teapot', strOCDoodad, HInstance);
  1607. RegisterSceneObject(TGLTree, 'Tree', strOCDoodad, HInstance);
  1608. RegisterSceneObject(TGLWaterPlane, 'WaterPlane', strOCDoodad, HInstance);
  1609. // Proxy objects.
  1610. RegisterSceneObject(TGLProxyObject, 'ProxyObject', strOCProxyObjects, HInstance);
  1611. RegisterSceneObject(TGLColorProxy, 'ColorProxy', strOCProxyObjects, HInstance);
  1612. RegisterSceneObject(TGLFreeFormProxy, 'FreeFormProxy', strOCProxyObjects, HInstance);
  1613. RegisterSceneObject(TGLMaterialProxy, 'MaterialProxy', strOCProxyObjects, HInstance);
  1614. RegisterSceneObject(TGLActorProxy, 'ActorProxy', strOCProxyObjects, HInstance);
  1615. RegisterSceneObject(TGLMultiProxy, 'MultiProxy', strOCProxyObjects, HInstance);
  1616. RegisterSceneObject(TGLMaterialMultiProxy, 'MaterialMultiProxy', strOCProxyObjects, HInstance);
  1617. // Other objects.
  1618. RegisterSceneObject(TGLDirectOpenGL, 'Direct OpenGL', '', HInstance);
  1619. RegisterSceneObject(TGLRenderPoint, 'Render Point', '', HInstance);
  1620. RegisterSceneObject(TGLImposter, 'Imposter Sprite', '', HInstance);
  1621. RegisterSceneObject(TGLFeedback, 'OpenGL Feedback', '', HInstance);
  1622. RegisterSceneObject(TGLFBORenderer, 'OpenGL FrameBuffer', '', HInstance);
  1623. end;
  1624. //------------------------------------------------------
  1625. finalization
  1626. //------------------------------------------------------
  1627. ObjectManager.Free;
  1628. end.