opengl
/
OpenGLCore
1
0
Fork 0
Code Issues 0 Pull Requests 0 Releases 0 Wiki Activity
Browse Source

* added LazIntfImage Support

master
Bergmann89 10 years ago
parent
ecbecb3fd9
commit
5707b04adc
1 changed files with 271 additions and 235 deletions
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +271
    -235
      glBitmap.pas

+ 271
- 235
glBitmap.pas View File

@@ -218,9 +218,9 @@ History
***********************************************************}
unit glBitmap;

{.$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}
// Please uncomment the defines below to configure the glBitmap to your preferences.
// If you have configured the unit you can uncomment the warning above.
{$MESSAGE warn 'Hey. I''m the glBitmap.pas and i need to be configured. My master tell me your preferences! ;)'}

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Preferences ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -233,28 +233,33 @@ unit glBitmap;
// use dglOpenGL.pas if not enabled
{.$DEFINE GLB_NATIVE_OGL_DYNAMIC}


// activate to enable the support for SDL_surfaces
{.$DEFINE GLB_SDL}

// activate to enable the support for TBitmap from Delphi (not lazarus)
{.$DEFINE GLB_DELPHI}

// activate to enable the support for TLazIntfImage from Lazarus
{$DEFINE GLB_LAZARUS}


//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// activate to enable the support of SDL_image to load files. (READ ONLY)
// If you enable SDL_image all other libraries will be ignored!
{.$DEFINE GLB_SDL_IMAGE}

// PNG /////////////////////////////////////////////////////////////////////////////////////////////


// activate to enable png support with the unit pngimage -> http://pngdelphi.sourceforge.net/
// if you enable pngimage the libPNG will be ignored
{$DEFINE GLB_PNGIMAGE}
{.$DEFINE GLB_PNGIMAGE}

// activate to use the libPNG -> http://www.libpng.org/
// You will need an aditional header -> http://www.opengl24.de/index.php?cat=header&file=libpng
{.$DEFINE GLB_LIB_PNG}

// JPEG ////////////////////////////////////////////////////////////////////////////////////////////


// if you enable delphi jpegs the libJPEG will be ignored
{.$DEFINE GLB_DELPHI_JPEG}

@@ -285,12 +290,12 @@ unit glBitmap;
{$DEFINE GLB_WIN}
{$ELSEIF DEFINED(LINUX)}
{$DEFINE GLB_LINUX}
{$IFEND}
{$ENDIF}

// native OpenGL Support
{$IF DEFINED(GLB_NATIVE_OGL_STATIC) OR DEFINED(GLB_NATIVE_OGL_DYNAMIC)}
{$DEFINE GLB_NATIVE_OGL}
{$IFEND}
{$ENDIF}

// checking define combinations
//SDL Image
@@ -370,20 +375,21 @@ unit glBitmap;
interface

uses
{$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
{$IFNDEF GLB_NATIVE_OGL} dglOpenGL, {$ENDIF}
{$IF DEFINED(GLB_WIN) AND
DEFINED(GLB_NATIVE_OGL)} windows, {$IFEND}
DEFINED(GLB_NATIVE_OGL)} windows, {$ENDIF}

{$IFDEF GLB_SDL} SDL, {$ENDIF}
{$IFDEF GLB_DELPHI} Dialogs, Graphics, {$ENDIF}
{$IFDEF GLB_SDL} SDL, {$ENDIF}
{$IFDEF GLB_LAZARUS} IntfGraphics, GraphType, {$ENDIF}
{$IFDEF GLB_DELPHI} Dialogs, Graphics, {$ENDIF}

{$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}
{$IFDEF GLB_SDL_IMAGE} SDL_image, {$ENDIF}

