📄 dxteximg.pas
字号:
function CalcProgressCount(Image: TDXTextureImage): Integer;
var
i: Integer;
begin
Result := Image.WidthBytes*Image.Height;
for i:=0 to Image.SubImageCount-1 do
Inc(Result, CalcProgressCount(Image.SubImages[i]));
end;
procedure WriteGroup_Image(Image: TDXTextureImage);
var
i: Integer;
Header_Image_Format: TDXTextureImageHeader_Image_Format;
Header_Image_Format_Index: TDXTextureImageHeader_Image_Format_Index;
Header_Image_Format_RGB: TDXTextureImageHeader_Image_Format_RGB;
Header_Image_GroupInfo: TDXTextureImageHeader_Image_GroupInfo;
Header_Image_TransparentColor: TDXTextureImageHeader_Image_TransparentColor;
begin
BlockHeaderWriter.StartGroup(DXTextureImageFileCategoryType_Image);
try
{ Image format writing }
if Image.Size>0 then
begin
Header_Image_Format.ImageType := Image.ImageType;
Header_Image_Format.Width := Image.Width;
Header_Image_Format.Height := Image.Height;
Header_Image_Format.BitCount := Image.BitCount;
Header_Image_Format.WidthBytes := Image.WidthBytes;
BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_Format);
try
Stream.WriteBuffer(Header_Image_Format, SizeOf(Header_Image_Format));
case Image.ImageType of
DXTextureImageType_PaletteIndexedColor:
begin
{ INDEX IMAGE }
Header_Image_Format_Index.idx_index_Mask := Image.idx_index.Mask;
Header_Image_Format_Index.idx_alpha_Mask := Image.idx_alpha.Mask;
for i:=0 to 255 do
Header_Image_Format_Index.idx_palette[i] := Image.idx_palette[i];
Stream.WriteBuffer(Header_Image_Format_Index, SizeOf(Header_Image_Format_Index));
end;
DXTextureImageType_RGBColor:
begin
{ RGB IMAGE }
Header_Image_Format_RGB.rgb_red_Mask := Image.rgb_red.Mask;
Header_Image_Format_RGB.rgb_green_Mask := Image.rgb_green.Mask;
Header_Image_Format_RGB.rgb_blue_Mask := Image.rgb_blue.Mask;
Header_Image_Format_RGB.rgb_alpha_Mask := Image.rgb_alpha.Mask;
Stream.WriteBuffer(Header_Image_Format_RGB, SizeOf(Header_Image_Format_RGB));
end;
end;
finally
BlockHeaderWriter.EndBlock;
end;
end;
{ Image group information writing }
BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_GroupInfo);
try
Header_Image_GroupInfo.ImageGroupType := Image.ImageGroupType;
Header_Image_GroupInfo.ImageID := Image.ImageID;
Stream.WriteBuffer(Header_Image_GroupInfo, SizeOf(Header_Image_GroupInfo));
finally
BlockHeaderWriter.EndBlock;
end;
{ Name writing }
BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_Name);
try
Stream.WriteBuffer(Image.ImageName[1], Length(Image.ImageName));
finally
BlockHeaderWriter.EndBlock;
end;
{ Transparent color writing }
BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_TransparentColor);
try
Header_Image_TransparentColor.Transparent := Image.Transparent;
Header_Image_TransparentColor.TransparentColor := Image.TransparentColor;
Stream.WriteBuffer(Header_Image_TransparentColor, SizeOf(Header_Image_TransparentColor));
finally
BlockHeaderWriter.EndBlock;
end;
{ Pixel data writing }
if Image.Size>0 then
begin
BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_PixelData);
try
for i:=0 to Image.Height-1 do
Stream.WriteBuffer(Image.ScanLine[i]^, Image.Widthbytes);
finally
BlockHeaderWriter.EndBlock;
end;
end;
{ Sub-image writing }
for i:=0 to Image.SubImageCount-1 do
WriteGroup_Image(Image.SubImages[i]);
finally
BlockHeaderWriter.EndGroup;
end;
end;
var
FileHeader: TDXTextureImageFileHeader;
begin
{ File header writing }
FileHeader.FileType := DXTextureImageFile_Type;
FileHeader.ver := DXTextureImageFile_Version;
Stream.WriteBuffer(FileHeader, SizeOf(FileHeader));
{ Image writing }
BlockHeaderWriter := TDXTextureImageFileBlockHeaderWriter.Create(Stream);
try
{ Image writing }
WriteGroup_Image(Image);
{ End of file }
BlockHeaderWriter.WriteBlock(DXTextureImageFileBlockID_EndFile);
finally
BlockHeaderWriter.Free;
end;
end;
{ DXTextureImage_LoadBitmapFunc }
procedure DXTextureImage_LoadBitmapFunc(Stream: TStream; Image: TDXTextureImage);
type
TDIBPixelFormat = packed record
RBitMask, GBitMask, BBitMask: DWORD;
end;
var
TopDown: Boolean;
BF: TBitmapFileHeader;
BI: TBitmapInfoHeader;
procedure DecodeRGB;
var
y: Integer;
begin
for y:=0 to Image.Height-1 do
begin
if TopDown then
Stream.ReadBuffer(Image.ScanLine[y]^, Image.WidthBytes)
else
Stream.ReadBuffer(Image.ScanLine[Image.Height-y-1]^, Image.WidthBytes);
end;
end;
procedure DecodeRLE4;
var
SrcDataP: Pointer;
B1, B2, C: Byte;
Dest, Src, P: PByte;
X, Y, i: Integer;
begin
GetMem(SrcDataP, BI.biSizeImage);
try
Stream.ReadBuffer(SrcDataP^, BI.biSizeImage);
Dest := Image.TopPBits;
Src := SrcDataP;
X := 0;
Y := 0;
while True do
begin
B1 := Src^; Inc(Src);
B2 := Src^; Inc(Src);
if B1=0 then
begin
case B2 of
0: begin { End of line }
X := 0; Inc(Y);
Dest := Image.ScanLine[Y];
end;
1: Break; { End of bitmap }
2: begin { Difference of coordinates }
Inc(X, B1); Inc(Y, B2); Inc(Src, 2);
Dest := Image.ScanLine[Y];
end;
else
{ Absolute mode }
C := 0;
for i:=0 to B2-1 do
begin
if i and 1=0 then
begin
C := Src^; Inc(Src);
end else
begin
C := C shl 4;
end;
P := Pointer(Integer(Dest)+X shr 1);
if X and 1=0 then
P^ := (P^ and $0F) or (C and $F0)
else
P^ := (P^ and $F0) or ((C and $F0) shr 4);
Inc(X);
end;
end;
end else
begin
{ Encoding mode }
for i:=0 to B1-1 do
begin
P := Pointer(Integer(Dest)+X shr 1);
if X and 1=0 then
P^ := (P^ and $0F) or (B2 and $F0)
else
P^ := (P^ and $F0) or ((B2 and $F0) shr 4);
Inc(X);
// Swap nibble
B2 := (B2 shr 4) or (B2 shl 4);
end;
end;
{ Word arrangement }
Inc(Src, Longint(Src) and 1);
end;
finally
FreeMem(SrcDataP);
end;
end;
procedure DecodeRLE8;
var
SrcDataP: Pointer;
B1, B2: Byte;
Dest, Src: PByte;
X, Y: Integer;
begin
GetMem(SrcDataP, BI.biSizeImage);
try
Stream.ReadBuffer(SrcDataP^, BI.biSizeImage);
Dest := Image.TopPBits;
Src := SrcDataP;
X := 0;
Y := 0;
while True do
begin
B1 := Src^; Inc(Src);
B2 := Src^; Inc(Src);
if B1=0 then
begin
case B2 of
0: begin { End of line }
X := 0; Inc(Y);
Dest := Pointer(Longint(Image.TopPBits)+Y*Image.NextLine+X);
end;
1: Break; { End of bitmap }
2: begin { Difference of coordinates }
Inc(X, B1); Inc(Y, B2); Inc(Src, 2);
Dest := Pointer(Longint(Image.TopPBits)+Y*Image.NextLine+X);
end;
else
{ Absolute mode }
Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2);
end;
end else
begin
{ Encoding mode }
FillChar(Dest^, B1, B2); Inc(Dest, B1);
end;
{ Word arrangement }
Inc(Src, Longint(Src) and 1);
end;
finally
FreeMem(SrcDataP);
end;
end;
var
BC: TBitmapCoreHeader;
RGBTriples: array[0..255] of TRGBTriple;
RGBQuads: array[0..255] of TRGBQuad;
i, PalCount, j: Integer;
OS2: Boolean;
PixelFormat: TDIBPixelFormat;
begin
{ File header reading }
i := Stream.Read(BF, SizeOf(TBitmapFileHeader));
if i=0 then Exit;
if i<>SizeOf(TBitmapFileHeader) then
raise EDXTextureImageError.Create(SInvalidDIB);
{ Is the head 'BM'? }
if BF.bfType<>Ord('B') + Ord('M')*$100 then
raise EDXTextureImageError.Create(SInvalidDIB);
{ Reading of size of header }
i := Stream.Read(BI.biSize, 4);
if i<>4 then
raise EDXTextureImageError.Create(SInvalidDIB);
{ Kind check of DIB }
OS2 := False;
case BI.biSize of
SizeOf(TBitmapCoreHeader):
begin
{ OS/2 type }
Stream.ReadBuffer(Pointer(Integer(@BC)+4)^, SizeOf(TBitmapCoreHeader)-4);
FilLChar(BI, SizeOf(BI), 0);
with BI do
begin
biClrUsed := 0;
biCompression := BI_RGB;
biBitCount := BC.bcBitCount;
biHeight := BC.bcHeight;
biWidth := BC.bcWidth;
end;
OS2 := True;
end;
SizeOf(TBitmapInfoHeader):
begin
{ Windows type }
Stream.ReadBuffer(Pointer(Integer(@BI)+4)^, SizeOf(TBitmapInfoHeader)-4);
end;
else
raise EDXTextureImageError.Create(SInvalidDIB);
end;
{ Bit mask reading }
if BI.biCompression = BI_BITFIELDS then
begin
Stream.ReadBuffer(PixelFormat, SizeOf(PixelFormat));
end else
begin
if BI.biBitCount=16 then
begin
PixelFormat.RBitMask := $7C00;
PixelFormat.GBitMask := $03E0;
PixelFormat.BBitMask := $001F;
end else if (BI.biBitCount=24) or (BI.biBitCount=32) then
begin
PixelFormat.RBitMask := $00FF0000;
PixelFormat.GBitMask := $0300FF00;
PixelFormat.BBitMask := $000000FF;
end;
end;
{ DIB making }
if BI.biHeight<0 then
begin
BI.biHeight := -BI.biHeight;
TopDown := True;
end else
TopDown := False;
if BI.biBitCount in [1, 4, 8] then
begin
Image.SetSize(DXTextureImageType_PaletteIndexedColor, BI.biWidth, BI.biHeight, BI.biBitCount,
(((BI.biWidth*BI.biBitCount)+31) div 32)*4);
Image.idx_index := dxtMakeChannel(1 shl BI.biBitCount-1, True);
Image.PackedPixelOrder := True;
end else
begin
Image.SetSize(DXTextureImageType_RGBColor, BI.biWidth, BI.biHeight, BI.biBitCount,
(((BI.biWidth*BI.biBitCount)+31) div 32)*4);
Image.rgb_red := dxtMakeChannel(PixelFormat.RBitMask, False);
Image.rgb_green := dxtMakeChannel(PixelFormat.GBitMask, False);
Image.rgb_blue := dxtMakeChannel(PixelFormat.BBitMask, False);
j := Image.rgb_red.BitCount+Image.rgb_green.BitCount+Image.rgb_blue.BitCount;
if j<BI.biBitCount then
Image.rgb_alpha := dxtMakeChannel((1 shl (BI.biBitCount-j)-1) shl j, False);
Image.PackedPixelOrder := False;
end;
{ palette reading }
PalCount := BI.biClrUsed;
if (PalCount=0) and (BI.biBitCount<=8) then
PalCount := 1 shl BI.biBitCount;
if PalCount>256 then PalCount := 256;
if OS2 then
begin
{ OS/2 type }
Stream.ReadBuffer(RGBTriples, SizeOf(TRGBTriple)*PalCount);
for i:=0 to PalCount-1 do
begin
Image.idx_palette[i].peRed := RGBTriples[i].rgbtRed;
Image.idx_palette[i].peGreen := RGBTriples[i].rgbtGreen;
Image.idx_palette[i].peBlue := RGBTriples[i].rgbtBlue;
end;
end else
begin
{ Windows type }
Stream.ReadBuffer(RGBQuads, SizeOf(TRGBQuad)*PalCount);
for i:=0 to PalCount-1 do
begin
Image.idx_palette[i].peRed := RGBQuads[i].rgbRed;
Image.idx_palette[i].peGreen := RGBQuads[i].rgbGreen;
Image.idx_palette[i].peBlue := RGBQuads[i].rgbBlue;
end;
end;
{ Pixel data reading }
case BI.biCompression of
BI_RGB : DecodeRGB;
BI_BITFIELDS: DecodeRGB;
BI_RLE4 : DecodeRLE4;
BI_RLE8 : DecodeRLE8;
else
raise EDXTextureImageError.Create(SInvalidDIB);
end;
end;
initialization
finalization
_DXTextureImageLoadFuncList.Free;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -