fGameMenuD.pas 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148
  1. unit fGameMenuD;
  2. interface
  3. uses
  4. Winapi.Windows,
  5. Winapi.OpenGL,
  6. System.SysUtils,
  7. System.Classes,
  8. Vcl.Graphics,
  9. Vcl.Controls,
  10. Vcl.Forms,
  11. Vcl.ExtCtrls,
  12. Vcl.Dialogs,
  13. Vcl.StdCtrls,
  14. Vcl.Imaging.Jpeg,
  15. Stage.VectorTypes,
  16. Stage.Keyboard,
  17. Stage.Utils,
  18. GLS.Scene,
  19. GLS.Objects,
  20. GLS.SceneViewer,
  21. GLS.GeomObjects,
  22. GLS.BitmapFont,
  23. GLS.WindowsFont,
  24. GLS.GameMenu,
  25. GLS.Cadencer,
  26. GLS.Texture,
  27. GLS.XCollection,
  28. GLS.Material,
  29. GLS.Coordinates,
  30. GLS.BaseClasses;
  31. type
  32. TFormGameMenu = class(TForm)
  33. GLScene1: TGLScene;
  34. GLSceneViewer1: TGLSceneViewer;
  35. GLCamera1: TGLCamera;
  36. GLDummyCube1: TGLDummyCube;
  37. GLLightSource1: TGLLightSource;
  38. GLWindowsBitmapFont1: TGLWindowsBitmapFont;
  39. GLCadencer1: TGLCadencer;
  40. GLMaterialLibrary1: TGLMaterialLibrary;
  41. GLCube1: TGLCube;
  42. MainPanel: TPanel;
  43. ShowTitleCheckbox: TCheckBox;
  44. Label1: TLabel;
  45. procedure FormCreate(Sender: TObject);
  46. procedure FormKeyPress(Sender: TObject; var Key: Char);
  47. procedure GLCadencer1Progress(Sender: TObject; const deltaTime,
  48. newTime: Double);
  49. procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
  50. X, Y: Integer);
  51. procedure GLSceneViewer1MouseDown(Sender: TObject;
  52. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  53. procedure ShowTitleCheckboxClick(Sender: TObject);
  54. procedure MainPanelResize(Sender: TObject);
  55. private
  56. public
  57. GameMenu: TGLGameMenu;
  58. end;
  59. var
  60. FormGameMenu: TFormGameMenu;
  61. sMessage: String = 'You have selected the item ';
  62. sMenu: String = 'menu line ';
  63. implementation
  64. {$R *.dfm}
  65. procedure TFormGameMenu.FormCreate(Sender: TObject);
  66. begin
  67. var Path: TFileName := GetCurrentAssetPath();
  68. SetCurrentDir(Path + '\texture');
  69. GLMaterialLibrary1.Materials[0].Material.Texture.Image.LoadFromFile('GLScene.bmp');
  70. GameMenu := TGLGameMenu(GLScene1.Objects.AddNewChild(TGLGameMenu));
  71. GameMenu.MaterialLibrary := GLMaterialLibrary1;
  72. GameMenu.TitleMaterialName := 'LibMaterial';
  73. GameMenu.TitleHeight := 80;
  74. GameMenu.TitleWidth := 200;
  75. GameMenu.Font := GLWindowsBitmapFont1;
  76. GameMenu.Items.Add(sMenu+'1');
  77. GameMenu.Items.Add(sMenu+'2');
  78. GameMenu.Items.Add(sMenu+'3');
  79. GameMenu.Items.Add(sMenu+'4');
  80. GameMenu.Items.Add(sMenu+'5');
  81. GameMenu.Items.Add(sMenu+'6');
  82. GameMenu.Spacing := 1;
  83. GameMenu.Selected := 0;
  84. GameMenu.Position.Y := 200;
  85. end;
  86. procedure TFormGameMenu.FormKeyPress(Sender: TObject; var Key: Char);
  87. begin
  88. if IsKeyDown('W') then GameMenu.SelectPrev;
  89. // if IsKeyDown(VK_UP) then GameMenu.SelectPrev;
  90. if IsKeyDown('S') then GameMenu.SelectNext;
  91. // if IsKeyDown(VK_DOWN) then GameMenu.SelectNext;
  92. if IsKeyDown(VK_RETURN) then
  93. begin
  94. if GameMenu.Selected <> -1 then
  95. ShowMessage(sMessage + '"'+GameMenu.SelectedText+ '"');
  96. end;
  97. end;
  98. procedure TFormGameMenu.GLCadencer1Progress(Sender: TObject; const deltaTime,
  99. newTime: Double);
  100. begin
  101. GLSceneViewer1.Invalidate;
  102. end;
  103. procedure TFormGameMenu.GLSceneViewer1MouseMove(Sender: TObject;
  104. Shift: TShiftState; X, Y: Integer);
  105. begin
  106. GameMenu.MouseMenuSelect(X, Y);
  107. end;
  108. procedure TFormGameMenu.GLSceneViewer1MouseDown(Sender: TObject;
  109. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  110. begin
  111. GameMenu.MouseMenuSelect(X, Y);
  112. if GameMenu.Selected <> -1 then
  113. ShowMessage(sMessage + '"'+GameMenu.SelectedText+'"');
  114. end;
  115. procedure TFormGameMenu.ShowTitleCheckboxClick(Sender: TObject);
  116. begin
  117. if GameMenu.TitleHeight = 0 then
  118. GameMenu.TitleHeight := 80
  119. else
  120. GameMenu.TitleHeight := 0;
  121. end;
  122. procedure TFormGameMenu.MainPanelResize(Sender: TObject);
  123. begin
  124. GameMenu.Position.X := MainPanel.Width div 2;
  125. end;
  126. end.