{$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
{$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}
{$IFDEF GLB_PNGIMAGE} pngimage, {$ENDIF}
{$IFDEF GLB_LIB_PNG} libPNG, {$ENDIF}

{$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
{$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}
{$IFDEF GLB_DELPHI_JPEG} JPEG, {$ENDIF}
{$IFDEF GLB_LIB_JPEG} libJPEG, {$ENDIF}

Classes, SysUtils;

@@ -575,8 +581,9 @@ type

{$IFDEF GLB_LINUX}
TglXGetProcAddress = function(ProcName: PAnsiChar): Pointer; cdecl;
TglXGetProcAddressARB = function(const name: PAnsiChar): pointer; cdecl;
{$ELSE}
TwglGetProcAddress = function (ProcName: PAnsiChar): Pointer; stdcall;
TwglGetProcAddress = function(ProcName: PAnsiChar): Pointer; stdcall;
{$ENDIF}

{$ELSEIF DEFINED(GLB_NATIVE_OGL_STATIC)}
@@ -768,7 +775,8 @@ type
EglBitmapSizeToLargeException = class(EglBitmapException);
EglBitmapNonPowerOfTwoException = class(EglBitmapException);
EglBitmapUnsupportedFormat = class(EglBitmapException)
constructor Create(const aFormat: TglBitmapFormat);
constructor Create(const aFormat: TglBitmapFormat); overload;
constructor Create(const aMsg: String; const aFormat: TglBitmapFormat); overload;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -895,15 +903,15 @@ type
procedure AfterConstruction; override;
procedure BeforeDestruction; override;

procedure PrepareResType(var aResource: String; var aResType: PChar);

//Load
procedure LoadFromFile(const aFilename: String);
procedure LoadFromStream(const aStream: TStream); virtual;
procedure LoadFromFunc(const aSize: TglBitmapPixelPosition; const aFunc: TglBitmapFunction;
const aFormat: TglBitmapFormat; const aArgs: Pointer = nil);
{$IFDEF GLB_DELPHI}
procedure LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
procedure LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
{$ENDIF}
procedure LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil);
procedure LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);

//Save
procedure SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
@@ -929,11 +937,20 @@ type
function AssignAlphaToBitmap(const aBitmap: TBitmap): Boolean;
function AddAlphaFromBitmap(const aBitmap: TBitmap; const aFunc: TglBitmapFunction = nil;
const aArgs: Pointer = nil): Boolean;
function AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil;
{$ENDIF}

{$IFDEF GLB_LAZARUS}
function AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
function AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
function AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
function AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction = nil;
const aArgs: Pointer = nil): Boolean;
{$ENDIF}

function AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar = nil;
const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
function AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
{$ENDIF}

function AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer = nil): Boolean; virtual;
function AddAlphaFromFile(const aFileName: String; const aFunc: TglBitmapFunction = nil; const aArgs: Pointer = nil): Boolean;
@@ -978,10 +995,8 @@ type
constructor Create(const aStream: TStream); overload;
constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat); overload;
constructor Create(const aSize: TglBitmapPixelPosition; const aFormat: TglBitmapFormat; const aFunc: TglBitmapFunction; const aArgs: Pointer = nil); overload;
{$IFDEF GLB_DELPHI}
constructor Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil); overload;
constructor Create(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar); overload;
{$ENDIF}
private
{$IFDEF GLB_SUPPORT_PNG_READ} function LoadPNG(const aStream: TStream): Boolean; virtual; {$ENDIF}
{$ifdef GLB_SUPPORT_PNG_WRITE} procedure SavePNG(const aStream: TStream); virtual; {$ENDIF}
@@ -1005,15 +1020,6 @@ type
// Bildeinstellungen
fLines: array of PByte;

