SDL2_Frame.pas 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124
  1. (*
  2. ================================================================================
  3. == ==
  4. == ATTENTION: DO NOT LOAD ALL GRAPHICS ON CREATE OR ON SHOW BECAUSE THE ==
  5. == COMPONENT SDL2FRAME IS NOT YET COMPLETED ==
  6. == ==
  7. ================================================================================
  8. *)
  9. unit SDL2_Frame;
  10. interface
  11. uses
  12. Winapi.Windows,
  13. Vcl.Dialogs,
  14. System.SysUtils,
  15. System.Classes,
  16. Vcl.Controls,
  17. Vcl.ExtCtrls,
  18. SDL2;
  19. type
  20. TSDL2Frame = class(TPanel)
  21. private
  22. FSDLPantalla: PSDLPantalla;
  23. FFlags: UInt32;
  24. FRenderInfo: PSDL_RendererInfo;
  25. protected
  26. procedure CreateWnd; override;
  27. procedure DestroyWnd; override;
  28. public
  29. procedure Finalize;
  30. property SDLPantalla: PSDLPantalla read FSDLPantalla;
  31. published
  32. property Flags: UInt32 read FFlags write FFlags;
  33. end;
  34. procedure Register;
  35. //------------------------------------
  36. implementation
  37. //------------------------------------
  38. uses
  39. forms;
  40. // ******************************************************************************
  41. procedure Register;
  42. begin
  43. RegisterComponents('SDL2', [TSDL2Frame]);
  44. end;
  45. // ******************************************************************************
  46. procedure TSDL2Frame.CreateWnd;
  47. begin
  48. inherited;
  49. if SDL_WasInit(SDL_INIT_VIDEO) <> SDL_INIT_VIDEO then
  50. SDL_InitSubSystem(SDL_INIT_VIDEO);
  51. New(FSDLPantalla);
  52. FSDLPantalla.Window := SDL_CreateWindowFrom(Pointer(WindowHandle));
  53. if FSDLPantalla.Window <> nil then
  54. begin
  55. FSDLPantalla.Renderer := SDL_CreateRenderer(FSDLPantalla.Window, -1, 0);
  56. // no forzamos ningún tipo de render (0) para que el sistema coja el que pueda Hard-Soft
  57. if FSDLPantalla.Renderer <> nil then
  58. begin
  59. New(FRenderInfo);
  60. if SDL_GetRendererInfo(FSDLPantalla.Renderer, FRenderInfo) = 0 then
  61. begin
  62. FSDLPantalla.max_texture_width := FRenderInfo.max_texture_width;
  63. FSDLPantalla.max_texture_height := FRenderInfo.max_texture_height;
  64. FSDLPantalla.hardware := ((FRenderInfo.Flags and SDL_RENDERER_ACCELERATED) > 0);
  65. FSDLPantalla.render_name := FRenderInfo.name; // PAnsiChar(FRenderInfo.name);
  66. SDL_ShowWindow(FSDLPantalla.Window);
  67. if SDL_SetRenderDrawColor(FSDLPantalla.Renderer, 0, 0, 0, SDL_ALPHA_OPAQUE) = 0 then
  68. begin
  69. if SDL_RenderFillRect(FSDLPantalla.Renderer, nil) = 0 then
  70. FFlags := SDL_GetWindowFlags(FSDLPantalla.Window)
  71. else
  72. ShowMessage('Error clearing render context');
  73. end
  74. else
  75. ShowMessage('Error setting render draw color');
  76. end
  77. else
  78. ShowMessage('Error getting information about rendering context');
  79. end
  80. else
  81. ShowMessage('Error crearting SDL2 Render');
  82. end
  83. else
  84. ShowMessage('Error creating SDL2 Window.')
  85. end;
  86. // ******************************************************************************
  87. procedure TSDL2Frame.Finalize;
  88. begin
  89. if FSDLPantalla.Renderer <> nil then
  90. begin
  91. SDL_DestroyRenderer(FSDLPantalla.Renderer);
  92. FSDLPantalla.Renderer := nil;
  93. end;
  94. if FSDLPantalla.Window <> nil then
  95. begin
  96. SDL_DestroyWindow(FSDLPantalla.Window);
  97. FSDLPantalla.Window := nil;
  98. end;
  99. Dispose(FSDLPantalla);
  100. end;
  101. // ******************************************************************************
  102. procedure TSDL2Frame.DestroyWnd;
  103. begin
  104. Finalize;
  105. inherited;
  106. end;
  107. end.