opengl
/
glBitmap
1
0
Çatalla 0
Kod Konular 0 Değişiklik İstekleri 0 Sürümler 0 Wiki Aktivite
Kaynağa Gözat

* SaveBMP for all supported formats

master
Bergmann89 12 yıl önce
ebeveyn
27f2bb249b
işleme
7f2710a823
1 değiştirilmiş dosya ile 275 ekleme ve 124 silme
Görünümü Böl
Diff Seçenekleri
İstatistikleri Göster Yama Dosyasını İndir Diff Dosyasını İndir
  1. +275
    -124
      glBitmap.pas

+ 275
- 124
glBitmap.pas Dosyayı Görüntüle

@@ -1411,7 +1411,7 @@ type
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TBitfieldFormat = class(TFormatDescriptor)
TbmpBitfieldFormat = class(TFormatDescriptor)
private
procedure SetRedMask (const aValue: UInt64);
procedure SetGreenMask(const aValue: UInt64);
@@ -1432,17 +1432,21 @@ type
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TColorTableEnty = packed record
TbmpColorTableEnty = packed record
b, g, r, a: Byte;
end;
TColorTable = array of TColorTableEnty;
TColorTableFormat = class(TFormatDescriptor)
TbmpColorTable = array of TbmpColorTableEnty;
TbmpColorTableFormat = class(TFormatDescriptor)
private
fColorTable: TColorTable;
fColorTable: TbmpColorTable;
public
property PixelSize: Single read fPixelSize write fPixelSize;
property ColorTable: TColorTable read fColorTable write fColorTable;
property ColorTable: TbmpColorTable read fColorTable write fColorTable;
property Range: TglBitmapColorRec read fRange write fRange;
property Shift: TShiftRec read fShift write fShift;
property Format: TglBitmapFormat read fFormat write fFormat;

procedure CreateColorTable;

procedure Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer); override;
procedure Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer); override;
@@ -1549,11 +1553,41 @@ begin
result.a := a;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function glBitmapShiftRec(const r, g, b, a: Byte): TShiftRec;
begin
result.r := r;
result.g := g;
result.b := b;
result.a := a;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function FormatGetSupportedFiles(const aFormat: TglBitmapFormat): TglBitmapFileTypes;
begin
result := [ftDDS, ftTGA];

if (aFormat in [
//4 bbp
tfLuminance4,

//8bpp
tfR3G3B2, tfLuminance8,

//16bpp
tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4,

//24bpp
tfBGR8, tfRGB8,

//32bpp
tfRGB10, tfRGB10A2, tfRGBA8,
tfBGR10, tfBGR10A2, tfBGRA8]) then
result := result + [ftBMP];