(* TODO
procedure GetDXTColorBlock(pData: pByte; relX, relY: Integer; var Pixel: TglBitmapPixelData);
procedure GetPixel2DDXT1(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
procedure GetPixel2DDXT3(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
procedure GetPixel2DDXT5(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
procedure GetPixel2DUnmap(const Pos: TglBitmapPixelPosition; var Pixel: TglBitmapPixelData);
procedure SetPixel2DUnmap(const Pos: TglBitmapPixelPosition; const Pixel: TglBitmapPixelData);
*)

function GetScanline(const aIndex: Integer): Pointer;
procedure SetDataPointer(const aData: PByte; const aFormat: TglBitmapFormat;
const aWidth: Integer = - 1; const aHeight: Integer = - 1); override;
@@ -1122,15 +1128,6 @@ function CreateGrayPalette: HPALETTE;

implementation


(* TODO
function FormatIsCompressed(Format: TglBitmapInternalFormat): boolean;
function FormatIsUncompressed(Format: TglBitmapInternalFormat): boolean;
function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal = 0{$ENDIF}): Boolean;
function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
*)

uses
Math, syncobjs, typinfo;

@@ -1663,6 +1660,12 @@ begin
inherited Create('unsupported format: ' + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EglBitmapUnsupportedFormat.Create(const aMsg: String; const aFormat: TglBitmapFormat);
begin
inherited Create(aMsg + GetEnumName(TypeInfo(TglBitmapFormat), Integer(aFormat)));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function glBitmapPosition(X, Y: Integer): TglBitmapPixelPosition;
begin
@@ -2154,127 +2157,6 @@ begin
end;
{$ENDIF}

(* TODO LoadFuncs
function LoadTexture(Filename: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
var
glBitmap: TglBitmap2D;
begin
result := false;
Texture := 0;

{$IFDEF GLB_DELPHI}
if Instance = 0 then
Instance := HInstance;

if (LoadFromRes) then
glBitmap := TglBitmap2D.CreateFromResourceName(Instance, FileName)
else
{$ENDIF}
glBitmap := TglBitmap2D.Create(FileName);

try
glBitmap.DeleteTextureOnFree := false;
glBitmap.FreeDataAfterGenTexture := false;
glBitmap.GenTexture(true);
if (glBitmap.ID > 0) then begin
Texture := glBitmap.ID;
result := true;
end;
finally
glBitmap.Free;
end;
end;

function LoadCubeMap(PositiveX, NegativeX, PositiveY, NegativeY, PositiveZ, NegativeZ: String; var Texture: Cardinal{$IFDEF GLB_DELPHI}; LoadFromRes : Boolean; Instance: Cardinal{$ENDIF}): Boolean;
var
CM: TglBitmapCubeMap;
begin
Texture := 0;

{$IFDEF GLB_DELPHI}
if Instance = 0 then
Instance := HInstance;
{$ENDIF}

CM := TglBitmapCubeMap.Create;
try
CM.DeleteTextureOnFree := false;

// Maps
{$IFDEF GLB_DELPHI}
if (LoadFromRes) then
CM.LoadFromResource(Instance, PositiveX)
else
{$ENDIF}
CM.LoadFromFile(PositiveX);
CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_X);

{$IFDEF GLB_DELPHI}
if (LoadFromRes) then
CM.LoadFromResource(Instance, NegativeX)
else
{$ENDIF}
CM.LoadFromFile(NegativeX);
CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_X);

{$IFDEF GLB_DELPHI}
if (LoadFromRes) then
CM.LoadFromResource(Instance, PositiveY)
else
{$ENDIF}
CM.LoadFromFile(PositiveY);
CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Y);

{$IFDEF GLB_DELPHI}
if (LoadFromRes) then
CM.LoadFromResource(Instance, NegativeY)
else
{$ENDIF}
CM.LoadFromFile(NegativeY);
CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Y);

{$IFDEF GLB_DELPHI}
if (LoadFromRes) then
CM.LoadFromResource(Instance, PositiveZ)
else
{$ENDIF}
CM.LoadFromFile(PositiveZ);
CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_POSITIVE_Z);

