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