//TODO Supported File Formats!
result := [ftDDS, ftTGA, ftBMP];
(*
{$IFDEF GLB_SUPPORT_PNG_WRITE}
if aFormat in [
@@ -3363,31 +3397,31 @@ end;
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TBitfieldFormat/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TBitfieldFormat.SetRedMask(const aValue: UInt64);
procedure TbmpBitfieldFormat.SetRedMask(const aValue: UInt64);
begin
Update(aValue, fRange.r, fShift.r);
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TBitfieldFormat.SetGreenMask(const aValue: UInt64);
procedure TbmpBitfieldFormat.SetGreenMask(const aValue: UInt64);
begin
Update(aValue, fRange.g, fShift.g);
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TBitfieldFormat.SetBlueMask(const aValue: UInt64);
procedure TbmpBitfieldFormat.SetBlueMask(const aValue: UInt64);
begin
Update(aValue, fRange.b, fShift.b);
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TBitfieldFormat.SetAlphaMask(const aValue: UInt64);
procedure TbmpBitfieldFormat.SetAlphaMask(const aValue: UInt64);
begin
Update(aValue, fRange.a, fShift.a);
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TBitfieldFormat.Update(aMask: UInt64; out aRange: Cardinal; out
procedure TbmpBitfieldFormat.Update(aMask: UInt64; out aRange: Cardinal; out
aShift: Byte);
begin
aShift := 0;
@@ -3409,7 +3443,7 @@ begin
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
procedure TbmpBitfieldFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
var
data: UInt64;
s: Integer;
@@ -3434,7 +3468,7 @@ begin
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TBitfieldFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
procedure TbmpBitfieldFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
var
data: UInt64;
s, i: Integer;
@@ -3458,12 +3492,90 @@ end;
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TColorTableFormat///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
procedure TbmpColorTableFormat.CreateColorTable;
var
bits: Byte;
len: Integer;
i: Integer;
begin
raise EglBitmapException.Create('mapping of color table formats is not supported');
if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
raise EglBitmapException.Create(UNSUPPORTED_FORMAT);

if (Format = tfLuminance4) then
SetLength(fColorTable, 16)
else
SetLength(fColorTable, 256);

case Format of
tfLuminance4: begin
for i := 0 to High(fColorTable) do begin
fColorTable[i].r := 16 * i;
fColorTable[i].g := 16 * i;
fColorTable[i].b := 16 * i;
fColorTable[i].a := 0;
end;
end;

tfLuminance8: begin
for i := 0 to High(fColorTable) do begin
fColorTable[i].r := i;
fColorTable[i].g := i;
fColorTable[i].b := i;
fColorTable[i].a := 0;
end;
end;

tfR3G3B2: begin
for i := 0 to High(fColorTable) do begin
fColorTable[i].r := Round(((i shr Shift.r) and Range.r) / Range.r * 255);
fColorTable[i].g := Round(((i shr Shift.g) and Range.g) / Range.g * 255);
fColorTable[i].b := Round(((i shr Shift.b) and Range.b) / Range.b * 255);
fColorTable[i].a := 0;

s := SysUtils.Format('%.2X%.2X%.2X' + sLineBreak, [fColorTable[i].r, fColorTable[i].g, fColorTable[i].b]);
fs.Write(s[1], Length(s));
end;
end;
end;
end;

procedure TColorTableFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TbmpColorTableFormat.Map(const aPixel: TglBitmapPixelData; var aData: PByte; var aMapData: Pointer);
var
d: Byte;
begin
if not (Format in [tfLuminance4, tfLuminance8, tfR3G3B2]) then
raise EglBitmapException.Create(UNSUPPORTED_FORMAT);

case Format of
tfLuminance4: begin
if (aMapData = nil) then
aData^ := 0;
d := LuminanceWeight(aPixel) and Range.r;
aData^ := aData^ or (d shl (4 - PtrInt(aMapData)));
inc(aMapData, 4);
if (PtrInt(aMapData) >= 8) then begin
inc(aData);
aMapData := nil;
end;
end;

tfLuminance8: begin
aData^ := LuminanceWeight(aPixel) and Range.r;
inc(aData);
end;

tfR3G3B2: begin
aData^ := Round(
((aPixel.Data.r and Range.r) shl Shift.r) or
((aPixel.Data.g and Range.g) shl Shift.g) or
((aPixel.Data.b and Range.b) shl Shift.b));
inc(aData);
end;
end;
end;

procedure TbmpColorTableFormat.Unmap(var aData: PByte; var aPixel: TglBitmapPixelData; var aMapData: Pointer);
type
PUInt64 = ^UInt64;
var
@@ -3500,7 +3612,7 @@ begin
inc(aData, s);
end;

destructor TColorTableFormat.Destroy;
destructor TbmpColorTableFormat.Destroy;
begin
SetLength(fColorTable, 0);
inherited Destroy;
@@ -5906,16 +6018,6 @@ type
biClrImportant: Cardinal;
end;

(* TODO: delete?
TBMPInfoOS = packed record
biSize: Cardinal;
biWidth: Longint;
biHeight: Longint;
biPlanes: Word;
biBitCount: Word;
end;
*)

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TglBitmap.LoadBMP(const aStream: TStream): Boolean;

@@ -5952,10 +6054,10 @@ function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
end;
end;

function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TColorTableFormat;
function ReadColorTable(var aFormat: TglBitmapFormat; const aInfo: TBMPInfo): TbmpColorTableFormat;
var
i, c: Integer;
ColorTable: TColorTable;
ColorTable: TbmpColorTable;
begin
result := nil;
if (aInfo.biBitCount >= 16) then
@@ -5966,20 +6068,20 @@ function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
c := 1 shl aInfo.biBitCount;
SetLength(ColorTable, c);
for i := 0 to c-1 do begin
aStream.Read(ColorTable[i], SizeOf(TColorTableEnty));
aStream.Read(ColorTable[i], SizeOf(TbmpColorTableEnty));
if (ColorTable[i].r <> ColorTable[i].g) or (ColorTable[i].g <> ColorTable[i].b) then
aFormat := tfRGB8;
end;

result := TColorTableFormat.Create;
result := TbmpColorTableFormat.Create;
result.PixelSize := aInfo.biBitCount / 8;
result.ColorTable := ColorTable;
result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
result.Range := glBitmapColorRec($FF, $FF, $FF, $00);
end;

//////////////////////////////////////////////////////////////////////////////////////////////////
function CheckBitfields(var aFormat: TglBitmapFormat; const aMask: TglBitmapColorRec;
const aInfo: TBMPInfo): TBitfieldFormat;
const aInfo: TBMPInfo): TbmpBitfieldFormat;
var
TmpFormat: TglBitmapFormat;
FormatDesc: TFormatDescriptor;
@@ -5999,7 +6101,7 @@ function TglBitmap.LoadBMP(const aStream: TStream): Boolean;
if (aMask.a <> 0) and not TFormatDescriptor.Get(aFormat).HasAlpha then
aFormat := TFormatDescriptor.Get(aFormat).WithAlpha;

result := TBitfieldFormat.Create;
result := TbmpBitfieldFormat.Create;
result.PixelSize := aInfo.biBitCount / 8;
result.RedMask := aMask.r;
result.GreenMask := aMask.g;
@@ -6016,7 +6118,7 @@ var
LineBuf, ImageData, TmpData: PByte;
SourceMD, DestMD: Pointer;
BmpFormat: TglBitmapFormat;
ColorTable: TColorTable;
ColorTable: TbmpColorTable;

//records
Mask: TglBitmapColorRec;
@@ -6134,12 +6236,15 @@ procedure TglBitmap.SaveBMP(const aStream: TStream);
var
Header: TBMPHeader;
Info: TBMPInfo;
pData, pTemp: pByte;
Converter: TbmpColorTableFormat;
FormatDesc: TFormatDescriptor;
SourceFD, DestFD: Pointer;
pData, srcData, dstData, ConvertBuffer: pByte;

Pixel: TglBitmapPixelData;
PixelFormat: TglBitmapPixelData;
FormatDesc: TFormatDescriptor;
ImageSize, LineSize, Padding, LineIdx, ColorIdx: Integer;
Temp, RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;
ImageSize, wbLineSize, rbLineSize, Padding, LineIdx, PixelIdx, i: Integer;
RedMask, GreenMask, BlueMask, AlphaMask: Cardinal;

PaddingBuff: Cardinal;

@@ -6152,8 +6257,11 @@ begin
if not (ftBMP in FormatGetSupportedFiles(Format)) then
raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);

ImageSize := TFormatDescriptor.Get(Format).GetSize(Dimension);
Converter := nil;
FormatDesc := TFormatDescriptor.Get(Format);
ImageSize := FormatDesc.GetSize(Dimension);

FillChar(Header, SizeOf(Header), 0);
Header.bfType := BMP_MAGIC;
Header.bfSize := SizeOf(Header) + SizeOf(Info) + ImageSize;
Header.bfReserved1 := 0;
@@ -6167,100 +6275,142 @@ begin
Info.biPlanes := 1;
Info.biCompression := BMP_COMP_RGB;
Info.biSizeImage := ImageSize;
case Format of
tfR3G3B2, tfLuminance8: begin
Info.biBitCount := 8;
Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal);
end;