{$IFDEF GLB_DELPHI}
if (LoadFromRes) then
CM.LoadFromResource(Instance, NegativeZ)
else
{$ENDIF}
CM.LoadFromFile(NegativeZ);
CM.GenerateCubeMap(GL_TEXTURE_CUBE_MAP_NEGATIVE_Z);

Texture := CM.ID;
result := true;
finally
CM.Free;
end;
end;

function LoadNormalMap(Size: Integer; var Texture: Cardinal): Boolean;
var
NM: TglBitmapNormalMap;
begin
Texture := 0;

NM := TglBitmapNormalMap.Create;
try
NM.DeleteTextureOnFree := false;
NM.GenerateNormalMap(Size);

Texture := NM.ID;
result := true;
finally
NM.Free;
end;
end;
*)

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure glBitmapSetDefaultDeleteTextureOnFree(const aDeleteTextureOnFree: Boolean);
begin
@@ -2440,10 +2322,8 @@ end;
function TFormatDescriptor.MaskMatch(const aRedMask, aGreenMask, aBlueMask, aAlphaMask: QWord): Boolean;
begin
result := false;

if (aRedMask = 0) and (aGreenMask = 0) and (aBlueMask = 0) and (aAlphaMask = 0) then
raise EglBitmapException.Create('FormatCheckFormat - All Masks are 0');

if (aRedMask <> RedMask) then
exit;
if (aGreenMask <> GreenMask) then
@@ -2500,7 +2380,7 @@ begin
aPixel.Data.g := 0;
aPixel.Data.b := 0;
aPixel.Data.a := aData^;
inc(aData^);
inc(aData);
end;

constructor TfdAlpha_UB1.Create;
@@ -3952,7 +3832,7 @@ begin
f := fPixelSize - s;
bits := Round(8 * f);
case s of
0: idx := (aData^ shr (8 - bits - {%H-}PtrUInt(aMapData))) and ((1 shl bits) - 1);
0: idx := (aData^ shr (8 - bits - {%H-}PtrInt(aMapData))) and ((1 shl bits) - 1);
1: idx := aData^;
2: idx := PWord(aData)^;
4: idx := PCardinal(aData)^;
@@ -4373,6 +4253,18 @@ begin
inherited BeforeDestruction;
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TglBitmap.PrepareResType(var aResource: String; var aResType: PChar);
var
TempPos: Integer;
begin
if not Assigned(aResType) then begin
TempPos := Pos('.', aResource);
aResType := PChar(UpperCase(Copy(aResource, TempPos + 1, Length(aResource) - TempPos)));
aResource := UpperCase(Copy(aResource, 0, TempPos -1));
end;
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TglBitmap.LoadFromFile(const aFilename: String);
var
@@ -4424,24 +4316,13 @@ begin
AddFunc(Self, aFunc, false, Format, aArgs);
end;

{$IFDEF GLB_DELPHI}
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar = nil);
procedure TglBitmap.LoadFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar);
var
rs: TResourceStream;
TempPos: Integer;
ResTypeStr: String;
TempResType: PChar;
begin
if not Assigned(ResType) then begin
TempPos := Pos('.', Resource);
ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
Resource := UpperCase(Copy(Resource, 0, TempPos -1));
TempResType := PChar(ResTypeStr);
end else
TempResType := ResType

rs := TResourceStream.Create(Instance, Resource, TempResType);
begin
PrepareResType(aResource, aResType);
rs := TResourceStream.Create(aInstance, aResource, aResType);
try
LoadFromStream(rs);
finally
@@ -4450,18 +4331,17 @@ begin
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TglBitmap.LoadFromResourceID(const sInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
procedure TglBitmap.LoadFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar);
var
rs: TResourceStream;
begin
rs := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
try
LoadFromStream(rs);
finally
rs.Free;
end;
end;
{$ENDIF}

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TglBitmap.SaveToFile(const aFileName: String; const aFileType: TglBitmapFileType);
@@ -4519,6 +4399,11 @@ begin
SourceFD := TFormatDescriptor.Get(aSource.Format);
DestFD := TFormatDescriptor.Get(aFormat);

