GLS.SceneRegister.pas 61 KB

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