tfRGB5, tfRGB5A1, tfR5G6B5, tfRGB4, tfRGBA4,
tfBGR5, tfBGR5A1, tfB5G6R5, tfBGR4, tfBGRA4: begin
Info.biBitCount := 16;
Info.biCompression := BMP_COMP_BITFIELDS;
end;

tfBGR8, tfRGB8: begin
Info.biBitCount := 24;
end;
try
case Format of
tfLuminance4: begin
Info.biBitCount := 4;
Header.bfSize := Header.bfSize + 16 * SizeOf(Cardinal);
Header.bfOffBits := Header.bfOffBits + 16 * SizeOf(Cardinal); //16 ColorTable entries
Converter := TbmpColorTableFormat.Create;
Converter.PixelSize := 0.5;
Converter.Format := Format;
Converter.Range := glBitmapColorRec($F, $F, $F, $0);
Converter.CreateColorTable;
end;

tfRGB10, tfRGB10A2, tfRGBA8,
tfBGR10, tfBGR10A2, tfBGRA8: begin
Info.biBitCount := 32;
Info.biCompression := BMP_COMP_BITFIELDS;
end;
else
raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
end;
Info.biXPelsPerMeter := 2835;
Info.biYPelsPerMeter := 2835;
tfR3G3B2, tfLuminance8: begin
Info.biBitCount := 8;
Header.bfSize := Header.bfSize + 256 * SizeOf(Cardinal);
Header.bfOffBits := Header.bfOffBits + 256 * SizeOf(Cardinal); //256 ColorTable entries
Converter := TbmpColorTableFormat.Create;
Converter.PixelSize := 1;
Converter.Format := Format;
if (Format = tfR3G3B2) then begin
Converter.Range := glBitmapColorRec($7, $7, $3, $0);
Converter.Shift := glBitmapShiftRec(0, 3, 6, 0);
end else
Converter.Range := glBitmapColorRec($FF, $FF, $FF, $0);
Converter.CreateColorTable;
end;