if (SourceFD.IsCompressed) then
raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', SourceFD.Format);
if (DestFD.IsCompressed) then
raise EglBitmapUnsupportedFormat.Create('compressed formats are not supported: ', DestFD.Format);

// inkompatible Formats so CreateTemp
if (SourceFD.PixelSize <> DestFD.PixelSize) then
aCreateTemp := true;
@@ -4532,7 +4417,7 @@ begin

TmpData := nil;
if aCreateTemp then begin
GetMem(TmpData, TFormatDescriptor.Get(aFormat).GetSize(TempWidth, TempHeight));
GetMem(TmpData, DestFD.GetSize(TempWidth, TempHeight));
DestData := TmpData;
end else
DestData := Data;
@@ -4897,49 +4782,220 @@ begin
tex.Free;
end;
end;
{$ENDIF}

{$IFDEF GLB_LAZARUS}
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; const aResource: String; const aResType: PChar;
const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
function TglBitmap.AssignToLazIntfImage(const aImage: TLazIntfImage): Boolean;
var
RS: TResourceStream;
TempPos: Integer;
ResTypeStr: String;
TempResType: PChar;
rid: TRawImageDescription;
FormatDesc: TFormatDescriptor;
begin
if Assigned(ResType) then
TempResType := ResType
result := false;
if not Assigned(aImage) or (Format = tfEmpty) then
exit;
FormatDesc := TFormatDescriptor.Get(Format);
if FormatDesc.IsCompressed then
exit;

FillChar(rid{%H-}, SizeOf(rid), 0);
if (Format in [
tfAlpha4, tfAlpha8, tfAlpha12, tfAlpha16,
tfLuminance4, tfLuminance8, tfLuminance12, tfLuminance16,
tfLuminance4Alpha4, tfLuminance8Alpha8, tfLuminance12Alpha4, tfLuminance12Alpha12, tfLuminance16Alpha16]) then
rid.Format := ricfGray
else
begin
TempPos := Pos('.', Resource);
ResTypeStr := UpperCase(Copy(Resource, TempPos + 1, Length(Resource) - TempPos));
Resource := UpperCase(Copy(Resource, 0, TempPos -1));
TempResType := PChar(ResTypeStr);
end;
rid.Format := ricfRGBA;

rid.Width := Width;
rid.Height := Height;
rid.Depth := CountSetBits(FormatDesc.Range.r or FormatDesc.Range.g or FormatDesc.Range.b or FormatDesc.Range.a);
rid.BitOrder := riboBitsInOrder;
rid.ByteOrder := riboLSBFirst;
rid.LineOrder := riloTopToBottom;
rid.LineEnd := rileTight;
rid.BitsPerPixel := Round(8 * FormatDesc.PixelSize);
rid.RedPrec := CountSetBits(FormatDesc.Range.r);
rid.GreenPrec := CountSetBits(FormatDesc.Range.g);
rid.BluePrec := CountSetBits(FormatDesc.Range.b);
rid.AlphaPrec := CountSetBits(FormatDesc.Range.a);
rid.RedShift := FormatDesc.Shift.r;
rid.GreenShift := FormatDesc.Shift.g;
rid.BlueShift := FormatDesc.Shift.b;
rid.AlphaShift := FormatDesc.Shift.a;

rid.MaskBitsPerPixel := 0;
rid.PaletteColorCount := 0;

aImage.DataDescription := rid;
aImage.CreateData;

Move(Data^, aImage.PixelData^, FormatDesc.GetSize(Dimension));

