fMultiTextureD.pas 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115
  1. unit fMultiTextureD;
  2. interface
  3. uses
  4. Winapi.OpenGL,
  5. System.SysUtils,
  6. System.Classes,
  7. Vcl.Graphics,
  8. Vcl.Controls,
  9. Vcl.Forms,
  10. Vcl.Dialogs,
  11. Vcl.ComCtrls,
  12. Vcl.StdCtrls,
  13. Vcl.ExtCtrls,
  14. Vcl.ExtDlgs,
  15. Vcl.Imaging.Jpeg,
  16. GLS.Scene,
  17. GLScene.VectorTypes,
  18. GLS.Objects,
  19. GLS.Texture,
  20. GLS.SceneViewer,
  21. GLS.Material,
  22. GLS.Coordinates,
  23. GLS.BaseClasses,
  24. GLScene.Utils;
  25. type
  26. TFormMultiTexture = class(TForm)
  27. GLScene1: TGLScene;
  28. GLSceneViewer1: TGLSceneViewer;
  29. Plane1: TGLPlane;
  30. GLCamera1: TGLCamera;
  31. GLMaterialLibrary1: TGLMaterialLibrary;
  32. Image1: TImage;
  33. Image2: TImage;
  34. Label1: TLabel;
  35. Label2: TLabel;
  36. Label3: TLabel;
  37. TrackBar1: TTrackBar;
  38. Label4: TLabel;
  39. OpenPictureDialog1: TOpenPictureDialog;
  40. CBClampTex2: TCheckBox;
  41. procedure FormCreate(Sender: TObject);
  42. procedure Image1Click(Sender: TObject);
  43. procedure Image2Click(Sender: TObject);
  44. procedure TrackBar1Change(Sender: TObject);
  45. procedure CBClampTex2Click(Sender: TObject);
  46. private
  47. public
  48. end;
  49. var
  50. FormMultiTexture: TFormMultiTexture;
  51. implementation
  52. {$R *.DFM}
  53. procedure TFormMultiTexture.FormCreate(Sender: TObject);
  54. begin
  55. var Path: TFileName := GetCurrentAssetPath();
  56. SetCurrentDir(Path + '\texture');
  57. // prepare images to merge in the multitexture
  58. with GLMaterialLibrary1 do begin
  59. Image1.Picture.LoadFromFile('ashwood.jpg');
  60. Materials[0].Material.Texture.Image.Assign(Image1.Picture);
  61. Image2.Picture.LoadFromFile('Flare1.bmp');
  62. Materials[1].Material.Texture.Image.Assign(Image2.Picture);
  63. end;
  64. end;
  65. procedure TFormMultiTexture.Image1Click(Sender: TObject);
  66. begin
  67. // load a new Image1
  68. if OpenPictureDialog1.Execute then
  69. begin
  70. Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
  71. GLMaterialLibrary1.Materials[0].Material.Texture.Image.Assign(Image1.Picture);
  72. end;
  73. end;
  74. procedure TFormMultiTexture.Image2Click(Sender: TObject);
  75. begin
  76. // load a new Image2
  77. if OpenPictureDialog1.Execute then
  78. begin
  79. Image2.Picture.LoadFromFile(OpenPictureDialog1.FileName);
  80. GLMaterialLibrary1.Materials[1].Material.Texture.Image.Assign(Image2.Picture);
  81. end;
  82. end;
  83. procedure TFormMultiTexture.TrackBar1Change(Sender: TObject);
  84. begin
  85. // adjust scale
  86. with GLMaterialLibrary1.Materials[1].TextureScale do
  87. begin
  88. X:=TrackBar1.Position/10;
  89. Y:=TrackBar1.Position/10;
  90. end;
  91. end;
  92. procedure TFormMultiTexture.CBClampTex2Click(Sender: TObject);
  93. begin
  94. with GLMaterialLibrary1.Materials[1].Material.Texture do
  95. if CBClampTex2.Checked then
  96. TextureWrap:=twNone
  97. else TextureWrap:=twBoth;
  98. end;
  99. end.