// prepare bitmasks
if Info.biCompression = BMP_COMP_BITFIELDS then begin
Info.biSize := Info.biSize + 4 * SizeOf(Cardinal);
Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);
tfRGB4, tfRGB5, tfR5G6B5, tfRGB5A1, tfRGBA4,
tfBGR4, tfBGR5, tfB5G6R5, tfBGR5A1, tfBGRA4: begin
Info.biBitCount := 16;
Info.biCompression := BMP_COMP_BITFIELDS;
end;

FormatDesc := TFormatDescriptor.Get(Format);
RedMask := FormatDesc.RedMask;
GreenMask := FormatDesc.GreenMask;
BlueMask := FormatDesc.BlueMask;
AlphaMask := FormatDesc.AlphaMask;
end;
tfBGR8, tfRGB8: begin
Info.biBitCount := 24;
end;

// headers
aStream.Write(Header, SizeOf(Header));
aStream.Write(Info, SizeOf(Info));

// colortable
if Info.biBitCount = 8 then begin
Temp := 0;
for ColorIdx := Low(Byte) to High(Byte) do begin
aStream.Write(Temp, 4);
Temp := Temp + $00010101;
tfRGB10, tfRGB10A2, tfRGBA8,
tfBGR10, tfBGR10A2, tfBGRA8: begin
Info.biBitCount := 32;
Info.biCompression := BMP_COMP_BITFIELDS;
end;
else
raise EglBitmapUnsupportedFormatFormat.Create('SaveBMP - ' + UNSUPPORTED_FORMAT);
end;
Info.biXPelsPerMeter := 2835;
Info.biYPelsPerMeter := 2835;

// prepare bitmasks
if Info.biCompression = BMP_COMP_BITFIELDS then begin
Header.bfSize := Header.bfSize + 4 * SizeOf(Cardinal);
Header.bfOffBits := Header.bfOffBits + 4 * SizeOf(Cardinal);

RedMask := FormatDesc.RedMask;
GreenMask := FormatDesc.GreenMask;
BlueMask := FormatDesc.BlueMask;
AlphaMask := FormatDesc.AlphaMask;
end;
end;