result := true;
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TglBitmap.AssignFromLazIntfImage(const aImage: TLazIntfImage): Boolean;
var
f: TglBitmapFormat;
FormatDesc: TFormatDescriptor;
ImageData: PByte;
ImageSize: Integer;
begin
result := false;
if not Assigned(aImage) then
exit;
for f := High(f) downto Low(f) do begin
FormatDesc := TFormatDescriptor.Get(f);
with aImage.DataDescription do
if FormatDesc.MaskMatch(
(QWord(1 shl RedPrec )-1) shl RedShift,
(QWord(1 shl GreenPrec)-1) shl GreenShift,
(QWord(1 shl BluePrec )-1) shl BlueShift,
(QWord(1 shl AlphaPrec)-1) shl AlphaShift) then
break;
end;

if (f = tfEmpty) then
exit;

ImageSize := FormatDesc.GetSize(aImage.Width, aImage.Height);
ImageData := GetMem(ImageSize);
try
Move(aImage.PixelData^, ImageData^, (aImage.Width * aImage.Height * aImage.DataDescription.BitsPerPixel) shr 3);
SetDataPointer(ImageData, f, aImage.Width, aImage.Height);
except
FreeMem(ImageData);
raise;
end;

result := true;
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TglBitmap.AssignAlphaToLazIntfImage(const aImage: TLazIntfImage): Boolean;
var
rid: TRawImageDescription;
FormatDesc: TFormatDescriptor;
Pixel: TglBitmapPixelData;
x, y: Integer;
srcMD: Pointer;
src, dst: PByte;
begin
result := false;
if not Assigned(aImage) or (Format = tfEmpty) then
exit;
FormatDesc := TFormatDescriptor.Get(Format);
if FormatDesc.IsCompressed or not FormatDesc.HasAlpha then
exit;

RS := TResourceStream.Create(Instance, Resource, TempResType);
FillChar(rid{%H-}, SizeOf(rid), 0);
rid.Format := ricfGray;
rid.Width := Width;
rid.Height := Height;
rid.Depth := CountSetBits(FormatDesc.Range.a);
rid.BitOrder := riboBitsInOrder;
rid.ByteOrder := riboLSBFirst;
rid.LineOrder := riloTopToBottom;
rid.LineEnd := rileTight;
rid.BitsPerPixel := 8 * Ceil(rid.Depth / 8);
rid.RedPrec := CountSetBits(FormatDesc.Range.a);
rid.GreenPrec := 0;
rid.BluePrec := 0;
rid.AlphaPrec := 0;
rid.RedShift := 0;
rid.GreenShift := 0;
rid.BlueShift := 0;
rid.AlphaShift := 0;

rid.MaskBitsPerPixel := 0;
rid.PaletteColorCount := 0;

aImage.DataDescription := rid;
aImage.CreateData;

