Luxophia

1
unit LUX.GPU.OpenGL.Render;
2

3
interface
4

5
uses
6
  System.UITypes,
7
  FMX.Graphics,
8
  Winapi.Windows,
9
  Winapi.OpenGL,
10
  Winapi.OpenGLext,
11
  LUX.GPU.OpenGL.Render_;
12

13
type
14
  TGLRender = class(TGL_Render)
15
  private
16
  protected
17
  public
18
    procedure CopyTo(const BMP_: FMX.Graphics.TBitmap);
19
    function MakeScreenShot: FMX.Graphics.TBitmap;
20
    procedure SaveToFile(const FileName_: String);
21
  end;
22

23
implementation
24

25
procedure TGLRender.CopyTo(const BMP_: FMX.Graphics.TBitmap);
26
var
27
  Cs: TArray<TAlphaColor>;
28
  C, B: PAlphaColor;
29
  Bs: TBitmapData;
30
  S, Y: Integer;
31
begin
32
  with BMP_ do
33
  begin
34
    SetSize(_SizeX, _SizeY);
35
    SetLength(Cs, _SizeY * _SizeX);
36
    C := @Cs[0];
37
    _Frame1.Bind;
38
    glReadBuffer(GL_COLOR_ATTACHMENT0);
39
    glReadPixels(0, 0, _SizeX, _SizeY, GL_BGRA, GL_UNSIGNED_BYTE, C);
40

41
    _Frame1.Unbind;
42

43
    Map(TMapAccess.Write, Bs);
44
    S := SizeOf(TAlphaColor) * _SizeX;
45
    for Y := _SizeY - 1 downto 0 do
46
    begin
47
      B := Bs.GetScanline(Y);
48
      System.Move(C^, B^, S);
49
      Inc(C, _SizeX);
50
    end;
51
    Unmap(Bs);
52
  end;
53
end;
54

55
function TGLRender.MakeScreenShot: FMX.Graphics.TBitmap;
56
begin
57
  Result := FMX.Graphics.TBitmap.Create;
58
  CopyTo(Result);
59
end;
60

61
procedure TGLRender.SaveToFile(const FileName_: String);
62
begin
63
  with MakeScreenShot do
64
  begin
65
    SaveToFile(FileName_);
66
    Free;
67
  end;
68
end;
69

70

71
initialization
72

73
finalization
74

75
end.
76