1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 unit BGRAOpenGLType;
3 
4 {$mode objfpc}{$H+}
5 
6 interface
7 
8 uses
9   BGRAGraphics, BGRABitmap, BGRABitmapTypes,
10   FPimage, BGRAClasses, SysUtils, BGRATransform,
11   BGRASSE, BGRAMatrix3D;
12 
13 type
14   TBGLTextureHandle = type Pointer;
15   TOpenGLResampleFilter = (orfBox,orfLinear);
16   TOpenGLBlendMode = (obmNormal, obmAdd, obmMultiply);
17   TWaitForGPUOption = (wfgQueueAllCommands, wfgFinishAllCommands);
18   TFaceCulling = BGRABitmapTypes.TFaceCulling;
19   TOpenGLPrimitive = (opPoints,opLineStrip,opLineLoop,opLines,
20                   opTriangleStrip,opTriangleFan,opTriangles);
21 
22 const
23   fcNone = BGRABitmapTypes.fcNone;
24   fcKeepCW = BGRABitmapTypes.fcKeepCW;
25   fcKeepCCW = BGRABitmapTypes.fcKeepCCW;
26 
27 type
28 
29   { IBGLFont }
30 
31   IBGLFont = interface
GetClippednull32     function GetClipped: boolean;
GetPaddingnull33     function GetPadding: TRectF;
GetUseGradientColorsnull34     function GetUseGradientColors: boolean;
GetHorizontalAlignnull35     function GetHorizontalAlign: TAlignment;
GetJustifynull36     function GetJustify: boolean;
GetScalenull37     function GetScale: single;
GetStepXnull38     function GetStepX: single;
GetVerticalAlignnull39     function GetVerticalAlign: TTextLayout;
40     procedure SetClipped(AValue: boolean);
41     procedure SetPadding(AValue: TRectF);
42     procedure SetUseGradientColors(AValue: boolean);
43     procedure SetHorizontalAlign(AValue: TAlignment);
44     procedure SetJustify(AValue: boolean);
45     procedure SetScale(AValue: single);
46     procedure SetStepX(AValue: single);
47     procedure SetVerticalAlign(AValue: TTextLayout);
48     procedure TextOut(X, Y: Single; const Text : UTF8String); overload;
49     procedure TextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); overload;
50     procedure TextOut(X, Y: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload;
51     procedure TextOut(X, Y: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
52     procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String); overload;
53     procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); overload;
54     procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AVertAlign: TTextLayout); overload;
55     procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
56     procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload;
57     procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
58     procedure TextRect(ARect: TRectF; const Text : UTF8String); overload;
59     procedure TextRect(ARect: TRectF; const Text : UTF8String; AColor: TBGRAPixel); overload;
60     procedure TextRect(ARect: TRectF; const Text : UTF8String; AVertAlign: TTextLayout); overload;
61     procedure TextRect(ARect: TRectF; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
62     procedure TextRect(ARect: TRectF; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload;
63     procedure TextRect(ARect: TRectF; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
TextWidthnull64     function TextWidth(const Text: UTF8String): single;
TextHeightnull65     function TextHeight(const Text: UTF8String): single; overload;
TextHeightnull66     function TextHeight(const Text: UTF8String; AWidth: single): single; overload;
67     procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel);
68 
69     property Scale: single read GetScale write SetScale;
70     property StepX: single read GetStepX write SetStepX;
71     property Justify: boolean read GetJustify write SetJustify;
72     property Clipped: boolean read GetClipped write SetClipped;
73     property HorizontalAlign: TAlignment read GetHorizontalAlign write SetHorizontalAlign;
74     property VerticalAlign: TTextLayout read GetVerticalAlign write SetVerticalAlign;
75     property GradientColors: boolean read GetUseGradientColors write SetUseGradientColors;
76     property Padding: TRectF read GetPadding write SetPadding;
77   end;
78 
79   { TBGLCustomFont }
80 
81   TBGLCustomFont = class(TInterfacedObject, IBGLFont)
82   protected
83     FScale, FStepX: single;
84     FPadding: TRectF;
85     FFlags: LongWord;
86     FHorizontalAlign: TAlignment;
87     FVerticalAlign: TTextLayout;
88     FJustify: boolean;
89     procedure Init; virtual;
LoadFromFilenull90     function LoadFromFile(AFilename: UTF8String): boolean; virtual; abstract;
91     procedure FreeMemoryOnDestroy; virtual;
92 
GetScalenull93     function GetScale: single; virtual;
GetStepXnull94     function GetStepX: single; virtual;
95     procedure SetScale(AValue: single); virtual;
96     procedure SetStepX(AValue: single); virtual;
GetPaddingnull97     function GetPadding: TRectF;
98     procedure SetPadding(AValue: TRectF); virtual;
99 
GetHorizontalAlignnull100     function GetHorizontalAlign: TAlignment; virtual;
GetJustifynull101     function GetJustify: boolean; virtual;
GetVerticalAlignnull102     function GetVerticalAlign: TTextLayout; virtual;
103     procedure SetHorizontalAlign(AValue: TAlignment); virtual;
104     procedure SetJustify(AValue: boolean); virtual;
105     procedure SetVerticalAlign(AValue: TTextLayout); virtual;
106 
GetClippednull107     function GetClipped: boolean; virtual; abstract;
GetUseGradientColorsnull108     function GetUseGradientColors: boolean; virtual; abstract;
109     procedure SetClipped(AValue: boolean); virtual; abstract;
110     procedure SetUseGradientColors(AValue: boolean); virtual; abstract;
111 
112     procedure DoTextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); virtual; abstract;
113     procedure DoTextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); virtual; abstract;
114 
GetDefaultColornull115     function GetDefaultColor: TBGRAPixel; virtual;
116     procedure SwapRectIfNeeded(var ARect: TRectF); overload;
117     procedure SwapRectIfNeeded(var ARect: TRect); overload;
118   public
119     constructor Create(AFilename: UTF8String);
120     procedure FreeMemory; virtual;
121     destructor Destroy; override;
122     procedure TextOut(X, Y: Single; const Text : UTF8String); overload;
123     procedure TextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); overload;
124     procedure TextOut(X, Y: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload;
125     procedure TextOut(X, Y: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
126     procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String); overload;
127     procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); overload;
128     procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AVertAlign: TTextLayout); overload;
129     procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
130     procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload;
131     procedure TextRect(X, Y, Width, Height: Single; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
132     procedure TextRect(ARect: TRect; const Text : UTF8String); overload;
133     procedure TextRect(ARect: TRect; const Text : UTF8String; AColor: TBGRAPixel); overload;
134     procedure TextRect(ARect: TRect; const Text : UTF8String; AVertAlign: TTextLayout); overload;
135     procedure TextRect(ARect: TRect; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
136     procedure TextRect(ARect: TRect; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload;
137     procedure TextRect(ARect: TRect; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
138     procedure TextRect(ARect: TRectF; const Text : UTF8String); overload;
139     procedure TextRect(ARect: TRectF; const Text : UTF8String; AColor: TBGRAPixel); overload;
140     procedure TextRect(ARect: TRectF; const Text : UTF8String; AVertAlign: TTextLayout); overload;
141     procedure TextRect(ARect: TRectF; const Text : UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
142     procedure TextRect(ARect: TRectF; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop); overload;
143     procedure TextRect(ARect: TRectF; const Text : UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
TextWidthnull144     function TextWidth(const Text: UTF8String): single; virtual; abstract;
TextHeightnull145     function TextHeight(const Text: UTF8String): single; overload; virtual; abstract;
TextHeightnull146     function TextHeight(const Text: UTF8String; AWidth: single): single; overload; virtual; abstract;
147     procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); virtual; abstract;
148 
149     property Scale: single read GetScale write SetScale;
150     property StepX: single read GetStepX write SetStepX;
151     property Justify: boolean read GetJustify write SetJustify;
152     property Clipped: boolean read GetClipped write SetClipped;
153     property HorizontalAlign: TAlignment read GetHorizontalAlign write SetHorizontalAlign;
154     property VerticalAlign: TTextLayout read GetVerticalAlign write SetVerticalAlign;
155     property GradientColors: boolean read GetUseGradientColors write SetUseGradientColors;
156     property Padding: TRectF read GetPadding write SetPadding;
157   end;
158 
159   { IBGLTexture }
160 
161   IBGLTexture = interface ['{BF2FF051-EBC6-4102-8268-37A9D0297B92}']
GetFlipXnull162     function GetFlipX: IBGLTexture;
GetFlipYnull163     function GetFlipY: IBGLTexture;
GetFramenull164     function GetFrame(AIndex: integer): IBGLTexture;
GetFrameCountnull165     function GetFrameCount: integer;
GetFrameHeightnull166     function GetFrameHeight: integer;
GetFrameWidthnull167     function GetFrameWidth: integer;
GetHeightnull168     function GetHeight: integer;
GetImageCenternull169     function GetImageCenter: TPointF;
GetMasknull170     function GetMask: IBGLTexture;
GetOpenGLBlendModenull171     function GetOpenGLBlendMode: TOpenGLBlendMode;
GetOpenGLTexturenull172     function GetOpenGLTexture: TBGLTextureHandle;
GetResampleFilternull173     function GetResampleFilter: TOpenGLResampleFilter;
GetUseGradientColorsnull174     function GetUseGradientColors: boolean;
GetWidthnull175     function GetWidth: integer;
176 
177     procedure SetFrameSize(x,y: integer);
178     procedure SetImageCenter(const AValue: TPointF);
179     procedure SetOpenGLBlendMode(AValue: TOpenGLBlendMode);
180     procedure SetResampleFilter(AValue: TOpenGLResampleFilter);
181     procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel);
182     procedure SetUseGradientColors(AValue: boolean);
183     procedure Update(ARGBAData: PLongWord; AllocatedWidth, AllocatedHeight, ActualWidth,ActualHeight: integer; RGBAOrder: boolean = true);
184     procedure ToggleFlipX;
185     procedure ToggleFlipY;
186     procedure ToggleMask;
FilterBlurMotionnull187     function FilterBlurMotion(ARadius: single; ABlurType: TRadialBlurType; ADirection: TPointF): IBGLTexture;
FilterBlurRadialnull188     function FilterBlurRadial(ARadius: single; ABlurType: TRadialBlurType): IBGLTexture;
189     procedure SetFrame(AIndex: integer);
190     procedure FreeMemory;
191     procedure Bind(ATextureNumber: integer);
192 
193     procedure Draw(x,y: single; AAlpha: byte = 255); overload;
194     procedure Draw(x,y: single; AColor: TBGRAPixel); overload;
195     procedure Draw(x,y: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload;
196     procedure Draw(x,y: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
197     procedure StretchDraw(x,y,w,h: single; AAlpha: byte = 255); overload;
198     procedure StretchDraw(x,y,w,h: single; AColor: TBGRAPixel); overload;
199     procedure StretchDraw(x,y,w,h: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload;
200     procedure StretchDraw(x,y,w,h: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
201     procedure DrawAngle(x,y,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte = 255); overload;
202     procedure DrawAngle(x,y,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); overload;
203     procedure DrawAngle(x,y,angleDeg: single; AAlpha: byte = 255); overload;
204     procedure DrawAngle(x,y,angleDeg: single; AColor: TBGRAPixel); overload;
205     procedure DrawAngle(x,y,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload;
206     procedure DrawAngle(x,y,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
207     procedure StretchDrawAngle(x,y,w,h,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte = 255); overload;
208     procedure StretchDrawAngle(x,y,w,h,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); overload;
209     procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AAlpha: byte = 255); overload;
210     procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AColor: TBGRAPixel); overload;
211     procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload;
212     procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
213     procedure DrawAffine(const Origin, HAxis, VAxis: TPointF; AAlpha: byte = 255); overload;
214     procedure DrawAffine(const Origin, HAxis, VAxis: TPointF; AColor: TBGRAPixel); overload;
215     procedure DrawAffine(x,y: single; const AMatrix: TAffineMatrix; AAlpha: byte = 255); overload;
216     procedure DrawAffine(x,y: single; const AMatrix: TAffineMatrix; AColor: TBGRAPixel); overload;
217     procedure DrawTriangle(const APoints: array of TPointF; const ATexCoords: array of TPointF); overload;
218     procedure DrawTriangle(const APoints: array of TPointF; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
219     procedure DrawTriangle(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF); overload;
220     procedure DrawTriangle(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
221     procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload;
222     procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
223     procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload;
224     procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
225     procedure DrawQuad(const APoints: array of TPointF; const ATexCoords: array of TPointF); overload;
226     procedure DrawQuad(const APoints: array of TPointF; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
227     procedure DrawQuad(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF); overload;
228     procedure DrawQuad(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
229     procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload;
230     procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
231     procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload;
232     procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
233 
234     property Width: integer read GetWidth;
235     property Height: integer read GetHeight;
236     property FrameCount: integer read GetFrameCount;
237     property Frame[AIndex: integer]: IBGLTexture read GetFrame;
238     property FrameWidth: integer read GetFrameWidth;
239     property FrameHeight: integer read GetFrameHeight;
240     property FlipX: IBGLTexture read GetFlipX;
241     property FlipY: IBGLTexture read GetFlipY;
242     property Mask: IBGLTexture read GetMask;
243     property Handle: TBGLTextureHandle read GetOpenGLTexture;
244     property ImageCenter: TPointF read GetImageCenter write SetImageCenter;
245     property ResampleFilter: TOpenGLResampleFilter read GetResampleFilter write SetResampleFilter;
246     property BlendMode: TOpenGLBlendMode read GetOpenGLBlendMode write SetOpenGLBlendMode;
247     property GradientColors: boolean read GetUseGradientColors write SetUseGradientColors;
248   end;
249 
250   { TBGLCustomBitmap }
251 
252   TBGLCustomBitmap = class(TBGRABitmap)
253   protected
254     FActualWidth,FActualHeight,
255     FAllocatedWidth,FAllocatedHeight: integer;
256     FTextureInvalidated: boolean;
257     FActualRect: TRect;
258     FTexture: IBGLTexture;
259     procedure Init; override;
GetTexturenull260     function GetTexture: IBGLTexture; virtual;
GetOpenGLMaxTexSizenull261     function GetOpenGLMaxTexSize: integer; virtual; abstract;
262     procedure NotifySizeTooBigForOpenGL; virtual;
263     procedure NotifyOpenGLContextNotCreatedYet; virtual;
GetTextureGLnull264     function GetTextureGL: IUnknown; override;
265     procedure SwapRedBlueWithoutInvalidate(ARect: TRect);
266     procedure SetClipRect(const AValue: TRect); override;
267   public
268     procedure InvalidateBitmap; override;
269     procedure Fill(const c: TBGRAPixel); override;
270     procedure NoClip; override;
271     destructor Destroy; override;
272     procedure SwapRedBlue; overload; override;
Resamplenull273     function Resample(newWidth, newHeight: integer; mode: TResampleMode=rmFineResample): TBGLCustomBitmap; override;
274     procedure ApplyGlobalOpacity(alpha: byte); overload; override;
275     procedure ReplaceColor(before, after: TColor); overload; override;
276     procedure ReplaceColor(const ABefore, AAfter: TBGRAPixel); overload; override;
277     procedure ReplaceTransparent(const AAfter: TBGRAPixel); overload; override;
278     procedure SetSize(AWidth, AHeight: integer); override;
279     property Width: integer read FActualWidth;
280     property Height: integer read FActualHeight;
281     property AllocatedWidth: integer read FAllocatedWidth;
282     property AllocatedHeight: integer read FAllocatedHeight;
MakeTextureAndFreenull283     function MakeTextureAndFree: IBGLTexture;
284     property Texture: IBGLTexture read GetTexture;
285     property MaxTextureSize: integer read GetOpenGLMaxTexSize;
286   end;
287 
288   { TBGLCustomTexture }
289 
290   TBGLCustomTexture = class(TInterfacedObject, IBGLTexture)
291   private
GetFlipXnull292     function GetFlipX: IBGLTexture;
GetFlipYnull293     function GetFlipY: IBGLTexture;
GetFramenull294     function GetFrame(AIndex: integer): IBGLTexture;
GetFrameCountnull295     function GetFrameCount: integer;
GetFrameHeightnull296     function GetFrameHeight: integer;
GetFrameWidthnull297     function GetFrameWidth: integer;
GetHeightnull298     function GetHeight: integer;
GetMasknull299     function GetMask: IBGLTexture;
GetOpenGLBlendModenull300     function GetOpenGLBlendMode: TOpenGLBlendMode;
GetOpenGLTexturenull301     function GetOpenGLTexture: TBGLTextureHandle;
GetWidthnull302     function GetWidth: integer;
GetImageCenternull303     function GetImageCenter: TPointF;
304     procedure SetImageCenter(const AValue: TPointF);
GetResampleFilternull305     function GetResampleFilter: TOpenGLResampleFilter;
306     procedure SetOpenGLBlendMode(AValue: TOpenGLBlendMode);
307     procedure SetResampleFilter(AValue: TOpenGLResampleFilter);
308   protected
309     FOpenGLTexture: TBGLTextureHandle;
310     FOpenGLTextureOwned: boolean;
311     FResampleFilter: TOpenGLResampleFilter;
312     FWidth,FHeight: integer;
313     FImageCenter: TPointF;
314     FFrame: integer;
315     FFrameWidth,FFrameHeight: integer;
316     FIsMask: boolean;
317     FGradTopLeft, FGradTopRight, FGradBottomRight, FGradBottomLeft: TBGRAPixel;
318     FUseGradientColor: boolean;
319     FBlendMode: TOpenGLBlendMode;
320 
GetOpenGLMaxTexSizenull321     function GetOpenGLMaxTexSize: integer; virtual; abstract;
CreateOpenGLTexturenull322     function CreateOpenGLTexture(ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer; RGBAOrder: boolean): TBGLTextureHandle; virtual; abstract;
323     procedure UpdateOpenGLTexture(ATexture: TBGLTextureHandle; ARGBAData: PLongWord; AAllocatedWidth, AAllocatedHeight, AActualWidth,AActualHeight: integer; RGBAOrder: boolean); virtual; abstract;
SupportsBGRAOrdernull324     class function SupportsBGRAOrder: boolean; virtual;
325     procedure SetOpenGLTextureSize(ATexture: TBGLTextureHandle; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer); virtual; abstract;
326     procedure ComputeOpenGLFramesCoord(ATexture: TBGLTextureHandle; FramesX: Integer=1; FramesY: Integer=1); virtual; abstract;
GetOpenGLFrameCountnull327     function GetOpenGLFrameCount(ATexture: TBGLTextureHandle): integer; virtual; abstract;
GetEmptyTexturenull328     function GetEmptyTexture: TBGLTextureHandle; virtual; abstract;
329     procedure FreeOpenGLTexture(ATexture: TBGLTextureHandle); virtual; abstract;
330     procedure UpdateGLResampleFilter(ATexture: TBGLTextureHandle; AFilter: TOpenGLResampleFilter); virtual; abstract;
GetUseGradientColorsnull331     function GetUseGradientColors: boolean; virtual;
332     procedure SetUseGradientColors(AValue: boolean); virtual;
333 
334     procedure DoDrawTriangleOrQuad(const {%H-}Points: array of TPointF;
335       const {%H-}APointsZ: array of Single; const {%H-}APoints3D: array of TPoint3D_128;
336       const {%H-}ANormals3D: array of TPoint3D_128; const {%H-}TexCoords: array of TPointF;
337       const {%H-}AColors: array of TColorF); virtual;
338     procedure DoStretchDraw(x,y,w,h: single; AColor: TBGRAPixel); virtual; abstract;
339     procedure DoStretchDrawAngle(x,y,w,h,angleDeg: single; rotationCenter: TPointF; AColor: TBGRAPixel); virtual; abstract;
340     procedure DoDrawAffine(Origin, HAxis, VAxis: TPointF; AColor: TBGRAPixel); virtual; abstract;
NewEmptynull341     function NewEmpty: TBGLCustomTexture; virtual; abstract;
NewFromTexturenull342     function NewFromTexture(ATexture: TBGLTextureHandle; AWidth,AHeight: integer): TBGLCustomTexture; virtual; abstract;
343     procedure NotifyInvalidFrameSize; virtual;
344     procedure NotifyErrorLoadingFile({%H-}AFilename: string); virtual;
345 
346     procedure Init(ATexture: TBGLTextureHandle; AWidth,AHeight: integer; AOwned: boolean); virtual;
Duplicatenull347     function Duplicate: TBGLCustomTexture; virtual;
348     procedure FreeMemoryOnDestroy; virtual;
349 
350     procedure InitEmpty;
351     procedure InitFromData(ARGBAData: PLongWord; AllocatedWidth,AllocatedHeight, ActualWidth,ActualHeight: integer; RGBAOrder: boolean);
352     procedure InitFromStream(AStream: TStream);
353   public
354     destructor Destroy; override;
355     constructor Create; overload;
356     constructor Create(ATexture: TBGLTextureHandle; AWidth,AHeight: integer); overload;
357     constructor Create(ARGBAData: PLongWord; AllocatedWidth,AllocatedHeight, ActualWidth,ActualHeight: integer; RGBAOrder: boolean = true); overload;
358     constructor Create(AFPImage: TFPCustomImage); overload;
359     constructor Create(ABitmap: TBitmap); overload;
360     constructor Create(AWidth, AHeight: integer; Color: TColor); overload;
361     constructor Create(AWidth, AHeight: integer; Color: TBGRAPixel); overload;
362     constructor Create(AFilenameUTF8: string); overload;
363     constructor Create(AFilenameUTF8: string; AWidth,AHeight: integer; AResampleFilter: TResampleFilter); overload;
364     constructor Create(AStream: TStream); overload;
365     procedure ToggleFlipX; virtual; abstract;
366     procedure ToggleFlipY; virtual; abstract;
367     procedure ToggleMask; virtual;
FilterBlurMotionnull368     function FilterBlurMotion({%H-}ARadius: single; {%H-}ABlurType: TRadialBlurType; {%H-}ADirection: TPointF): IBGLTexture; virtual;
FilterBlurRadialnull369     function FilterBlurRadial({%H-}ARadius: single; {%H-}ABlurType: TRadialBlurType): IBGLTexture; virtual;
370 
371     procedure SetFrameSize(x,y: integer);
372     procedure Update(ARGBAData: PLongWord; AllocatedWidth, AllocatedHeight, ActualWidth,ActualHeight: integer; RGBAOrder: boolean = true);
373     procedure SetFrame(AIndex: integer);
374     procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel);
375     procedure FreeMemory;
376     procedure Bind({%H-}ATextureNumber: integer); virtual;
377 
378     procedure Draw(x,y: single; AAlpha: byte = 255); overload;
379     procedure Draw(x,y: single; AColor: TBGRAPixel); overload;
380     procedure Draw(x,y: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload;
381     procedure Draw(x,y: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
382     procedure StretchDraw(x,y,w,h: single; AAlpha: byte = 255); overload;
383     procedure StretchDraw(x,y,w,h: single; AColor: TBGRAPixel); overload;
384     procedure StretchDraw(x,y,w,h: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload;
385     procedure StretchDraw(x,y,w,h: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
386     procedure DrawAngle(x,y,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte = 255); overload;
387     procedure DrawAngle(x,y,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); overload;
388     procedure DrawAngle(x,y,angleDeg: single; AAlpha: byte = 255); overload;
389     procedure DrawAngle(x,y,angleDeg: single; AColor: TBGRAPixel); overload;
390     procedure DrawAngle(x,y,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload;
391     procedure DrawAngle(x,y,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
392     procedure StretchDrawAngle(x,y,w,h,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte = 255); overload;
393     procedure StretchDrawAngle(x,y,w,h,angleDeg: single; const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel); overload;
394     procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AAlpha: byte = 255); overload;
395     procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AColor: TBGRAPixel); overload;
396     procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout = tlTop; AAlpha: byte = 255); overload;
397     procedure StretchDrawAngle(x,y,w,h,angleDeg: single; AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel); overload;
398     procedure DrawAffine(const Origin, HAxis, VAxis: TPointF; AAlpha: byte = 255); overload;
399     procedure DrawAffine(const Origin, HAxis, VAxis: TPointF; AColor: TBGRAPixel); overload;
400     procedure DrawAffine(x,y: single; const AMatrix: TAffineMatrix; AAlpha: byte = 255); overload;
401     procedure DrawAffine(x,y: single; const AMatrix: TAffineMatrix; AColor: TBGRAPixel); overload;
402     procedure DrawTriangle(const APoints: array of TPointF; const ATexCoords: array of TPointF); overload;
403     procedure DrawTriangle(const APoints: array of TPointF; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
404     procedure DrawTriangle(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF); overload;
405     procedure DrawTriangle(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
406     procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload;
407     procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
408     procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload;
409     procedure DrawTriangle(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
410     procedure DrawQuad(const APoints: array of TPointF; const ATexCoords: array of TPointF); overload;
411     procedure DrawQuad(const APoints: array of TPointF; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
412     procedure DrawQuad(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF); overload;
413     procedure DrawQuad(const APoints: array of TPointF; const APointsZ: array of Single; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
414     procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload;
415     procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
416     procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF); overload;
417     procedure DrawQuad(const APoints3D: array of TPoint3D_128; const ANormals3D: array of TPoint3D_128; const ATexCoords: array of TPointF; const AColors: array of TColorF); overload;
418 
419     property Width: integer read GetWidth;
420     property Height: integer read GetHeight;
421     property FrameCount: integer read GetFrameCount;
422     property Frame[AIndex: integer]: IBGLTexture read GetFrame;
423     property FrameWidth: integer read GetFrameWidth;
424     property FrameHeight: integer read GetFrameHeight;
425     property FlipX: IBGLTexture read GetFlipX;
426     property FlipY: IBGLTexture read GetFlipY;
427     property Mask: IBGLTexture read GetMask;
428     property Handle: TBGLTextureHandle read GetOpenGLTexture;
429     property ResampleFilter: TOpenGLResampleFilter read GetResampleFilter write SetResampleFilter;
430     property BlendMode: TOpenGLBlendMode read GetOpenGLBlendMode write SetOpenGLBlendMode;
431     property GradientColors: boolean read GetUseGradientColors write SetUseGradientColors;
432   end;
433 
434   { TBGLCustomFrameBuffer }
435 
436   TBGLCustomFrameBuffer = class
437   protected
438     FCanvas: pointer;
GetTexturenull439     function GetTexture: IBGLTexture; virtual; abstract;
GetHandlenull440     function GetHandle: pointer; virtual; abstract;
GetMatrixnull441     function GetMatrix: TAffineMatrix; virtual; abstract;
GetHeightnull442     function GetHeight: integer; virtual; abstract;
GetProjectionMatrixnull443     function GetProjectionMatrix: TMatrix4D; virtual; abstract;
GetWidthnull444     function GetWidth: integer; virtual; abstract;
445     procedure SetMatrix(AValue: TAffineMatrix); virtual; abstract;
446     procedure SetProjectionMatrix(AValue: TMatrix4D); virtual; abstract;
447 
448   public
449     procedure UseOrthoProjection; overload; virtual;
450     procedure UseOrthoProjection(AMinX,AMinY,AMaxX,AMaxY: single); overload; virtual;
MakeTextureAndFreenull451     function MakeTextureAndFree: IBGLTexture; virtual;
452 
453     procedure SetCanvas(ACanvas: Pointer); //for internal use
454     property Matrix: TAffineMatrix read GetMatrix write SetMatrix;
455     property ProjectionMatrix: TMatrix4D read GetProjectionMatrix write SetProjectionMatrix;
456     property Width: integer read GetWidth;
457     property Height: integer read GetHeight;
458     property Handle: pointer read GetHandle;
459     property Texture: IBGLTexture read GetTexture;
460   end;
461 
462 type
463   TBGLBitmapAny = class of TBGLCustomBitmap;
464   TBGLTextureAny = class of TBGLCustomTexture;
465 
466 var
467   BGLBitmapFactory : TBGLBitmapAny;
468   BGLTextureFactory: TBGLTextureAny;
469 
OrthoProjectionToOpenGLnull470 function OrthoProjectionToOpenGL(AMinX,AMinY,AMaxX,AMaxY: Single): TMatrix4D;
GetPowerOfTwonull471 function GetPowerOfTwo( Value : Integer ) : Integer;
472 
473 implementation
474 
475 uses BGRAFilterScanner;
476 
477 procedure TBGLCustomFrameBuffer.UseOrthoProjection;
478 begin
479   ProjectionMatrix := OrthoProjectionToOpenGL(0,0,Width,Height);
480 end;
481 
482 procedure TBGLCustomFrameBuffer.UseOrthoProjection(AMinX, AMinY, AMaxX, AMaxY: single);
483 begin
484   ProjectionMatrix := OrthoProjectionToOpenGL(AMinX,AMinY,AMaxX,AMaxY);
485 end;
486 
TBGLCustomFrameBuffer.MakeTextureAndFreenull487 function TBGLCustomFrameBuffer.MakeTextureAndFree: IBGLTexture;
488 begin
489   result := nil;
490   raise exception.create('Not implemented');
491 end;
492 
493 procedure TBGLCustomFrameBuffer.SetCanvas(ACanvas: Pointer);
494 begin
495   FCanvas := ACanvas;
496 end;
497 
OrthoProjectionToOpenGLnull498 function OrthoProjectionToOpenGL(AMinX, AMinY, AMaxX, AMaxY: Single): TMatrix4D;
499 var sx,sy: single;
500 begin
501   sx := 2/(AMaxX-AMinX);
502   sy := 2/(AMaxY-AMinY);
503   result[1,1] := sx;   result[2,1] := 0;     result[3,1] := 0;   result[4,1] := -1 - AMinX*sx;
504   result[1,2] := 0;    result[2,2] := -sy;   result[3,2] := 0;   result[4,2] := 1 + AMinY*sy;
505   result[1,3] := 0;    result[2,3] := 0;     result[3,3] := -1;  result[4,3] := 0;
506   result[1,4] := 0;    result[2,4] := 0;     result[3,4] := 0;   result[4,4] := 1;
507 end;
508 
GetPowerOfTwonull509 function GetPowerOfTwo( Value : Integer ) : Integer;
510 begin
511   Result := Value - 1;
512   Result := Result or ( Result shr 1 );
513   Result := Result or ( Result shr 2 );
514   Result := Result or ( Result shr 4 );
515   Result := Result or ( Result shr 8 );
516   Result := Result or ( Result shr 16 );
517   Result := Result + 1;
518 end;
519 
520 { TBGLCustomTexture }
521 
TBGLCustomTexture.GetFlipXnull522 function TBGLCustomTexture.GetFlipX: IBGLTexture;
523 begin
524   result := Duplicate;
525   result.ToggleFlipX;
526 end;
527 
TBGLCustomTexture.GetFlipYnull528 function TBGLCustomTexture.GetFlipY: IBGLTexture;
529 begin
530   result := Duplicate;
531   result.ToggleFlipY;
532 end;
533 
TBGLCustomTexture.GetFramenull534 function TBGLCustomTexture.GetFrame(AIndex: integer): IBGLTexture;
535 var fc: integer;
536 begin
537   fc := GetFrameCount;
538   if fc <= 1 then
539     result := self
540   else
541     begin
542       if (AIndex < 1) or (AIndex > fc) then
543         result := NewEmpty
544       else
545       begin
546         result := Duplicate;
547         result.SetFrame(AIndex);
548       end;
549     end;
550 end;
551 
TBGLCustomTexture.GetFrameCountnull552 function TBGLCustomTexture.GetFrameCount: integer;
553 begin
554   result := GetOpenGLFrameCount(FOpenGLTexture);
555 end;
556 
TBGLCustomTexture.GetFrameHeightnull557 function TBGLCustomTexture.GetFrameHeight: integer;
558 begin
559   result := FFrameHeight;
560 end;
561 
GetFrameWidthnull562 function TBGLCustomTexture.GetFrameWidth: integer;
563 begin
564   result := FFrameWidth;
565 end;
566 
TBGLCustomTexture.GetHeightnull567 function TBGLCustomTexture.GetHeight: integer;
568 begin
569   result := FHeight;
570 end;
571 
TBGLCustomTexture.GetMasknull572 function TBGLCustomTexture.GetMask: IBGLTexture;
573 begin
574   result := Duplicate;
575   result.ToggleMask;
576 end;
577 
TBGLCustomTexture.GetOpenGLBlendModenull578 function TBGLCustomTexture.GetOpenGLBlendMode: TOpenGLBlendMode;
579 begin
580   result := FBlendMode;
581 end;
582 
GetOpenGLTexturenull583 function TBGLCustomTexture.GetOpenGLTexture: TBGLTextureHandle;
584 begin
585   result := FOpenGLTexture;
586 end;
587 
TBGLCustomTexture.GetUseGradientColorsnull588 function TBGLCustomTexture.GetUseGradientColors: boolean;
589 begin
590   result := FUseGradientColor;
591 end;
592 
TBGLCustomTexture.GetWidthnull593 function TBGLCustomTexture.GetWidth: integer;
594 begin
595   result := FWidth;
596 end;
597 
GetImageCenternull598 function TBGLCustomTexture.GetImageCenter: TPointF;
599 begin
600   result := FImageCenter;
601 end;
602 
603 procedure TBGLCustomTexture.SetImageCenter(const AValue: TPointF);
604 begin
605   FImageCenter := AValue;
606 end;
607 
GetResampleFilternull608 function TBGLCustomTexture.GetResampleFilter: TOpenGLResampleFilter;
609 begin
610   result := FResampleFilter;
611 end;
612 
613 procedure TBGLCustomTexture.SetOpenGLBlendMode(AValue: TOpenGLBlendMode);
614 begin
615   FBlendMode := AValue;
616 end;
617 
618 procedure TBGLCustomTexture.SetResampleFilter(AValue: TOpenGLResampleFilter);
619 begin
620   if AValue <> FResampleFilter then
621   begin
622     FResampleFilter:= AValue;
623     UpdateGLResampleFilter(FOpenGLTexture, AValue);
624   end;
625 end;
626 
TBGLCustomTexture.SupportsBGRAOrdernull627 class function TBGLCustomTexture.SupportsBGRAOrder: boolean;
628 begin
629   result := false;
630 end;
631 
632 procedure TBGLCustomTexture.SetUseGradientColors(AValue: boolean);
633 begin
634   FUseGradientColor := AValue;
635 end;
636 
637 procedure TBGLCustomTexture.DoDrawTriangleOrQuad(
638   const Points: array of TPointF; const APointsZ: array of Single;
639   const APoints3D: array of TPoint3D_128;
640   const ANormals3D: array of TPoint3D_128; const TexCoords: array of TPointF;
641   const AColors: array of TColorF);
642 begin
643   raise Exception.Create('Not implemented');
644 end;
645 
646 procedure TBGLCustomTexture.ToggleMask;
647 begin
648   FIsMask := not FIsMask;
649 end;
650 
TBGLCustomTexture.FilterBlurMotionnull651 function TBGLCustomTexture.FilterBlurMotion(ARadius: single; ABlurType: TRadialBlurType;
652   ADirection: TPointF): IBGLTexture;
653 begin
654   result := nil;
655   raise exception.Create('Not implemented');
656 end;
657 
TBGLCustomTexture.FilterBlurRadialnull658 function TBGLCustomTexture.FilterBlurRadial(ARadius: single; ABlurType: TRadialBlurType): IBGLTexture;
659 begin
660   result := nil;
661   raise exception.Create('Not implemented');
662 end;
663 
664 procedure TBGLCustomTexture.Update(ARGBAData: PLongWord; AllocatedWidth,
665   AllocatedHeight, ActualWidth, ActualHeight: integer; RGBAOrder: boolean);
666 begin
667   UpdateOpenGLTexture(FOpenGLTexture, ARGBAData, AllocatedWidth, AllocatedHeight, ActualWidth,ActualHeight,RGBAOrder);
668   ComputeOpenGLFramesCoord(FOpenGLTexture, round(FWidth/FFrameWidth),round(FWidth/FFrameHeight));
669   FWidth := ActualWidth;
670   FHeight := ActualHeight;
671   FImageCenter := PointF(FWidth*0.5,FHeight*0.5);
672 end;
673 
674 procedure TBGLCustomTexture.SetFrame(AIndex: integer);
675 begin
676   if (AIndex >= 1) and (AIndex <= GetFrameCount) then
677     begin
678       FFrame := AIndex;
679       FWidth := FFrameWidth;
680       FHeight:= FFrameHeight;
681       FImageCenter := PointF(FWidth*0.5,FHeight*0.5);
682     end;
683 end;
684 
685 procedure TBGLCustomTexture.SetGradientColors(ATopLeft, ATopRight,
686   ABottomRight, ABottomLeft: TBGRAPixel);
687 begin
688   FGradTopLeft := ATopLeft;
689   FGradTopRight := ATopRight;
690   FGradBottomLeft := ABottomLeft;
691   FGradBottomRight := ABottomRight;
692   GradientColors := true;
693 end;
694 
695 procedure TBGLCustomTexture.FreeMemory;
696 begin
697   if FOpenGLTextureOwned then
698   begin
699     FreeOpenGLTexture(FOpenGLTexture);
700     FOpenGLTexture := GetEmptyTexture;
701     FOpenGLTextureOwned := false;
702   end;
703 end;
704 
705 procedure TBGLCustomTexture.Bind(ATextureNumber: integer);
706 begin
707   raise Exception.Create('Not implemented');
708 end;
709 
710 procedure TBGLCustomTexture.NotifyInvalidFrameSize;
711 begin
712   //
713 end;
714 
715 procedure TBGLCustomTexture.NotifyErrorLoadingFile(AFilename: string);
716 begin
717   //
718 end;
719 
720 procedure TBGLCustomTexture.Init(ATexture: TBGLTextureHandle; AWidth,
721   AHeight: integer; AOwned: boolean);
722 begin
723   FOpenGLTexture:= ATexture;
724   FWidth := AWidth;
725   FHeight := AHeight;
726   FImageCenter := PointF(FWidth*0.5,FHeight*0.5);
727   FFrame:= 0;
728   FFrameWidth := AWidth;
729   FFrameHeight := AHeight;
730   FIsMask:= false;
731   FOpenGLTextureOwned := AOwned;
732 end;
733 
Duplicatenull734 function TBGLCustomTexture.Duplicate: TBGLCustomTexture;
735 begin
736   result := NewFromTexture(FOpenGLTexture, FWidth, FHeight);
737   result.FFrame := FFrame;
738   result.FFrameWidth := FFrameWidth;
739   result.FFrameHeight := FFrameHeight;
740   result.FIsMask := FIsMask;
741   result.FResampleFilter := FResampleFilter;
742   result.FGradTopLeft := FGradTopLeft;
743   result.FGradTopRight := FGradTopRight;
744   result.FGradBottomRight := FGradBottomRight;
745   result.FGradBottomLeft := FGradBottomLeft;
746   result.FUseGradientColor := FUseGradientColor;
747   result.FBlendMode := FBlendMode;
748 end;
749 
750 procedure TBGLCustomTexture.FreeMemoryOnDestroy;
751 begin
752   FreeMemory;
753 end;
754 
755 procedure TBGLCustomTexture.InitEmpty;
756 begin
757   Init(GetEmptyTexture,0,0,False);
758 end;
759 
760 procedure TBGLCustomTexture.InitFromData(ARGBAData: PLongWord;
761   AllocatedWidth, AllocatedHeight, ActualWidth, ActualHeight: integer;
762   RGBAOrder: boolean);
763 var tex: TBGLTextureHandle;
764     MaxTexSize: integer;
765 begin
766   MaxTexSize := GetOpenGLMaxTexSize;
767   if ( AllocatedWidth > MaxTexSize ) or ( AllocatedHeight > MaxTexSize ) or
768     (AllocatedWidth <= 0) or (AllocatedHeight <= 0) then
769     InitEmpty
770   else
771   begin
772     tex := CreateOpenGLTexture(ARGBAData,AllocatedWidth,AllocatedHeight,ActualWidth,ActualHeight,RGBAOrder);
773     FResampleFilter := orfLinear;
774     ComputeOpenGLFramesCoord(tex);
775     Init(tex,ActualWidth,ActualHeight,True);
776   end;
777 end;
778 
779 procedure TBGLCustomTexture.InitFromStream(AStream: TStream);
780 var bmp: TBGLCustomBitmap;
781 begin
782   bmp := nil;
783   try
784     bmp := BGLBitmapFactory.Create(AStream);
785     if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue;
786     InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height,TBGRAPixel_RGBAOrder or not SupportsBGRAOrder);
787   except
788     InitEmpty;
789   end;
790   bmp.Free;
791 end;
792 
793 destructor TBGLCustomTexture.Destroy;
794 begin
795   FreeMemoryOnDestroy;
796   inherited Destroy;
797 end;
798 
799 constructor TBGLCustomTexture.Create;
800 begin
801   InitEmpty;
802 end;
803 
804 constructor TBGLCustomTexture.Create(ATexture: TBGLTextureHandle; AWidth,
805   AHeight: integer);
806 begin
807   Init(ATexture, AWidth,AHeight, False);
808 end;
809 
810 constructor TBGLCustomTexture.Create(ARGBAData: PLongWord; AllocatedWidth,
811   AllocatedHeight, ActualWidth, ActualHeight: integer; RGBAOrder: boolean);
812 begin
813   InitFromData(ARGBAData,AllocatedWidth,AllocatedHeight,ActualWidth,ActualHeight,RGBAOrder);
814 end;
815 
816 constructor TBGLCustomTexture.Create(AFPImage: TFPCustomImage);
817 var bmp: TBGLCustomBitmap;
818 begin
819   if (AFPImage is TBGRACustomBitmap) and
820     (AFPImage.Width = GetPowerOfTwo(AFPImage.Width)) and
821     (AFPImage.Height = GetPowerOfTwo(AFPImage.Height)) then
822   begin
823     with TBGRACustomBitmap(AFPImage) do
824     begin
825       if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then SwapRedBlue;
826       if LineOrder = riloBottomToTop then VerticalFlip;
827       InitFromData(PLongWord(Data), Width,Height, Width,Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder);
828       if LineOrder = riloBottomToTop then VerticalFlip;
829       if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then SwapRedBlue;
830     end;
831   end else
832   begin
833     bmp := BGLBitmapFactory.Create(AFPImage);
834     if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue;
835     InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder);
836     bmp.Free;
837   end;
838 end;
839 
840 constructor TBGLCustomTexture.Create(ABitmap: TBitmap);
841 var bmp: TBGLCustomBitmap;
842 begin
843   bmp := BGLBitmapFactory.Create(ABitmap);
844   if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue;
845   InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder);
846   bmp.Free;
847 end;
848 
849 constructor TBGLCustomTexture.Create(AWidth, AHeight: integer; Color: TColor);
850 var bmp: TBGLCustomBitmap;
851 begin
852   bmp := BGLBitmapFactory.Create(AWidth,AHeight,Color);
853   if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue;
854   InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder);
855   bmp.Free;
856 end;
857 
858 constructor TBGLCustomTexture.Create(AWidth, AHeight: integer;
859   Color: TBGRAPixel);
860 var bmp: TBGLCustomBitmap;
861 begin
862   bmp := BGLBitmapFactory.Create(AWidth,AHeight,Color);
863   if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue;
864   InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder);
865   bmp.Free;
866 end;
867 
868 constructor TBGLCustomTexture.Create(AFilenameUTF8: string);
869 var bmp: TBGLCustomBitmap;
870 begin
871   bmp := nil;
872   try
873     bmp := BGLBitmapFactory.Create(AFilenameUTF8, True);
874     if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue;
875     InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder or not SupportsBGRAOrder);
876   except
877     InitEmpty;
878     NotifyErrorLoadingFile(AFilenameUTF8);
879   end;
880   bmp.Free;
881 end;
882 
883 constructor TBGLCustomTexture.Create(AFilenameUTF8: string; AWidth,
884   AHeight: integer; AResampleFilter: TResampleFilter);
885 var bmp, temp: TBGLCustomBitmap;
886 begin
887   bmp := nil;
888   try
889     bmp := BGLBitmapFactory.Create(AFilenameUTF8, True);
890     if (bmp.Width <> AWidth) or (bmp.Height <> AHeight) then
891     begin
892       if AResampleFilter = rfBox then
893         temp := bmp.Resample(AWidth,AHeight,rmSimpleStretch) as TBGLCustomBitmap
894       else
895       begin
896         bmp.ResampleFilter := AResampleFilter;
897         temp := bmp.Resample(AWidth,AHeight) as TBGLCustomBitmap;
898       end;
899       bmp.Free;
900       bmp := temp;
901       temp := nil;
902     end;
903     if not TBGRAPixel_RGBAOrder and not SupportsBGRAOrder then bmp.SwapRedBlue;
904     InitFromData(PLongWord(bmp.Data), bmp.AllocatedWidth,bmp.AllocatedHeight, bmp.Width,bmp.Height, TBGRAPixel_RGBAOrder);
905   except
906     InitEmpty;
907     NotifyErrorLoadingFile(AFilenameUTF8);
908   end;
909   bmp.Free;
910 end;
911 
912 constructor TBGLCustomTexture.Create(AStream: TStream);
913 begin
914   InitFromStream(AStream);
915 end;
916 
917 procedure TBGLCustomTexture.SetFrameSize(x, y: integer);
918 begin
919   if (FWidth = 0) or (FHeight = 0) then exit;
920   if (x <= 0) or (y <= 0) or (x > FWidth) or (y > FHeight) then
921   begin
922     NotifyInvalidFrameSize;
923     exit;
924   end;
925   ComputeOpenGLFramesCoord(FOpenGLTexture, FWidth div x,FHeight div y);
926   FFrameWidth:= x;
927   FFrameHeight:= y;
928 end;
929 
930 procedure TBGLCustomTexture.Draw(x, y: single; AAlpha: byte);
931 begin
932   DoStretchDraw(x,y,FWidth,FHeight,BGRA(255,255,255,AAlpha));
933 end;
934 
935 procedure TBGLCustomTexture.Draw(x, y: single; AColor: TBGRAPixel);
936 begin
937   DoStretchDraw(x,y,FWidth,FHeight,AColor);
938 end;
939 
940 procedure TBGLCustomTexture.Draw(x, y: single; AHorizAlign: TAlignment;
941   AVertAlign: TTextLayout; AAlpha: byte);
942 begin
943   Draw(x,y, AHorizAlign, AVertAlign, BGRA(255,255,255,AAlpha));
944 end;
945 
946 procedure TBGLCustomTexture.Draw(x, y: single; AHorizAlign: TAlignment;
947   AVertAlign: TTextLayout; AColor: TBGRAPixel);
948 begin
949   StretchDraw(x,y, FWidth,FHeight, AHorizAlign,AVertAlign, AColor);
950 end;
951 
952 procedure TBGLCustomTexture.StretchDraw(x, y, w, h: single; AAlpha: byte);
953 begin
954   DoStretchDraw(x,y,w,h, BGRA(255,255,255,AAlpha));
955 end;
956 
957 procedure TBGLCustomTexture.StretchDraw(x, y, w, h: single;
958   AColor: TBGRAPixel);
959 begin
960   DoStretchDraw(x,y,w,h,AColor);
961 end;
962 
963 procedure TBGLCustomTexture.StretchDraw(x, y, w, h: single;
964   AHorizAlign: TAlignment; AVertAlign: TTextLayout; AAlpha: byte);
965 begin
966   StretchDraw(x,y,w,h, AHorizAlign,AVertAlign, BGRA(255,255,255,AAlpha));
967 end;
968 
969 procedure TBGLCustomTexture.StretchDraw(x, y, w, h: single;
970   AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel);
971 begin
972   case AHorizAlign of
973   taCenter: DecF(x, w*0.5);
974   taRightJustify: DecF(x, w-1);
975   end;
976   case AVertAlign of
977   tlCenter: DecF(y, h*0.5);
978   tlBottom: DecF(y, h);
979   end;
980   DoStretchDraw(x,y,w,h,AColor);
981 end;
982 
983 procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single;
984   const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte);
985 begin
986   StretchDrawAngle(x,y,FWidth,FHeight,angleDeg,imageCenter,ARestoreOffsetAfterRotation,BGRA(255,255,255,AAlpha));
987 end;
988 
989 procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single;
990   const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel);
991 begin
992   StretchDrawAngle(x,y,FWidth,FHeight,angleDeg,imageCenter,ARestoreOffsetAfterRotation,AColor);
993 end;
994 
995 procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; AAlpha: byte);
996 begin
997   StretchDrawAngle(x,y, FWidth,FHeight, angleDeg, AAlpha);
998 end;
999 
1000 procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single; AColor: TBGRAPixel);
1001 begin
1002   StretchDrawAngle(x,y, FWidth,FHeight, angleDeg, AColor);
1003 end;
1004 
1005 procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single;
1006   AHorizAlign: TAlignment; AVertAlign: TTextLayout; AAlpha: byte);
1007 begin
1008   StretchDrawAngle(x,y,FWidth,FHeight,angleDeg, AHorizAlign, AVertAlign, AAlpha);
1009 end;
1010 
1011 procedure TBGLCustomTexture.DrawAngle(x, y, angleDeg: single;
1012   AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel);
1013 begin
1014   StretchDrawAngle(x,y,FWidth,FHeight, angleDeg, AHorizAlign, AVertAlign, AColor);
1015 end;
1016 
1017 procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single;
1018   const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AAlpha: byte);
1019 begin
1020   StretchDrawAngle(x,y,w,h,angleDeg,imageCenter,ARestoreOffsetAfterRotation,BGRA(255,255,255,AAlpha));
1021 end;
1022 
1023 procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single;
1024   const imageCenter: TPointF; ARestoreOffsetAfterRotation: boolean; AColor: TBGRAPixel);
1025 var
1026   rotationCenter: TPointF;
1027 begin
1028   if (FWidth=0) or (FHeight = 0) then exit;
1029   rotationCenter := PointF(imageCenter.x*w/FWidth, imageCenter.y*h/FHeight);
1030   if not ARestoreOffsetAfterRotation then
1031   begin
1032     DecF(x, rotationCenter.x);
1033     DecF(y, rotationCenter.y);
1034   end;
1035   DoStretchDrawAngle(x,y,w,h,angleDeg,rotationCenter+PointF(x,y),AColor);
1036 end;
1037 
1038 procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single; AAlpha: byte);
1039 begin
1040   StretchDrawAngle(x, y, w,h, angleDeg, FImageCenter, True, BGRA(255,255,255,AAlpha));
1041 end;
1042 
1043 procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single;
1044   AColor: TBGRAPixel);
1045 begin
1046   StretchDrawAngle(x, y, w,h, angleDeg, FImageCenter, True, AColor);
1047 end;
1048 
1049 procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single;
1050   AHorizAlign: TAlignment; AVertAlign: TTextLayout; AAlpha: byte);
1051 begin
1052   StretchDrawAngle(x,y,w,h,angleDeg, AHorizAlign, AVertAlign, BGRA(255,255,255,AAlpha));
1053 end;
1054 
1055 procedure TBGLCustomTexture.StretchDrawAngle(x, y,w,h, angleDeg: single;
1056   AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel);
1057 var imageCenter: TPointF;
1058 begin
1059   case AHorizAlign of
1060   taCenter: imageCenter.x := FWidth*0.5;
1061   taRightJustify: imageCenter.x := FWidth;
1062   else imageCenter.x := 0;
1063   end;
1064   case AVertAlign of
1065   tlCenter: imageCenter.y := FHeight*0.5;
1066   tlBottom: imageCenter.y := FHeight;
1067   else imageCenter.y := 0;
1068   end;
1069   StretchDrawAngle(x,y,w,h, angleDeg, imageCenter, False, AColor);
1070 end;
1071 
1072 procedure TBGLCustomTexture.DrawAffine(const Origin, HAxis, VAxis: TPointF;
1073   AAlpha: byte);
1074 begin
1075   {$PUSH}{$OPTIMIZATION OFF}
1076   DoDrawAffine(Origin,HAxis,VAxis, BGRA(255,255,255,AAlpha));
1077   {$POP}
1078 end;
1079 
1080 procedure TBGLCustomTexture.DrawAffine(const Origin, HAxis, VAxis: TPointF;
1081   AColor: TBGRAPixel);
1082 begin
1083   {$PUSH}{$OPTIMIZATION OFF}
1084   DoDrawAffine(Origin,HAxis,VAxis, AColor);
1085   {$POP}
1086 end;
1087 
1088 procedure TBGLCustomTexture.DrawAffine(x, y: single;
1089   const AMatrix: TAffineMatrix; AAlpha: byte);
1090 begin
1091   DoDrawAffine(AMatrix*PointF(0,0) + PointF(x,y), AMatrix*PointF(Width,0) + PointF(x,y),
1092      AMatrix*PointF(0,Height) + PointF(x,y), BGRA(255,255,255,AAlpha));
1093 end;
1094 
1095 procedure TBGLCustomTexture.DrawAffine(x, y: single;
1096   const AMatrix: TAffineMatrix; AColor: TBGRAPixel);
1097 begin
1098   DoDrawAffine(AMatrix*PointF(0,0) + PointF(x,y), AMatrix*PointF(Width,0) + PointF(x,y),
1099      AMatrix*PointF(0,Height) + PointF(x,y), AColor);
1100 end;
1101 
1102 procedure TBGLCustomTexture.DrawTriangle(const APoints: array of TPointF;
1103   const ATexCoords: array of TPointF);
1104 begin
1105   if (length(APoints) = 3) and (length(ATexCoords) = 3) then
1106     DoDrawTriangleOrQuad(APoints,[],[],[],ATexCoords,[]);
1107 end;
1108 
1109 procedure TBGLCustomTexture.DrawTriangle(const APoints: array of TPointF;
1110   const ATexCoords: array of TPointF; const AColors: array of TColorF);
1111 begin
1112   if (length(APoints) = 3) and (length(ATexCoords) = 3)
1113      and (length(AColors) = 3) then
1114     DoDrawTriangleOrQuad(APoints,[],[],[],ATexCoords,AColors);
1115 end;
1116 
1117 procedure TBGLCustomTexture.DrawTriangle(const APoints: array of TPointF;
1118   const APointsZ: array of Single; const ATexCoords: array of TPointF);
1119 begin
1120   if (length(APoints) = 3) and (length(ATexCoords) = 3)
1121      and (length(APointsZ) = 3) then
1122   DoDrawTriangleOrQuad(APoints,APointsZ,[],[],ATexCoords,[]);
1123 end;
1124 
1125 procedure TBGLCustomTexture.DrawTriangle(const APoints: array of TPointF;
1126   const APointsZ: array of Single; const ATexCoords: array of TPointF;
1127   const AColors: array of TColorF);
1128 begin
1129   if (length(APoints) = 3) and (length(ATexCoords) = 3)
1130      and (length(APointsZ) = 3) and (length(AColors) = 3) then
1131   DoDrawTriangleOrQuad(APoints,APointsZ,[],[],ATexCoords,AColors);
1132 end;
1133 
1134 procedure TBGLCustomTexture.DrawTriangle(
1135   const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF);
1136 begin
1137   if (length(APoints3D) = 3) and (length(ATexCoords) = 3) then
1138   DoDrawTriangleOrQuad([],[],APoints3D,[],ATexCoords,[]);
1139 end;
1140 
1141 procedure TBGLCustomTexture.DrawTriangle(
1142   const APoints3D: array of TPoint3D_128; const ATexCoords: array of TPointF;
1143   const AColors: array of TColorF);
1144 begin
1145   if (length(APoints3D) = 3) and (length(ATexCoords) = 3)
1146   and (length(AColors) = 3) then
1147   DoDrawTriangleOrQuad([],[],APoints3D,[],ATexCoords,AColors);
1148 end;
1149 
1150 procedure TBGLCustomTexture.DrawTriangle(const APoints3D: array of TPoint3D_128;
1151   const ANormals3D: array of TPoint3D_128;
1152   const ATexCoords: array of TPointF);
1153 begin
1154   if (length(APoints3D) = 3) and (length(ATexCoords) = 3)
1155   and (length(ANormals3D) = 3) then
1156   DoDrawTriangleOrQuad([],[],APoints3D,ANormals3D,ATexCoords,[]);
1157 end;
1158 
1159 procedure TBGLCustomTexture.DrawTriangle(const APoints3D: array of TPoint3D_128;
1160   const ANormals3D: array of TPoint3D_128;
1161   const ATexCoords: array of TPointF; const AColors: array of TColorF);
1162 begin
1163   if (length(APoints3D) = 3) and (length(ATexCoords) = 3)
1164   and (length(ANormals3D) = 3)
1165   and (length(AColors) = 3) then
1166   DoDrawTriangleOrQuad([],[],APoints3D,ANormals3D,ATexCoords,AColors);
1167 end;
1168 
1169 procedure TBGLCustomTexture.DrawQuad(const APoints: array of TPointF;
1170   const ATexCoords: array of TPointF);
1171 begin
1172   if (length(APoints) = 4) and (length(ATexCoords) = 4) then
1173     DoDrawTriangleOrQuad(APoints,[],[],[],ATexCoords,[]);
1174 end;
1175 
1176 procedure TBGLCustomTexture.DrawQuad(const APoints: array of TPointF;
1177   const ATexCoords: array of TPointF; const AColors: array of TColorF);
1178 begin
1179   if (length(APoints) = 4) and (length(ATexCoords) = 4)
1180     and (length(AColors) = 4) then
1181     DoDrawTriangleOrQuad(APoints,[],[],[],ATexCoords, AColors);
1182 end;
1183 
1184 procedure TBGLCustomTexture.DrawQuad(const APoints: array of TPointF;
1185   const APointsZ: array of Single; const ATexCoords: array of TPointF);
1186 begin
1187   if (length(APoints) = 4) and (length(ATexCoords) = 4)
1188      and (length(APointsZ) = 4) then
1189     DoDrawTriangleOrQuad(APoints,APointsZ,[],[],ATexCoords,[]);
1190 end;
1191 
1192 procedure TBGLCustomTexture.DrawQuad(const APoints: array of TPointF;
1193   const APointsZ: array of Single; const ATexCoords: array of TPointF;
1194   const AColors: array of TColorF);
1195 begin
1196   if (length(APoints) = 4) and (length(ATexCoords) = 4)
1197      and (length(APointsZ) = 4) and (length(AColors) = 4) then
1198     DoDrawTriangleOrQuad(APoints,APointsZ,[],[],ATexCoords,AColors);
1199 end;
1200 
1201 procedure TBGLCustomTexture.DrawQuad(const APoints3D: array of TPoint3D_128;
1202   const ATexCoords: array of TPointF);
1203 begin
1204   if (length(APoints3D) = 4) and (length(ATexCoords) = 4) then
1205     DoDrawTriangleOrQuad([],[],APoints3D,[],ATexCoords,[]);
1206 end;
1207 
1208 procedure TBGLCustomTexture.DrawQuad(const APoints3D: array of TPoint3D_128;
1209   const ATexCoords: array of TPointF; const AColors: array of TColorF);
1210 begin
1211   if (length(APoints3D) = 4) and (length(ATexCoords) = 4)
1212      and (length(AColors) = 4) then
1213     DoDrawTriangleOrQuad([],[],APoints3D,[],ATexCoords,AColors);
1214 end;
1215 
1216 procedure TBGLCustomTexture.DrawQuad(const APoints3D: array of TPoint3D_128;
1217   const ANormals3D: array of TPoint3D_128;
1218   const ATexCoords: array of TPointF);
1219 begin
1220   if (length(APoints3D) = 4) and (length(ATexCoords) = 4)
1221      and (length(ANormals3D) = 4) then
1222     DoDrawTriangleOrQuad([],[],APoints3D,ANormals3D,ATexCoords,[]);
1223 end;
1224 
1225 procedure TBGLCustomTexture.DrawQuad(const APoints3D: array of TPoint3D_128;
1226   const ANormals3D: array of TPoint3D_128;
1227   const ATexCoords: array of TPointF; const AColors: array of TColorF);
1228 begin
1229   if (length(APoints3D) = 4) and (length(ATexCoords) = 4)
1230      and (length(ANormals3D) = 4)
1231      and (length(AColors) = 4) then
1232     DoDrawTriangleOrQuad([],[],APoints3D,ANormals3D,ATexCoords,AColors);
1233 end;
1234 
1235 { TBGLCustomFont }
1236 
TBGLCustomFont.GetScalenull1237 function TBGLCustomFont.GetScale: single;
1238 begin
1239   result := FScale;
1240 end;
1241 
GetStepXnull1242 function TBGLCustomFont.GetStepX: single;
1243 begin
1244   result := FStepX;
1245 end;
1246 
1247 procedure TBGLCustomFont.SetScale(AValue: single);
1248 begin
1249   FScale:= AValue;
1250 end;
1251 
1252 procedure TBGLCustomFont.SetStepX(AValue: single);
1253 begin
1254   FStepX:= AValue;
1255 end;
1256 
GetHorizontalAlignnull1257 function TBGLCustomFont.GetHorizontalAlign: TAlignment;
1258 begin
1259   result := FHorizontalAlign;
1260 end;
1261 
TBGLCustomFont.GetJustifynull1262 function TBGLCustomFont.GetJustify: boolean;
1263 begin
1264   result := FJustify;
1265 end;
1266 
GetVerticalAlignnull1267 function TBGLCustomFont.GetVerticalAlign: TTextLayout;
1268 begin
1269   result := FVerticalAlign;
1270 end;
1271 
1272 procedure TBGLCustomFont.SetHorizontalAlign(AValue: TAlignment);
1273 begin
1274   FHorizontalAlign:= AValue;
1275 end;
1276 
1277 procedure TBGLCustomFont.SetJustify(AValue: boolean);
1278 begin
1279   FJustify:= AValue;
1280 end;
1281 
1282 procedure TBGLCustomFont.SetVerticalAlign(AValue: TTextLayout);
1283 begin
1284   FVerticalAlign := AValue;
1285 end;
1286 
TBGLCustomFont.GetDefaultColornull1287 function TBGLCustomFont.GetDefaultColor: TBGRAPixel;
1288 begin
1289   result := BGRAWhite;
1290 end;
1291 
1292 procedure TBGLCustomFont.SwapRectIfNeeded(var ARect: TRectF);
1293 var temp: single;
1294 begin
1295   if ARect.Right < ARect.Left then
1296   begin
1297     temp := ARect.Left;
1298     ARect.Left := ARect.Right;
1299     ARect.Right := temp;
1300   end;
1301   if ARect.Bottom < ARect.Top then
1302   begin
1303     temp := ARect.Top;
1304     ARect.Top := ARect.Bottom;
1305     ARect.Bottom := temp;
1306   end;
1307 end;
1308 
1309 procedure TBGLCustomFont.SwapRectIfNeeded(var ARect: TRect);
1310 var temp: integer;
1311 begin
1312   if ARect.Right < ARect.Left then
1313   begin
1314     temp := ARect.Left;
1315     ARect.Left := ARect.Right;
1316     ARect.Right := temp;
1317   end;
1318   if ARect.Bottom < ARect.Top then
1319   begin
1320     temp := ARect.Top;
1321     ARect.Top := ARect.Bottom;
1322     ARect.Bottom := temp;
1323   end;
1324 end;
1325 
1326 procedure TBGLCustomFont.SetPadding(AValue: TRectF);
1327 begin
1328   FPadding:=AValue;
1329 end;
1330 
TBGLCustomFont.GetPaddingnull1331 function TBGLCustomFont.GetPadding: TRectF;
1332 begin
1333   result := FPadding;
1334 end;
1335 
1336 procedure TBGLCustomFont.Init;
1337 begin
1338   FScale:= 1;
1339   FStepX:= 0;
1340   FHorizontalAlign:= taLeftJustify;
1341   FVerticalAlign:= tlTop;
1342   FJustify:= false;
1343   FPadding := RectF(1,1,1,1);
1344 end;
1345 
1346 procedure TBGLCustomFont.FreeMemoryOnDestroy;
1347 begin
1348   FreeMemory;
1349 end;
1350 
1351 procedure TBGLCustomFont.FreeMemory;
1352 begin
1353 
1354 end;
1355 
1356 constructor TBGLCustomFont.Create(AFilename: UTF8String);
1357 begin
1358   Init;
1359   LoadFromFile(AFilename);
1360 end;
1361 
1362 destructor TBGLCustomFont.Destroy;
1363 begin
1364   FreeMemoryOnDestroy;
1365   inherited Destroy;
1366 end;
1367 
1368 procedure TBGLCustomFont.TextOut(X, Y: Single; const Text: UTF8String);
1369 begin
1370   DoTextOut(X,Y,Text,GetDefaultColor);
1371 end;
1372 
1373 procedure TBGLCustomFont.TextOut(X, Y: Single; const Text: UTF8String;
1374   AColor: TBGRAPixel);
1375 begin
1376   DoTextOut(X,Y,Text,AColor);
1377 end;
1378 
1379 procedure TBGLCustomFont.TextOut(X, Y: Single; const Text: UTF8String;
1380   AHorizAlign: TAlignment; AVertAlign: TTextLayout);
1381 begin
1382   TextOut(X,Y,Text,AHorizAlign,AVertAlign,GetDefaultColor);
1383 end;
1384 
1385 procedure TBGLCustomFont.TextOut(X, Y: Single; const Text: UTF8String;
1386   AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel);
1387 var PrevHorizAlign: TAlignment;
1388     PrevVertAlign: TTextLayout;
1389 begin
1390   PrevHorizAlign:= GetHorizontalAlign;
1391   PrevVertAlign:= GetVerticalAlign;
1392   SetHorizontalAlign(AHorizAlign);
1393   SetVerticalAlign(AVertAlign);
1394   DoTextOut(X,Y,Text,AColor);
1395   SetHorizontalAlign(PrevHorizAlign);
1396   SetVerticalAlign(PrevVertAlign);
1397 end;
1398 
1399 procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single;
1400   const Text: UTF8String);
1401 begin
1402   DoTextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,GetDefaultColor);
1403 end;
1404 
1405 procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single;
1406   const Text: UTF8String; AColor: TBGRAPixel);
1407 begin
1408   DoTextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AColor);
1409 end;
1410 
1411 procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single;
1412   const Text: UTF8String; AVertAlign: TTextLayout);
1413 begin
1414   TextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AVertAlign,GetDefaultColor);
1415 end;
1416 
1417 procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single;
1418   const Text: UTF8String; AVertAlign: TTextLayout; AColor: TBGRAPixel);
1419 var PrevVertAlign: TTextLayout;
1420 begin
1421   PrevVertAlign:= GetVerticalAlign;
1422   SetVerticalAlign(AVertAlign);
1423   DoTextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AColor);
1424   SetVerticalAlign(PrevVertAlign);
1425 end;
1426 
1427 procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single;
1428   const Text: UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout);
1429 begin
1430   TextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AHorizAlign,AVertAlign,GetDefaultColor);
1431 end;
1432 
1433 procedure TBGLCustomFont.TextRect(X, Y, Width, Height: Single;
1434   const Text: UTF8String; AHorizAlign: TAlignment; AVertAlign: TTextLayout;
1435   AColor: TBGRAPixel);
1436 var PrevHorizAlign: TAlignment;
1437     PrevVertAlign: TTextLayout;
1438     PrevJustify: boolean;
1439 begin
1440   PrevHorizAlign:= GetHorizontalAlign;
1441   PrevVertAlign:= GetVerticalAlign;
1442   PrevJustify := GetJustify;
1443   SetHorizontalAlign(AHorizAlign);
1444   SetVerticalAlign(AVertAlign);
1445   SetJustify(False);
1446   DoTextRect(X+Padding.Left,Y+Padding.Top,Width-Padding.Left-Padding.Right,Height-Padding.Top-Padding.Bottom,Text,AColor);
1447   SetHorizontalAlign(PrevHorizAlign);
1448   SetVerticalAlign(PrevVertAlign);
1449   SetJustify(PrevJustify);
1450 end;
1451 
1452 procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String);
1453 begin
1454   SwapRectIfNeeded(ARect);
1455   with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text);
1456 end;
1457 
1458 procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String;
1459   AColor: TBGRAPixel);
1460 begin
1461   SwapRectIfNeeded(ARect);
1462   with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text,
1463     AColor);
1464 end;
1465 
1466 procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String;
1467   AVertAlign: TTextLayout);
1468 begin
1469   SwapRectIfNeeded(ARect);
1470   with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text,
1471     AVertAlign);
1472 end;
1473 
1474 procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String;
1475   AVertAlign: TTextLayout; AColor: TBGRAPixel);
1476 begin
1477   SwapRectIfNeeded(ARect);
1478   with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text,
1479     AVertAlign, AColor);
1480 end;
1481 
1482 procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String;
1483   AHorizAlign: TAlignment; AVertAlign: TTextLayout);
1484 begin
1485   SwapRectIfNeeded(ARect);
1486   with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text,
1487     AHorizAlign, AVertAlign);
1488 end;
1489 
1490 procedure TBGLCustomFont.TextRect(ARect: TRect; const Text: UTF8String;
1491   AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel);
1492 begin
1493   SwapRectIfNeeded(ARect);
1494   with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text,
1495     AHorizAlign, AVertAlign, AColor);
1496 end;
1497 
1498 procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String);
1499 begin
1500   SwapRectIfNeeded(ARect);
1501   with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text);
1502 end;
1503 
1504 procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String;
1505   AColor: TBGRAPixel);
1506 begin
1507   SwapRectIfNeeded(ARect);
1508   with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text,
1509     AColor);
1510 end;
1511 
1512 procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String;
1513   AVertAlign: TTextLayout);
1514 begin
1515   SwapRectIfNeeded(ARect);
1516   with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text,
1517     AVertAlign);
1518 end;
1519 
1520 procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String;
1521   AVertAlign: TTextLayout; AColor: TBGRAPixel);
1522 begin
1523   SwapRectIfNeeded(ARect);
1524   with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text,
1525     AVertAlign, AColor);
1526 end;
1527 
1528 procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String;
1529   AHorizAlign: TAlignment; AVertAlign: TTextLayout);
1530 begin
1531   SwapRectIfNeeded(ARect);
1532   with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text,
1533     AHorizAlign, AVertAlign);
1534 end;
1535 
1536 procedure TBGLCustomFont.TextRect(ARect: TRectF; const Text: UTF8String;
1537   AHorizAlign: TAlignment; AVertAlign: TTextLayout; AColor: TBGRAPixel);
1538 begin
1539   SwapRectIfNeeded(ARect);
1540   with ARect do TextRect(Left,Top,Right-Left,Bottom-Top,Text,
1541     AHorizAlign, AVertAlign, AColor);
1542 end;
1543 
1544 { TBGLCustomBitmap }
1545 
1546 procedure TBGLCustomBitmap.Init;
1547 begin
1548   inherited Init;
1549   FTextureInvalidated := true;
1550   FActualRect := rect(0,0,0,0);
1551   FScanWidth := 0;
1552   FScanHeight:= 0;
1553   FTexture := nil;
1554   FLineOrder := riloTopToBottom;
1555 end;
1556 
GetTexturenull1557 function TBGLCustomBitmap.GetTexture: IBGLTexture;
1558 begin
1559   if (Width = 0) or (Height = 0) then
1560     result := BGLTextureFactory.Create
1561   else
1562   begin
1563     if FTextureInvalidated then
1564     begin
1565       FTextureInvalidated := false;
1566       if not TBGRAPixel_RGBAOrder and not BGLTextureFactory.SupportsBGRAOrder then SwapRedBlueWithoutInvalidate(Rect(0,0,Width,Height));
1567       if FTexture = nil then
1568         FTexture := BGLTextureFactory.Create(PLongWord(self.Data), AllocatedWidth,AllocatedHeight, Width,Height, TBGRAPixel_RGBAOrder or not BGLTextureFactory.SupportsBGRAOrder)
1569       else
1570         FTexture.Update(PLongWord(self.Data), AllocatedWidth,AllocatedHeight, Width,Height, TBGRAPixel_RGBAOrder or not BGLTextureFactory.SupportsBGRAOrder);
1571       if not TBGRAPixel_RGBAOrder and not BGLTextureFactory.SupportsBGRAOrder then SwapRedBlueWithoutInvalidate(Rect(0,0,Width,Height));
1572     end;
1573     result := FTexture;
1574   end;
1575 end;
1576 
1577 procedure TBGLCustomBitmap.NotifySizeTooBigForOpenGL;
1578 begin
1579   raise exception.Create('Size too big for OpenGL');
1580 end;
1581 
1582 procedure TBGLCustomBitmap.NotifyOpenGLContextNotCreatedYet;
1583 begin
1584   raise exception.Create('OpenGL context has not been created yet');
1585 end;
1586 
TBGLCustomBitmap.GetTextureGLnull1587 function TBGLCustomBitmap.GetTextureGL: IUnknown;
1588 begin
1589   Result:=GetTexture;
1590 end;
1591 
1592 procedure TBGLCustomBitmap.SwapRedBlueWithoutInvalidate(ARect: TRect);
1593 var y: Int32or64;
1594     p: PBGRAPixel;
1595 begin
1596   if not CheckClippedRectBounds(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom) then exit;
1597   for y := ARect.Top to ARect.Bottom-1 do
1598   begin
1599     p := GetScanlineFast(y)+ARect.Left;
1600     TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(p,p, ARect.Right-ARect.Left, False);
1601   end;
1602 end;
1603 
1604 procedure TBGLCustomBitmap.InvalidateBitmap;
1605 begin
1606   inherited InvalidateBitmap;
1607   FTextureInvalidated := true;
1608 end;
1609 
1610 procedure TBGLCustomBitmap.Fill(const c: TBGRAPixel);
1611 var oldClip: TRect;
1612 begin
1613   oldClip := ClipRect;
1614   NoClip;
1615   FillRect(ClipRect, c, dmSet);
1616   ClipRect := oldClip;
1617 end;
1618 
1619 procedure TBGLCustomBitmap.NoClip;
1620 begin
1621   ClipRect := FActualRect;
1622 end;
1623 
1624 destructor TBGLCustomBitmap.Destroy;
1625 begin
1626   if FTexture <> nil then
1627   begin
1628     //always free the memory of the texture
1629     FTexture.FreeMemory;
1630     FTexture := nil;
1631   end;
1632   inherited Destroy;
1633 end;
1634 
1635 procedure TBGLCustomBitmap.SwapRedBlue;
1636 var previousClip : TRect;
1637 begin
1638   previousClip := ClipRect;
1639   NoClip;
1640   SwapRedBlue(rect(0,0,Width,Height));
1641   ClipRect := previousClip;
1642 end;
1643 
Resamplenull1644 function TBGLCustomBitmap.Resample(newWidth, newHeight: integer;
1645   mode: TResampleMode): TBGLCustomBitmap;
1646 var temp,resampled: TBGRACustomBitmap;
1647 begin
1648   temp := TBGRABitmap.Create(FActualWidth,FActualHeight);
1649   temp.PutImage(-FActualRect.Left,-FActualRect.Top, self, dmSet);
1650   temp.ResampleFilter := ResampleFilter;
1651   resampled := temp.Resample(NewWidth,NewHeight,mode);
1652   temp.Free;
1653   Result:= NewBitmap(resampled) as TBGLCustomBitmap;
1654   resampled.Free;
1655 end;
1656 
1657 procedure TBGLCustomBitmap.ApplyGlobalOpacity(alpha: byte);
1658 var oldClip: TRect;
1659 begin
1660   oldClip := ClipRect;
1661   NoClip;
1662   ApplyGlobalOpacity(FActualRect,alpha);
1663   ClipRect := oldClip;
1664 end;
1665 
1666 procedure TBGLCustomBitmap.ReplaceColor(before, after: TColor);
1667 var oldClip: TRect;
1668 begin
1669   oldClip := ClipRect;
1670   NoClip;
1671   ReplaceColor(FActualRect, before, after);
1672   ClipRect := oldClip;
1673 end;
1674 
1675 procedure TBGLCustomBitmap.ReplaceColor(const ABefore, AAfter: TBGRAPixel);
1676 var oldClip: TRect;
1677 begin
1678   oldClip := ClipRect;
1679   NoClip;
1680   ReplaceColor(FActualRect, ABefore, AAfter);
1681   ClipRect := oldClip;
1682 end;
1683 
1684 procedure TBGLCustomBitmap.ReplaceTransparent(const AAfter: TBGRAPixel);
1685 var oldClip: TRect;
1686 begin
1687   oldClip := ClipRect;
1688   NoClip;
1689   ReplaceTransparent(FActualRect,AAfter);
1690   ClipRect := oldClip;
1691 end;
1692 
1693 procedure TBGLCustomBitmap.SetClipRect(const AValue: TRect);
1694 var r: TRect;
1695 begin
1696   r := TRect.Intersect(AValue, FActualRect);
1697   inherited SetClipRect(r);
1698 end;
1699 
1700 procedure TBGLCustomBitmap.SetSize(AWidth, AHeight: integer);
1701 var AllocatedWidthNeeded,AllocatedHeightNeeded,
1702     MaxTexSize: Integer;
1703 begin
1704   if AWidth < 0 then AWidth := 0;
1705   if AHeight < 0 then AHeight := 0;
1706   if (AWidth = Width) and (AHeight = Height) then exit;
1707   AllocatedWidthNeeded := GetPowerOfTwo(AWidth);
1708   AllocatedHeightNeeded := GetPowerOfTwo(AHeight);
1709   MaxTexSize := GetOpenGLMaxTexSize;
1710   if (AllocatedWidthNeeded > MaxTexSize) or
1711      (AllocatedHeightNeeded > MaxTexSize) then
1712   begin
1713     if MaxTexSize = 0 then
1714       NotifyOpenGLContextNotCreatedYet
1715     else
1716       NotifySizeTooBigForOpenGL;
1717     if AllocatedWidthNeeded > MaxTexSize then
1718     begin
1719       AllocatedWidthNeeded := MaxTexSize;
1720       AWidth := MaxTexSize;
1721     end;
1722     if AllocatedHeightNeeded > MaxTexSize then
1723     begin
1724       AllocatedHeightNeeded := MaxTexSize;
1725       AHeight := MaxTexSize;
1726     end;
1727   end;
1728   FActualWidth := AWidth;
1729   FActualHeight := AHeight;
1730   FAllocatedWidth := AllocatedWidthNeeded;
1731   FAllocatedHeight := AllocatedHeightNeeded;
1732   FActualRect := rect(0,0,FActualWidth,FActualHeight);
1733   if (FAllocatedWidth <> inherited Width) or
1734      (FAllocatedHeight <> inherited Height) then
1735     inherited SetSize(FAllocatedWidth, FAllocatedHeight);
1736   inherited NoClip;
1737   inherited FillRect(Width,0,FAllocatedWidth,Height, BGRAPixelTransparent, dmSet);
1738   inherited FillRect(0,Height,FAllocatedWidth,FAllocatedHeight, BGRAPixelTransparent, dmSet);
1739   NoClip;
1740   FScanWidth := Width;
1741   FScanHeight:= Height;
1742   FTextureInvalidated:= true;
1743 end;
1744 
MakeTextureAndFreenull1745 function TBGLCustomBitmap.MakeTextureAndFree: IBGLTexture;
1746 begin
1747   result := Texture;
1748   FTexture := nil;
1749   Free;
1750 end;
1751 
1752 end.
1753 
1754