srcMD := FormatDesc.CreateMappingData;
try
result := AddAlphaFromStream(RS, Func, CustomData);
FormatDesc.PreparePixel(Pixel);
src := Data;
dst := aImage.PixelData;
for y := 0 to Height-1 do
for x := 0 to Width-1 do begin
FormatDesc.Unmap(src, Pixel, srcMD);
case rid.BitsPerPixel of
8: begin
dst^ := Pixel.Data.a;
inc(dst);
end;
16: begin
PWord(dst)^ := Pixel.Data.a;
inc(dst, 2);
end;
24: begin
PByteArray(dst)^[0] := PByteArray(@Pixel.Data.a)^[0];
PByteArray(dst)^[1] := PByteArray(@Pixel.Data.a)^[1];
PByteArray(dst)^[2] := PByteArray(@Pixel.Data.a)^[2];
inc(dst, 3);
end;
32: begin
PCardinal(dst)^ := Pixel.Data.a;
inc(dst, 4);
end;
else
raise EglBitmapUnsupportedFormat.Create(Format);
end;
end;
finally
RS.Free;
FormatDesc.FreeMappingData(srcMD);
end;
result := true;
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
const aFunc: TglBitmapFunction; const aArgs: PtrInt): Boolean;
function TglBitmap.AddAlphaFromLazIntfImage(const aImage: TLazIntfImage; const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
var
RS: TResourceStream;
tex: TglBitmap2D;
begin
RS := TResourceStream.CreateFromID(Instance, ResourceID, ResType);
tex := TglBitmap2D.Create;
try
result := AddAlphaFromStream(RS, Func, CustomData);
tex.AssignFromLazIntfImage(aImage);
result := AddAlphaFromglBitmap(tex, aFunc, aArgs);
finally
RS.Free;
tex.Free;
end;
end;
{$ENDIF}

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TglBitmap.AddAlphaFromResource(const aInstance: Cardinal; aResource: String; aResType: PChar;
const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
var
rs: TResourceStream;
begin
PrepareResType(aResource, aResType);
rs := TResourceStream.Create(aInstance, aResource, aResType);
try
result := AddAlphaFromStream(rs, aFunc, aArgs);
finally
rs.Free;
end;
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TglBitmap.AddAlphaFromResourceID(const aInstance: Cardinal; const aResourceID: Integer; const aResType: PChar;
const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
var
rs: TResourceStream;
begin
rs := TResourceStream.CreateFromID(aInstance, aResourceID, aResType);
try
result := AddAlphaFromStream(rs, aFunc, aArgs);
finally
rs.Free;
end;
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TglBitmap.AddAlphaFromFunc(const aFunc: TglBitmapFunction; const aArgs: Pointer): Boolean;
begin
@@ -5463,7 +5519,6 @@ begin
LoadFromFunc(aSize, aFunc, aFormat, aArgs);
end;

{$IFDEF GLB_DELPHI}
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TglBitmap.Create(const aInstance: Cardinal; const aResource: String; const aResType: PChar);
begin
@@ -5477,7 +5532,6 @@ begin
Create;
LoadFromResourceID(aInstance, aResourceID, aResType);
end;
{$ENDIF}

{$IFDEF GLB_SUPPORT_PNG_READ}
{$IF DEFINED(GLB_SDL_IMAGE)}
@@ -5711,7 +5765,7 @@ begin
end;
end;
end;
{$IFEND}
{$ENDIF}
{$ENDIF}

{$IFDEF GLB_SUPPORT_PNG_WRITE}
@@ -5877,7 +5931,7 @@ begin
FreeAndNil(Png);
end;
end;
{$IFEND}
{$ENDIF}
{$ENDIF}

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -6186,7 +6240,7 @@ begin
end;
end;
end;
{$IFEND}
{$ENDIF}
{$ENDIF}

{$IFDEF GLB_SUPPORT_JPEG_WRITE}
@@ -7433,16 +7487,12 @@ begin
inherited SetDataPointer(aData, aFormat, aWidth, aHeight);

if not TFormatDescriptor.Get(aFormat).IsCompressed then begin
(* TODO PixelFuncs
fGetPixelFunc := GetPixel2DUnmap;
fSetPixelFunc := SetPixel2DUnmap;
*)
// Assigning Data
if Assigned(Data) then begin
SetLength(fLines, GetHeight);
LineWidth := Trunc(GetWidth * TFormatDescriptor.Get(Format).PixelSize);

for Idx := 0 to GetHeight -1 do begin
for Idx := 0 to GetHeight-1 do begin
fLines[Idx] := Data;
Inc(fLines[Idx], Idx * LineWidth);
end;
@@ -7450,20 +7500,6 @@ begin
else SetLength(fLines, 0);
end else begin
SetLength(fLines, 0);
(*
fSetPixelFunc := nil;

case Format of
ifDXT1:
fGetPixelFunc := GetPixel2DDXT1;
ifDXT3:
fGetPixelFunc := GetPixel2DDXT3;
ifDXT5:
fGetPixelFunc := GetPixel2DDXT5;
else
fGetPixelFunc := nil;
end;
*)
end;
end;



Write Preview
Loading…
Cancel
Save