2
0

SDL2.Frame.pas 3.5 KB

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