Context Navigation

bgraopengltype.pas

Last change on this file was 2, checked in by chronos, 5 years ago
Source code taken from https://svn.zdechov.net/PascalClassLibrary/GraphicTest/ rev 543.
File size: 66.7 KB

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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: trunk/Packages/bgrabitmap/bgraopengltype.pas

Download in other formats: