2
0

fGameMenuD.pas 3.6 KB

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