// bitmasks
if Info.biCompression = BMP_COMP_BITFIELDS then begin
aStream.Write(RedMask, SizeOf(Cardinal));
aStream.Write(GreenMask, SizeOf(Cardinal));
aStream.Write(BlueMask, SizeOf(Cardinal));
aStream.Write(AlphaMask, SizeOf(Cardinal));
end;

// image data
LineSize := Trunc(Width * TFormatDescriptor.Get(Format).PixelSize);
Padding := GetLineWidth - LineSize;
PaddingBuff := 0;

pData := Data;
Inc(pData, (Height -1) * LineSize);
// headers
aStream.Write(Header, SizeOf(Header));
aStream.Write(Info, SizeOf(Info));

// colortable
if Assigned(Converter) then
aStream.Write(Converter.ColorTable[0].b,
SizeOf(TbmpColorTableEnty) * Length(Converter.ColorTable));

// bitmasks
if Info.biCompression = BMP_COMP_BITFIELDS then begin
aStream.Write(RedMask, SizeOf(Cardinal));
aStream.Write(GreenMask, SizeOf(Cardinal));
aStream.Write(BlueMask, SizeOf(Cardinal));
aStream.Write(AlphaMask, SizeOf(Cardinal));
end;

// prepare row buffer. But only for RGB because RGBA supports color masks
// so it's possible to change color within the image.
if (Format = tfRGB8) then
GetMem(pTemp, fRowSize)
else
pTemp := nil;
// image data
rbLineSize := Round(Info.biWidth * FormatDesc.PixelSize);
wbLineSize := Round(Info.biWidth * Info.biBitCount / 8);
Padding := GetLineWidth - wbLineSize;
PaddingBuff := 0;

pData := Data;
inc(pData, (Height-1) * rbLineSize);

// prepare row buffer. But only for RGB because RGBA supports color masks
// so it's possible to change color within the image.
if Assigned(Converter) then begin
FormatDesc.PreparePixel(Pixel);
GetMem(ConvertBuffer, wbLineSize);
SourceFD := FormatDesc.CreateMappingData;
DestFD := Converter.CreateMappingData;
end else
ConvertBuffer := nil;

try
// write image data
for LineIdx := 0 to Height - 1 do begin
// preparing row
if Format = tfRGB8 then begin
Move(pData^, pTemp^, fRowSize);
SwapRGB(pTemp, Width, false);
end else
pTemp := pData;
aStream.Write(pTemp^, LineSize);
Dec(pData, LineSize);
if Padding > 0 then
aStream.Write(PaddingBuff, Padding);
try
for LineIdx := 0 to Height - 1 do begin
// preparing row
if Assigned(Converter) then begin
srcData := pData;
dstData := ConvertBuffer;
for PixelIdx := 0 to Info.biWidth-1 do begin
FormatDesc.Unmap(srcData, Pixel, SourceFD);
with FormatDesc do begin
//TODO use convert function
for i := 0 to 3 do
if (Converter.Range.arr[i] <> Range.arr[i]) then begin
if (Range.arr[i] > 0) then
Pixel.Data.arr[i] := Round(Pixel.Data.arr[i] / Range.arr[i] * Converter.Range.arr[i])
else
Pixel.Data.arr[i] := 0;
end;
end;
Converter.Map(Pixel, dstData, DestFD);
end;
aStream.Write(ConvertBuffer^, wbLineSize);
end else begin
aStream.Write(pData^, rbLineSize);
end;
dec(pData, rbLineSize);
if (Padding > 0) then
aStream.Write(PaddingBuff, Padding);
end;
finally
// destroy row buffer
if Assigned(ConvertBuffer) then begin
FormatDesc.FreeMappingData(SourceFD);
Converter.FreeMappingData(DestFD);
FreeMem(ConvertBuffer);
end;
end;
finally
// destroy row buffer
if Format = tfRGB8 then
FreeMem(pTemp);
if Assigned(Converter) then
Converter.Free;
end;
end;

@@ -7702,3 +7852,4 @@ finalization
TFormatDescriptor.Finalize;

end.


Yaz Önizleme
Yükleniyor…
İptal
Kaydet