Subversion Repositories spacemission

Rev

Blame | Last modification | View Log | RSS feed

  1. unit DXTexImg;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, SysUtils, Classes, DXConsts;
  7.  
  8. const
  9.   DXTextureImageGroupType_Normal = 0; // Normal group
  10.   DXTextureImageGroupType_Mipmap = 1; // Mipmap group
  11.  
  12. type
  13.   EDXTextureImageError = class(Exception);
  14.  
  15.   TDXTextureImageChannel = record
  16.     Mask: DWORD;
  17.     BitCount: Integer;
  18.  
  19.     {  Internal use  }
  20.     _Mask2: DWORD;
  21.     _rshift: Integer;
  22.     _lshift: Integer;
  23.     _BitCount2: Integer;
  24.   end;
  25.  
  26.   TDXTextureImage_PaletteEntries =  array[0..255] of TPaletteEntry;
  27.  
  28.   TDXTextureImageType = (
  29.     DXTextureImageType_PaletteIndexedColor,
  30.     DXTextureImageType_RGBColor
  31.   );
  32.  
  33.   TDXTextureImage = class;
  34.  
  35.   TDXTextureImageLoadFunc = procedure(Stream: TStream; Image: TDXTextureImage);
  36.  
  37.   TDXTextureImage = class
  38.   private
  39.     FOwner: TDXTextureImage;
  40.     FSubImage: TList;
  41.     FImageType: TDXTextureImageType;
  42.     FWidth: Integer;
  43.     FHeight: Integer;
  44.     FPBits: Pointer;
  45.     FBitCount: Integer;
  46.     FPackedPixelOrder: Boolean;
  47.     FWidthBytes: Integer;
  48.     FNextLine: Integer;
  49.     FSize: Integer;
  50.     FTopPBits: Pointer;
  51.     FTransparent: Boolean;
  52.     FTransparentColor: DWORD;
  53.     FImageGroupType: DWORD;
  54.     FImageID: DWORD;
  55.     FImageName: string;
  56.     FAutoFreeImage: Boolean;
  57.     procedure ClearImage;
  58.     function GetPixel(x, y: Integer): DWORD;
  59.     procedure SetPixel(x, y: Integer; c: DWORD);
  60.     function GetScanLine(y: Integer): Pointer;
  61.     function GetSubGroupImageCount(GroupTypeID: DWORD): Integer;
  62.     function GetSubGroupImage(GroupTypeID: DWORD; Index: Integer): TDXTextureImage;
  63.     function GetSubImageCount: Integer;
  64.     function GetSubImage(Index: Integer): TDXTextureImage;
  65.   public
  66.     idx_index: TDXTextureImageChannel;
  67.     idx_alpha: TDXTextureImageChannel;
  68.     idx_palette: TDXTextureImage_PaletteEntries;
  69.     rgb_red: TDXTextureImageChannel;
  70.     rgb_green: TDXTextureImageChannel;
  71.     rgb_blue: TDXTextureImageChannel;
  72.     rgb_alpha: TDXTextureImageChannel;
  73.     constructor Create;
  74.     constructor CreateSub(AOwner: TDXTextureImage);
  75.     destructor Destroy; override;
  76.     procedure Assign(Source: TDXTextureImage);
  77.     procedure Clear;
  78.     procedure SetImage(ImageType: TDXTextureImageType; Width, Height, BitCount, WidthBytes, NextLine: Integer;
  79.       PBits, TopPBits: Pointer; Size: Integer; AutoFree: Boolean);
  80.     procedure SetSize(ImageType: TDXTextureImageType; Width, Height, BitCount, WidthBytes: Integer);
  81.     procedure LoadFromFile(const FileName: string);
  82.     procedure LoadFromStream(Stream: TStream);
  83.     procedure SaveToFile(const FileName: string);
  84.     procedure SaveToStream(Stream: TStream);
  85.     function EncodeColor(R, G, B, A: Byte): DWORD;
  86.     function PaletteIndex(R, G, B: Byte): DWORD;
  87.     class procedure RegisterLoadFunc(LoadFunc: TDXTextureImageLoadFunc);
  88.     class procedure UnRegisterLoadFunc(LoadFunc: TDXTextureImageLoadFunc);
  89.     property BitCount: Integer read FBitCount;
  90.     property PackedPixelOrder: Boolean read FPackedPixelOrder write FPackedPixelOrder;
  91.     property Height: Integer read FHeight;
  92.     property ImageType: TDXTextureImageType read FImageType;
  93.     property ImageGroupType: DWORD read FImageGroupType write FImageGroupType;
  94.     property ImageID: DWORD read FImageID write FImageID;
  95.     property ImageName: string read FImageName write FImageName;
  96.     property NextLine: Integer read FNextLine;
  97.     property PBits: Pointer read FPBits;
  98.     property Pixels[x, y: Integer]: DWORD read GetPixel write SetPixel;
  99.     property ScanLine[y: Integer]: Pointer read GetScanLine;
  100.     property Size: Integer read FSize;
  101.     property SubGroupImageCount[GroupTypeID: DWORD]: Integer read GetSubGroupImageCount;
  102.     property SubGroupImages[GroupTypeID: DWORD; Index: Integer]: TDXTextureImage read GetSubGroupImage;
  103.     property SubImageCount: Integer read GetSubImageCount;
  104.     property SubImages[Index: Integer]: TDXTextureImage read GetSubImage;
  105.     property TopPBits: Pointer read FTopPBits;
  106.     property Transparent: Boolean read FTransparent write FTransparent;
  107.     property TransparentColor: DWORD read FTransparentColor write FTransparentColor;
  108.     property Width: Integer read FWidth;
  109.     property WidthBytes: Integer read FWidthBytes;
  110.   end;
  111.  
  112. function dxtMakeChannel(Mask: DWORD; indexed: Boolean): TDXTextureImageChannel;
  113. function dxtEncodeChannel(const Channel: TDXTextureImageChannel; c: DWORD): DWORD;
  114. function dxtDecodeChannel(const Channel: TDXTextureImageChannel; c: DWORD): DWORD;
  115.  
  116. implementation
  117.  
  118. function GetWidthBytes(Width, BitCount: Integer): Integer;
  119. begin
  120.   Result := (((Width*BitCount)+31) div 32)*4;
  121. end;
  122.  
  123. function dxtEncodeChannel(const Channel: TDXTextureImageChannel; c: DWORD): DWORD;
  124. begin
  125.   Result := ((c shl Channel._rshift) shr Channel._lshift) and Channel.Mask;
  126. end;
  127.  
  128. function dxtDecodeChannel(const Channel: TDXTextureImageChannel; c: DWORD): DWORD;
  129. begin
  130.   Result := ((c  and Channel.Mask) shr Channel._rshift) shl Channel._lshift;
  131.   Result := Result or (Result shr Channel._BitCount2);
  132. end;
  133.  
  134. function dxtMakeChannel(Mask: DWORD; indexed: Boolean): TDXTextureImageChannel;
  135.  
  136.   function GetMaskBitCount(b: Integer): Integer;
  137.   var
  138.     i: Integer;
  139.   begin
  140.     i := 0;
  141.     while (i<31) and (((1 shl i) and b)=0) do Inc(i);
  142.  
  143.     Result := 0;
  144.     while ((1 shl i) and b)<>0 do
  145.     begin
  146.       Inc(i);
  147.       Inc(Result);
  148.     end;
  149.   end;
  150.  
  151.   function GetBitCount2(b: Integer): Integer;
  152.   begin
  153.     Result := 0;
  154.     while (Result<31) and (((1 shl Result) and b)=0) do Inc(Result);
  155.   end;
  156.  
  157. begin
  158.   Result.BitCount := GetMaskBitCount(Mask);
  159.   Result.Mask := Mask;
  160.  
  161.   if indexed then
  162.   begin
  163.     Result._rshift := GetBitCount2(Mask);
  164.     Result._lshift := 0;
  165.     Result._Mask2 := 1 shl Result.BitCount-1;
  166.     Result._BitCount2 := 0;
  167.   end else
  168.   begin
  169.     Result._rshift := GetBitCount2(Mask)-(8-Result.BitCount);
  170.     if Result._rshift<0 then
  171.     begin
  172.       Result._lshift := -Result._rshift;
  173.       Result._rshift := 0;
  174.     end else
  175.       Result._lshift := 0;
  176.     Result._Mask2 := (1 shl Result.BitCount-1) shl (8-Result.BitCount);
  177.     Result._BitCount2 := 8-Result.BitCount;
  178.   end;
  179. end;
  180.  
  181. {  TDXTextureImage  }
  182.  
  183. var
  184.   _DXTextureImageLoadFuncList: TList;
  185.  
  186. procedure DXTextureImage_LoadDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage); forward;
  187. procedure DXTextureImage_LoadBitmapFunc(Stream: TStream; Image: TDXTextureImage); forward;
  188.  
  189. function DXTextureImageLoadFuncList: TList;
  190. begin
  191.   if _DXTextureImageLoadFuncList=nil then
  192.   begin
  193.     _DXTextureImageLoadFuncList := TList.Create;
  194.     _DXTextureImageLoadFuncList.Add(@DXTextureImage_LoadDXTextureImageFunc);
  195.     _DXTextureImageLoadFuncList.Add(@DXTextureImage_LoadBitmapFunc);
  196.   end;
  197.   Result := _DXTextureImageLoadFuncList;
  198. end;
  199.  
  200. class procedure TDXTextureImage.RegisterLoadFunc(LoadFunc: TDXTextureImageLoadFunc);
  201. begin
  202.   if DXTextureImageLoadFuncList.IndexOf(@LoadFunc)=-1 then
  203.     DXTextureImageLoadFuncList.Add(@LoadFunc);
  204. end;
  205.  
  206. class procedure TDXTextureImage.UnRegisterLoadFunc(LoadFunc: TDXTextureImageLoadFunc);
  207. begin
  208.   DXTextureImageLoadFuncList.Remove(@LoadFunc);
  209. end;
  210.  
  211. constructor TDXTextureImage.Create;
  212. begin
  213.   inherited Create;
  214.   FSubImage := TList.Create;
  215. end;
  216.  
  217. constructor TDXTextureImage.CreateSub(AOwner: TDXTextureImage);
  218. begin
  219.   Create;
  220.  
  221.   FOwner := AOwner;
  222.   try          
  223.     FOwner.FSubImage.Add(Self);
  224.   except
  225.     FOwner := nil;
  226.     raise;
  227.   end;
  228. end;
  229.  
  230. destructor TDXTextureImage.Destroy;
  231. begin
  232.   Clear;
  233.   FSubImage.Free;
  234.   if FOwner<>nil then
  235.     FOwner.FSubImage.Remove(Self);
  236.   inherited Destroy;
  237. end;
  238.  
  239. procedure TDXTextureImage.Assign(Source: TDXTextureImage);
  240. var
  241.   y: Integer;
  242. begin
  243.   SetSize(Source.ImageType, Source.Width, Source.Height, Source.BitCount, Source.WidthBytes);
  244.  
  245.   idx_index := Source.idx_index;
  246.   idx_alpha := Source.idx_alpha;
  247.   idx_palette := Source.idx_palette;
  248.  
  249.   rgb_red := Source.rgb_red;
  250.   rgb_green := Source.rgb_green;
  251.   rgb_blue := Source.rgb_blue;
  252.   rgb_alpha := Source.rgb_alpha;
  253.  
  254.   for y:=0 to Height-1 do
  255.     Move(Source.ScanLine[y]^, ScanLine[y]^, WidthBytes);
  256.  
  257.   Transparent := Source.Transparent;
  258.   TransparentColor := Source.TransparentColor;
  259.   ImageGroupType := Source.ImageGroupType;
  260.   ImageID := Source.ImageID;
  261.   ImageName := Source.ImageName;
  262. end;
  263.  
  264. procedure TDXTextureImage.ClearImage;
  265. begin
  266.   if FAutoFreeImage then
  267.     FreeMem(FPBits);
  268.  
  269.   FImageType := DXTextureImageType_PaletteIndexedColor;
  270.   FWidth := 0;
  271.   FHeight := 0;
  272.   FBitCount := 0;
  273.   FWidthBytes := 0;
  274.   FNextLine := 0;
  275.   FSize := 0;
  276.   FPBits := nil;
  277.   FTopPBits := nil;
  278.   FAutoFreeImage := False;
  279. end;
  280.  
  281. procedure TDXTextureImage.Clear;
  282. begin
  283.   ClearImage;
  284.  
  285.   while SubImageCount>0 do
  286.     SubImages[SubImageCount-1].Free;
  287.  
  288.   FImageGroupType := 0;
  289.   FImageID := 0;
  290.   FImageName := '';
  291.  
  292.   FTransparent := False;
  293.   FTransparentColor := 0;
  294.  
  295.   FillChar(idx_index, SizeOf(idx_index), 0);
  296.   FillChar(idx_alpha, SizeOf(idx_alpha), 0);
  297.   FillChar(idx_palette, SizeOf(idx_palette), 0);
  298.   FillChar(rgb_red, SizeOf(rgb_red), 0);
  299.   FillChar(rgb_green, SizeOf(rgb_green), 0);
  300.   FillChar(rgb_blue, SizeOf(rgb_blue), 0);
  301.   FillChar(rgb_alpha, SizeOf(rgb_alpha), 0);
  302. end;
  303.  
  304. procedure TDXTextureImage.SetImage(ImageType: TDXTextureImageType; Width, Height, BitCount, WidthBytes, NextLine: Integer;
  305.   PBits, TopPBits: Pointer; Size: Integer; AutoFree: Boolean);
  306. begin
  307.   ClearImage;
  308.  
  309.   FAutoFreeImage := AutoFree;
  310.   FImageType := ImageType;
  311.   FWidth := Width;
  312.   FHeight := Height;
  313.   FBitCount := BitCount;
  314.   FWidthBytes := WidthBytes;
  315.   FNextLine := NextLine;
  316.   FSize := Size;
  317.   FPBits := PBits;
  318.   FTopPBits := TopPBits;
  319. end;
  320.  
  321. procedure TDXTextureImage.SetSize(ImageType: TDXTextureImageType; Width, Height, BitCount, WidthBytes: Integer);
  322. var
  323.   APBits: Pointer;
  324. begin
  325.   ClearImage;
  326.  
  327.   if WidthBytes=0 then
  328.     WidthBytes := GetWidthBytes(Width, BitCount);
  329.  
  330.   GetMem(APBits, WidthBytes*Height);
  331.   SetImage(ImageType, Width, Height, BitCount, WidthBytes, WidthBytes, APBits, APBits, WidthBytes*Height, True);
  332. end;
  333.  
  334. function TDXTextureImage.GetScanLine(y: Integer): Pointer;
  335. begin
  336.   Result := Pointer(Integer(FTopPBits)+FNextLine*y);
  337. end;
  338.  
  339. function TDXTextureImage.GetSubGroupImageCount(GroupTypeID: DWORD): Integer;
  340. var
  341.   i: Integer;
  342. begin
  343.   Result := 0;
  344.   for i:=0 to SubImageCount-1 do
  345.     if SubImages[i].ImageGroupType=GroupTypeID then
  346.       Inc(Result);
  347. end;
  348.  
  349. function TDXTextureImage.GetSubGroupImage(GroupTypeID: DWORD; Index: Integer): TDXTextureImage;
  350. var
  351.   i, j: Integer;
  352. begin
  353.   j := 0;
  354.   for i:=0 to SubImageCount-1 do
  355.     if SubImages[i].ImageGroupType=GroupTypeID then
  356.     begin
  357.       if j=Index then
  358.       begin
  359.         Result := SubImages[i];
  360.         Exit;
  361.       end;
  362.  
  363.       Inc(j);
  364.     end;
  365.  
  366.   Result := nil;
  367.   SubImages[-1];
  368. end;
  369.  
  370. function TDXTextureImage.GetSubImageCount: Integer;
  371. begin
  372.   Result := FSubImage.Count;
  373. end;
  374.  
  375. function TDXTextureImage.GetSubImage(Index: Integer): TDXTextureImage;
  376. begin
  377.   Result := FSubImage[Index];
  378. end;
  379.  
  380. function TDXTextureImage.EncodeColor(R, G, B, A: Byte): DWORD;
  381. begin
  382.   if ImageType=DXTextureImageType_PaletteIndexedColor then
  383.   begin
  384.     Result := dxtEncodeChannel(idx_index, PaletteIndex(R, G, B)) or
  385.       dxtEncodeChannel(idx_alpha, A);
  386.   end else
  387.   begin
  388.     Result := dxtEncodeChannel(rgb_red, R) or
  389.       dxtEncodeChannel(rgb_green, G) or
  390.       dxtEncodeChannel(rgb_blue, B) or
  391.       dxtEncodeChannel(rgb_alpha, A);
  392.  end;
  393. end;
  394.  
  395. function TDXTextureImage.PaletteIndex(R, G, B: Byte): DWORD;
  396. var
  397.   i, d, d2: Integer;
  398. begin
  399.   Result := 0;
  400.   if ImageType=DXTextureImageType_PaletteIndexedColor then
  401.   begin
  402.     d := MaxInt;
  403.     for i:=0 to (1 shl idx_index.BitCount)-1 do
  404.       with idx_palette[i] do
  405.       begin
  406.         d2 := Abs((peRed-R))*Abs((peRed-R)) + Abs((peGreen-G))*Abs((peGreen-G)) + Abs((peBlue-B))*Abs((peBlue-B));
  407.         if d>d2 then
  408.         begin
  409.           d := d2;
  410.           Result := i;
  411.         end;
  412.       end;
  413.   end;
  414. end;
  415.  
  416. const
  417.   Mask1: array[0..7] of DWORD= (1, 2, 4, 8, 16, 32, 64, 128);
  418.   Mask2: array[0..3] of DWORD= (3, 12, 48, 192);
  419.   Mask4: array[0..1] of DWORD= ($0F, $F0);
  420.  
  421.   Shift1: array[0..7] of DWORD= (0, 1, 2, 3, 4, 5, 6, 7);
  422.   Shift2: array[0..3] of DWORD= (0, 2, 4, 6);
  423.   Shift4: array[0..1] of DWORD= (0, 4);
  424.  
  425. type
  426.   PByte3 = ^TByte3;
  427.   TByte3 = array[0..2] of Byte;
  428.  
  429. function TDXTextureImage.GetPixel(x, y: Integer): DWORD;
  430. begin
  431.   Result := 0;
  432.   if (x>=0) and (x<FWidth) and (y>=0) and (y<FHeight) then
  433.   begin
  434.     case FBitCount of
  435.       1 : begin
  436.             if FPackedPixelOrder then
  437.               Result := (PByte(Integer(FTopPBits)+FNextLine*y+x shr 3)^ and Mask1[7-x and 7]) shr Shift1[7-x and 7]
  438.             else
  439.               Result := (PByte(Integer(FTopPBits)+FNextLine*y+x shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7];
  440.           end;
  441.       2 : begin
  442.             if FPackedPixelOrder then
  443.               Result := (PByte(Integer(FTopPBits)+FNextLine*y+x shr 2)^ and Mask2[3-x and 3]) shr Shift2[3-x and 3]
  444.             else
  445.               Result := (PByte(Integer(FTopPBits)+FNextLine*y+x shr 2)^ and Mask2[x and 3]) shr Shift2[x and 3];
  446.           end;
  447.       4 : begin
  448.             if FPackedPixelOrder then
  449.               Result := (PByte(Integer(FTopPBits)+FNextLine*y+x shr 1)^ and Mask4[1-x and 1]) shr Shift4[1-x and 1]
  450.             else
  451.               Result := (PByte(Integer(FTopPBits)+FNextLine*y+x shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1];
  452.           end;
  453.       8 : Result := PByte(Integer(FTopPBits)+FNextLine*y+x)^;
  454.       16: Result := PWord(Integer(FTopPBits)+FNextLine*y+x*2)^;
  455.       24: PByte3(@Result)^ := PByte3(Integer(FTopPBits)+FNextLine*y+x*3)^;
  456.       32: Result := PDWORD(Integer(FTopPBits)+FNextLine*y+x*4)^;
  457.     end;
  458.   end;
  459. end;
  460.  
  461. procedure TDXTextureImage.SetPixel(x, y: Integer; c: DWORD);
  462. var
  463.   P: PByte;
  464. begin
  465.   if (x>=0) and (x<FWidth) and (y>=0) and (y<FHeight) then
  466.   begin
  467.     case FBitCount of
  468.       1 : begin
  469.             P := Pointer(Integer(FTopPBits)+FNextLine*y+x shr 3);
  470.             if FPackedPixelOrder then
  471.               P^ := (P^ and (not Mask1[7-x and 7])) or ((c and 1) shl Shift1[7-x and 7])
  472.             else
  473.               P^ := (P^ and (not Mask1[x and 7])) or ((c and 1) shl Shift1[x and 7]);
  474.           end;
  475.       2 : begin
  476.             P := Pointer(Integer(FTopPBits)+FNextLine*y+x shr 2);
  477.             if FPackedPixelOrder then
  478.               P^ := (P^ and (not Mask2[3-x and 3])) or ((c and 3) shl Shift2[3-x and 3])
  479.             else
  480.               P^ := (P^ and (not Mask2[x and 3])) or ((c and 3) shl Shift2[x and 3]);
  481.           end;
  482.       4 : begin
  483.             P := Pointer(Integer(FTopPBits)+FNextLine*y+x shr 1);
  484.             if FPackedPixelOrder then
  485.               P^ := (P^ and (not Mask4[1-x and 1])) or ((c and 7) shl Shift4[1-x and 1])
  486.             else
  487.               P^ := (P^ and (not Mask4[x and 1])) or ((c and 7) shl Shift4[x and 1]);
  488.           end;
  489.       8 : PByte(Integer(FTopPBits)+FNextLine*y+x)^ := c;
  490.       16: PWord(Integer(FTopPBits)+FNextLine*y+x*2)^ := c;
  491.       24: PByte3(Integer(FTopPBits)+FNextLine*y+x*3)^ := PByte3(@c)^;
  492.       32: PDWORD(Integer(FTopPBits)+FNextLine*y+x*4)^ := c;
  493.     end;
  494.   end;
  495. end;
  496.  
  497. procedure TDXTextureImage.LoadFromFile(const FileName: string);
  498. var
  499.   Stream: TFileStream;
  500. begin
  501.   Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  502.   try
  503.     LoadFromStream(Stream);
  504.   finally
  505.     Stream.Free;
  506.   end;
  507. end;
  508.  
  509. procedure TDXTextureImage.LoadFromStream(Stream: TStream);
  510. var
  511.   i, p: Integer;
  512. begin
  513.   Clear;
  514.  
  515.   p := Stream.Position;
  516.   for i:=0 to DXTextureImageLoadFuncList.Count-1 do
  517.   begin
  518.     Stream.Position := p;
  519.     try
  520.       TDXTextureImageLoadFunc(DXTextureImageLoadFuncList[i])(Stream, Self);
  521.       Exit;
  522.     except
  523.       Clear;
  524.     end;
  525.   end;
  526.  
  527.   raise EDXTextureImageError.Create(SNotSupportGraphicFile);
  528. end;
  529.  
  530. procedure TDXTextureImage.SaveToFile(const FileName: string);
  531. var
  532.   Stream: TFileStream;
  533. begin
  534.   Stream := TFileStream.Create(FileName, fmCreate);
  535.   try
  536.     SaveToStream(Stream);
  537.   finally
  538.     Stream.Free;
  539.   end;
  540. end;
  541.  
  542. procedure DXTextureImage_SaveDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage); forward;
  543.  
  544. procedure TDXTextureImage.SaveToStream(Stream: TStream);
  545. begin
  546.   DXTextureImage_SaveDXTextureImageFunc(Stream, Self);
  547. end;
  548.  
  549. {  DXTextureImage_LoadDXTextureImageFunc  }
  550.  
  551. const
  552.   DXTextureImageFile_Type     = 'dxt:';
  553.   DXTextureImageFile_Version  = $100;
  554.  
  555.   DXTextureImageCompress_None = 0;
  556.  
  557.   DXTextureImageFileCategoryType_Image             = $100;
  558.  
  559.   DXTextureImageFileBlockID_EndFile                = 0;
  560.   DXTextureImageFileBlockID_EndGroup               = 1;
  561.   DXTextureImageFileBlockID_StartGroup             = 2;
  562.   DXTextureImageFileBlockID_Image_Format           = DXTextureImageFileCategoryType_Image + 1;
  563.   DXTextureImageFileBlockID_Image_PixelData        = DXTextureImageFileCategoryType_Image + 2;
  564.   DXTextureImageFileBlockID_Image_GroupInfo        = DXTextureImageFileCategoryType_Image + 3;
  565.   DXTextureImageFileBlockID_Image_Name             = DXTextureImageFileCategoryType_Image + 4;
  566.   DXTextureImageFileBlockID_Image_TransparentColor = DXTextureImageFileCategoryType_Image + 5;
  567.  
  568. type
  569.   TDXTextureImageFileHeader = packed record
  570.     FileType: array[0..4] of Char;
  571.     ver: DWORD;
  572.   end;
  573.  
  574.   TDXTextureImageFileBlockHeader = packed record
  575.     ID: DWORD;
  576.     Size: Integer;
  577.   end;
  578.  
  579.   TDXTextureImageFileBlockHeader_StartGroup = packed record
  580.     CategoryType: DWORD;
  581.   end;
  582.  
  583.   TDXTextureImageHeader_Image_Format = packed record
  584.     ImageType: TDXTextureImageType;
  585.     Width: DWORD;
  586.     Height: DWORD;
  587.     BitCount: DWORD;
  588.     WidthBytes: DWORD;
  589.   end;
  590.  
  591.   TDXTextureImageHeader_Image_Format_Index = packed record
  592.     idx_index_Mask: DWORD;
  593.     idx_alpha_Mask: DWORD;
  594.     idx_palette: array[0..255] of TPaletteEntry;
  595.   end;
  596.  
  597.   TDXTextureImageHeader_Image_Format_RGB = packed record
  598.     rgb_red_Mask: DWORD;
  599.     rgb_green_Mask: DWORD;
  600.     rgb_blue_Mask: DWORD;
  601.     rgb_alpha_Mask: DWORD;
  602.   end;
  603.  
  604.   TDXTextureImageHeader_Image_GroupInfo = packed record
  605.     ImageGroupType: DWORD;
  606.     ImageID: DWORD;
  607.   end;
  608.  
  609.   TDXTextureImageHeader_Image_TransparentColor = packed record
  610.     Transparent: Boolean;
  611.     TransparentColor: DWORD;
  612.   end;
  613.  
  614. procedure DXTextureImage_LoadDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage);
  615.  
  616.   procedure ReadGroup_Image(Image: TDXTextureImage);
  617.   var
  618.     i: Integer;
  619.     BlockHeader: TDXTextureImageFileBlockHeader;
  620.     NextPos: Integer;
  621.     SubImage: TDXTextureImage;
  622.     Header_StartGroup: TDXTextureImageFileBlockHeader_StartGroup;
  623.     Header_Image_Format: TDXTextureImageHeader_Image_Format;
  624.     Header_Image_Format_Index: TDXTextureImageHeader_Image_Format_Index;
  625.     Header_Image_Format_RGB: TDXTextureImageHeader_Image_Format_RGB;
  626.     Header_Image_GroupInfo: TDXTextureImageHeader_Image_GroupInfo;
  627.     Header_Image_TransparentColor: TDXTextureImageHeader_Image_TransparentColor;
  628.     ImageName: string;
  629.   begin
  630.     while True do
  631.     begin
  632.       Stream.ReadBuffer(BlockHeader, SizeOf(BlockHeader));
  633.       NextPos := Stream.Position + BlockHeader.Size;
  634.  
  635.       case BlockHeader.ID of
  636.         DXTextureImageFileBlockID_EndGroup:
  637.           begin
  638.             {  End of group  }
  639.             Break;
  640.           end;
  641.         DXTextureImageFileBlockID_StartGroup:
  642.           begin
  643.             {  Beginning of group  }
  644.             Stream.ReadBuffer(Header_StartGroup, SizeOf(Header_StartGroup));
  645.             case Header_StartGroup.CategoryType of
  646.               DXTextureImageFileCategoryType_Image:
  647.                 begin
  648.                   {  Image group  }
  649.                   SubImage := TDXTextureImage.CreateSub(Image);
  650.                   try
  651.                     ReadGroup_Image(SubImage);
  652.                   except
  653.                     SubImage.Free;
  654.                     raise;
  655.                   end;
  656.                 end;
  657.             end;
  658.           end;
  659.         DXTextureImageFileBlockID_Image_Format:
  660.           begin
  661.             {  Image information reading (size etc.)  }
  662.             Stream.ReadBuffer(Header_Image_Format, SizeOf(Header_Image_Format));
  663.  
  664.             if (Header_Image_Format.ImageType<>DXTextureImageType_PaletteIndexedColor) and
  665.               (Header_Image_Format.ImageType<>DXTextureImageType_RGBColor) then
  666.               raise EDXTextureImageError.Create(SInvalidDXTFile);
  667.  
  668.             Image.SetSize(Header_Image_Format.ImageType, Header_Image_Format.Width, Header_Image_Format.Height,
  669.               Header_Image_Format.BitCount, Header_Image_Format.Widthbytes);
  670.  
  671.             if Header_Image_Format.ImageType=DXTextureImageType_PaletteIndexedColor then
  672.             begin
  673.               {  INDEX IMAGE  }
  674.               Stream.ReadBuffer(Header_Image_Format_Index, SizeOf(Header_Image_Format_Index));
  675.  
  676.               Image.idx_index := dxtMakeChannel(Header_Image_Format_Index.idx_index_Mask, True);
  677.               Image.idx_alpha := dxtMakeChannel(Header_Image_Format_Index.idx_alpha_Mask, False);
  678.  
  679.               for i:=0 to 255 do
  680.                 Image.idx_palette[i] := Header_Image_Format_Index.idx_palette[i];
  681.             end else if Header_Image_Format.ImageType=DXTextureImageType_RGBColor then
  682.             begin
  683.               {  RGB IMAGE  }
  684.               Stream.ReadBuffer(Header_Image_Format_RGB, SizeOf(Header_Image_Format_RGB));
  685.  
  686.               Image.rgb_red := dxtMakeChannel(Header_Image_Format_RGB.rgb_red_Mask, False);
  687.               Image.rgb_green := dxtMakeChannel(Header_Image_Format_RGB.rgb_green_Mask, False);
  688.               Image.rgb_blue := dxtMakeChannel(Header_Image_Format_RGB.rgb_blue_Mask, False);
  689.               Image.rgb_alpha := dxtMakeChannel(Header_Image_Format_RGB.rgb_alpha_Mask, False);
  690.             end;
  691.           end;
  692.         DXTextureImageFileBlockID_Image_Name:
  693.           begin
  694.             {  Name reading  }
  695.             SetLength(ImageName, BlockHeader.Size);
  696.             Stream.ReadBuffer(ImageName[1], BlockHeader.Size);
  697.  
  698.             Image.ImageName := ImageName;
  699.           end;
  700.         DXTextureImageFileBlockID_Image_GroupInfo:
  701.           begin
  702.             {  Image group information reading  }
  703.             Stream.ReadBuffer(Header_Image_GroupInfo, SizeOf(Header_Image_GroupInfo));
  704.  
  705.             Image.ImageGroupType := Header_Image_GroupInfo.ImageGroupType;
  706.             Image.ImageID := Header_Image_GroupInfo.ImageID;
  707.           end;
  708.         DXTextureImageFileBlockID_Image_TransparentColor:
  709.           begin
  710.             {  Transparent color information reading  }
  711.             Stream.ReadBuffer(Header_Image_TransparentColor, SizeOf(Header_Image_TransparentColor));
  712.  
  713.             Image.Transparent := Header_Image_TransparentColor.Transparent;
  714.             Image.TransparentColor := Header_Image_TransparentColor.TransparentColor;
  715.           end;
  716.         DXTextureImageFileBlockID_Image_PixelData:
  717.           begin
  718.             {  Pixel data reading  }
  719.             for i:=0 to Image.Height-1 do
  720.               Stream.ReadBuffer(Image.ScanLine[i]^, Header_Image_Format.Widthbytes);
  721.           end;
  722.       end;
  723.  
  724.       Stream.Seek(NextPos, soFromBeginning);
  725.     end;
  726.   end;
  727.  
  728. var
  729.   FileHeader: TDXTextureImageFileHeader;
  730.   BlockHeader: TDXTextureImageFileBlockHeader;
  731.   Header_StartGroup: TDXTextureImageFileBlockHeader_StartGroup;
  732.   NextPos: Integer;
  733. begin
  734.   {  File header reading  }
  735.   Stream.ReadBuffer(FileHeader, SizeOf(FileHeader));
  736.  
  737.   if FileHeader.FileType<>DXTextureImageFile_Type then
  738.     raise EDXTextureImageError.Create(SInvalidDXTFile);
  739.   if FileHeader.ver<>DXTextureImageFile_Version then
  740.     raise EDXTextureImageError.Create(SInvalidDXTFile);
  741.  
  742.   while True do
  743.   begin
  744.     Stream.ReadBuffer(BlockHeader, SizeOf(BlockHeader));
  745.     NextPos := Stream.Position + BlockHeader.Size;
  746.  
  747.     case BlockHeader.ID of
  748.       DXTextureImageFileBlockID_EndFile:
  749.         begin
  750.           {  End of file  }
  751.           Break;
  752.         end;
  753.       DXTextureImageFileBlockID_StartGroup:
  754.         begin
  755.           {  Beginning of group  }
  756.           Stream.ReadBuffer(Header_StartGroup, SizeOf(Header_StartGroup));
  757.           case Header_StartGroup.CategoryType of
  758.             DXTextureImageFileCategoryType_Image: ReadGroup_Image(Image);
  759.           end;
  760.         end;
  761.     end;
  762.    
  763.     Stream.Seek(NextPos, soFromBeginning);
  764.   end;
  765. end;
  766.  
  767. type
  768.   PDXTextureImageFileBlockHeaderWriter_BlockInfo = ^TDXTextureImageFileBlockHeaderWriter_BlockInfo;
  769.   TDXTextureImageFileBlockHeaderWriter_BlockInfo = record
  770.     BlockID: DWORD;
  771.     StreamPos: Integer;
  772.   end;
  773.  
  774.   TDXTextureImageFileBlockHeaderWriter = class
  775.   private
  776.     FStream: TStream;
  777.     FList: TList;
  778.   public
  779.     constructor Create(Stream: TStream);
  780.     destructor Destroy; override;
  781.     procedure StartBlock(BlockID: DWORD);
  782.     procedure EndBlock;
  783.     procedure WriteBlock(BlockID: DWORD);
  784.     procedure StartGroup(CategoryType: DWORD);
  785.     procedure EndGroup;
  786.   end;
  787.  
  788. constructor TDXTextureImageFileBlockHeaderWriter.Create(Stream: TStream);
  789. begin
  790.   inherited Create;
  791.   FStream := Stream;
  792.   FList := TList.Create;
  793. end;
  794.  
  795. destructor TDXTextureImageFileBlockHeaderWriter.Destroy;
  796. var
  797.   i: Integer;
  798. begin
  799.   for i:=0 to FList.Count-1 do
  800.     Dispose(PDXTextureImageFileBlockHeaderWriter_BlockInfo(FList[i]));
  801.   FList.Free;
  802.   inherited Destroy;
  803. end;
  804.  
  805. procedure TDXTextureImageFileBlockHeaderWriter.StartBlock(BlockID: DWORD);
  806. var
  807.   BlockInfo: PDXTextureImageFileBlockHeaderWriter_BlockInfo;
  808.   BlockHeader: TDXTextureImageFileBlockHeader;
  809. begin
  810.   New(BlockInfo);
  811.   BlockInfo.BlockID := BlockID;
  812.   BlockInfo.StreamPos := FStream.Position;
  813.   FList.Add(BlockInfo);
  814.  
  815.   BlockHeader.ID := BlockID;
  816.   BlockHeader.Size := 0;
  817.   FStream.WriteBuffer(BlockHeader, SizeOf(BlockHeader));
  818. end;
  819.  
  820. procedure TDXTextureImageFileBlockHeaderWriter.EndBlock;
  821. var
  822.   BlockHeader: TDXTextureImageFileBlockHeader;
  823.   BlockInfo: PDXTextureImageFileBlockHeaderWriter_BlockInfo;
  824.   CurStreamPos: Integer;
  825. begin
  826.   CurStreamPos := FStream.Position;
  827.   try
  828.     BlockInfo := FList[FList.Count-1];
  829.  
  830.     FStream.Position := BlockInfo.StreamPos;
  831.     BlockHeader.ID := BlockInfo.BlockID;
  832.     BlockHeader.Size := CurStreamPos-(BlockInfo.StreamPos+SizeOf(TDXTextureImageFileBlockHeader));
  833.     FStream.WriteBuffer(BlockHeader, SizeOf(BlockHeader));
  834.   finally
  835.     FStream.Position := CurStreamPos;
  836.  
  837.     Dispose(FList[FList.Count-1]);
  838.     FList.Count := FList.Count-1;
  839.   end;
  840. end;
  841.  
  842. procedure TDXTextureImageFileBlockHeaderWriter.WriteBlock(BlockID: DWORD);
  843. var
  844.   BlockHeader: TDXTextureImageFileBlockHeader;
  845. begin
  846.   BlockHeader.ID := BlockID;
  847.   BlockHeader.Size := 0;
  848.   FStream.WriteBuffer(BlockHeader, SizeOf(BlockHeader));
  849. end;
  850.  
  851. procedure TDXTextureImageFileBlockHeaderWriter.StartGroup(CategoryType: DWORD);
  852. var
  853.   Header_StartGroup: TDXTextureImageFileBlockHeader_StartGroup;
  854. begin
  855.   StartBlock(DXTextureImageFileBlockID_StartGroup);
  856.  
  857.   Header_StartGroup.CategoryType := CategoryType;
  858.   FStream.WriteBuffer(Header_StartGroup, SizeOf(Header_StartGroup));
  859. end;
  860.  
  861. procedure TDXTextureImageFileBlockHeaderWriter.EndGroup;
  862. begin
  863.   WriteBlock(DXTextureImageFileBlockID_EndGroup);
  864.   EndBlock;
  865. end;
  866.  
  867. procedure DXTextureImage_SaveDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage);
  868. var
  869.   BlockHeaderWriter: TDXTextureImageFileBlockHeaderWriter;
  870.  
  871.   function CalcProgressCount(Image: TDXTextureImage): Integer;
  872.   var
  873.     i: Integer;
  874.   begin
  875.     Result := Image.WidthBytes*Image.Height;
  876.     for i:=0 to Image.SubImageCount-1 do
  877.       Inc(Result, CalcProgressCount(Image.SubImages[i]));
  878.   end;
  879.  
  880.   procedure WriteGroup_Image(Image: TDXTextureImage);
  881.   var
  882.     i: Integer;
  883.     Header_Image_Format: TDXTextureImageHeader_Image_Format;
  884.     Header_Image_Format_Index: TDXTextureImageHeader_Image_Format_Index;
  885.     Header_Image_Format_RGB: TDXTextureImageHeader_Image_Format_RGB;
  886.     Header_Image_GroupInfo: TDXTextureImageHeader_Image_GroupInfo;
  887.     Header_Image_TransparentColor: TDXTextureImageHeader_Image_TransparentColor;
  888.   begin
  889.     BlockHeaderWriter.StartGroup(DXTextureImageFileCategoryType_Image);
  890.     try
  891.       {  Image format writing  }
  892.       if Image.Size>0 then
  893.       begin
  894.         Header_Image_Format.ImageType := Image.ImageType;
  895.         Header_Image_Format.Width := Image.Width;
  896.         Header_Image_Format.Height := Image.Height;
  897.         Header_Image_Format.BitCount := Image.BitCount;
  898.         Header_Image_Format.WidthBytes := Image.WidthBytes;
  899.  
  900.         BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_Format);
  901.         try
  902.           Stream.WriteBuffer(Header_Image_Format, SizeOf(Header_Image_Format));
  903.  
  904.           case Image.ImageType of
  905.             DXTextureImageType_PaletteIndexedColor:
  906.               begin
  907.                 {  INDEX IMAGE  }
  908.                 Header_Image_Format_Index.idx_index_Mask := Image.idx_index.Mask;
  909.                 Header_Image_Format_Index.idx_alpha_Mask := Image.idx_alpha.Mask;
  910.                 for i:=0 to 255 do
  911.                   Header_Image_Format_Index.idx_palette[i] := Image.idx_palette[i];
  912.  
  913.                 Stream.WriteBuffer(Header_Image_Format_Index, SizeOf(Header_Image_Format_Index));
  914.               end;
  915.             DXTextureImageType_RGBColor:
  916.               begin
  917.                 {  RGB IMAGE  }
  918.                 Header_Image_Format_RGB.rgb_red_Mask := Image.rgb_red.Mask;
  919.                 Header_Image_Format_RGB.rgb_green_Mask := Image.rgb_green.Mask;
  920.                 Header_Image_Format_RGB.rgb_blue_Mask := Image.rgb_blue.Mask;
  921.                 Header_Image_Format_RGB.rgb_alpha_Mask := Image.rgb_alpha.Mask;
  922.  
  923.                 Stream.WriteBuffer(Header_Image_Format_RGB, SizeOf(Header_Image_Format_RGB));
  924.               end;
  925.           end;
  926.         finally
  927.           BlockHeaderWriter.EndBlock;
  928.         end;
  929.       end;
  930.  
  931.       {  Image group information writing  }
  932.       BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_GroupInfo);
  933.       try
  934.         Header_Image_GroupInfo.ImageGroupType := Image.ImageGroupType;
  935.         Header_Image_GroupInfo.ImageID := Image.ImageID;
  936.  
  937.         Stream.WriteBuffer(Header_Image_GroupInfo, SizeOf(Header_Image_GroupInfo));
  938.       finally
  939.         BlockHeaderWriter.EndBlock;
  940.       end;
  941.  
  942.       {  Name writing  }
  943.       BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_Name);
  944.       try
  945.         Stream.WriteBuffer(Image.ImageName[1], Length(Image.ImageName));
  946.       finally
  947.         BlockHeaderWriter.EndBlock;
  948.       end;
  949.  
  950.       {  Transparent color writing  }
  951.       BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_TransparentColor);
  952.       try
  953.         Header_Image_TransparentColor.Transparent := Image.Transparent;
  954.         Header_Image_TransparentColor.TransparentColor := Image.TransparentColor;
  955.  
  956.         Stream.WriteBuffer(Header_Image_TransparentColor, SizeOf(Header_Image_TransparentColor));
  957.       finally
  958.         BlockHeaderWriter.EndBlock;
  959.       end;
  960.  
  961.       {  Pixel data writing  }
  962.       if Image.Size>0 then
  963.       begin
  964.         BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_PixelData);
  965.         try
  966.          for i:=0 to Image.Height-1 do
  967.            Stream.WriteBuffer(Image.ScanLine[i]^, Image.Widthbytes);
  968.         finally
  969.           BlockHeaderWriter.EndBlock;
  970.         end;
  971.       end;
  972.  
  973.       {  Sub-image writing  }
  974.       for i:=0 to Image.SubImageCount-1 do
  975.         WriteGroup_Image(Image.SubImages[i]);
  976.     finally
  977.       BlockHeaderWriter.EndGroup;
  978.     end;
  979.   end;
  980.  
  981. var
  982.   FileHeader: TDXTextureImageFileHeader;
  983. begin
  984.   {  File header writing  }
  985.   FileHeader.FileType := DXTextureImageFile_Type;
  986.   FileHeader.ver := DXTextureImageFile_Version;
  987.   Stream.WriteBuffer(FileHeader, SizeOf(FileHeader));
  988.  
  989.   {  Image writing  }
  990.   BlockHeaderWriter := TDXTextureImageFileBlockHeaderWriter.Create(Stream);
  991.   try
  992.     {  Image writing  }
  993.     WriteGroup_Image(Image);
  994.  
  995.     {  End of file  }
  996.     BlockHeaderWriter.WriteBlock(DXTextureImageFileBlockID_EndFile);
  997.   finally
  998.     BlockHeaderWriter.Free;
  999.   end;
  1000. end;
  1001.  
  1002. {  DXTextureImage_LoadBitmapFunc  }
  1003.  
  1004. procedure DXTextureImage_LoadBitmapFunc(Stream: TStream; Image: TDXTextureImage);
  1005. type
  1006.   TDIBPixelFormat = packed record
  1007.     RBitMask, GBitMask, BBitMask: DWORD;
  1008.   end;
  1009. var
  1010.   TopDown: Boolean;
  1011.   BF: TBitmapFileHeader;
  1012.   BI: TBitmapInfoHeader;
  1013.  
  1014.   procedure DecodeRGB;
  1015.   var
  1016.     y: Integer;
  1017.   begin
  1018.     for y:=0 to Image.Height-1 do
  1019.     begin
  1020.       if TopDown then
  1021.         Stream.ReadBuffer(Image.ScanLine[y]^, Image.WidthBytes)
  1022.       else
  1023.         Stream.ReadBuffer(Image.ScanLine[Image.Height-y-1]^, Image.WidthBytes);
  1024.     end;
  1025.   end;
  1026.  
  1027.   procedure DecodeRLE4;
  1028.   var
  1029.     SrcDataP: Pointer;
  1030.     B1, B2, C: Byte;
  1031.     Dest, Src, P: PByte;
  1032.     X, Y, i: Integer;
  1033.   begin
  1034.     GetMem(SrcDataP, BI.biSizeImage);
  1035.     try
  1036.       Stream.ReadBuffer(SrcDataP^, BI.biSizeImage);
  1037.  
  1038.       Dest := Image.TopPBits;
  1039.       Src := SrcDataP;
  1040.       X := 0;
  1041.       Y := 0;
  1042.  
  1043.       while True do
  1044.       begin
  1045.         B1 := Src^; Inc(Src);
  1046.         B2 := Src^; Inc(Src);
  1047.  
  1048.         if B1=0 then
  1049.         begin
  1050.           case B2 of
  1051.             0: begin  {  End of line  }
  1052.                  X := 0; Inc(Y);
  1053.                  Dest := Image.ScanLine[Y];
  1054.                end;
  1055.             1: Break; {  End of bitmap  }
  1056.             2: begin  {  Difference of coordinates  }
  1057.                  Inc(X, B1); Inc(Y, B2); Inc(Src, 2);
  1058.                  Dest := Image.ScanLine[Y];
  1059.                end;
  1060.           else
  1061.             {  Absolute mode  }
  1062.             C := 0;
  1063.             for i:=0 to B2-1 do
  1064.             begin
  1065.               if i and 1=0 then
  1066.               begin
  1067.                 C := Src^; Inc(Src);
  1068.               end else
  1069.               begin
  1070.                 C := C shl 4;
  1071.               end;
  1072.  
  1073.               P := Pointer(Integer(Dest)+X shr 1);
  1074.               if X and 1=0 then
  1075.                 P^ := (P^ and $0F) or (C and $F0)
  1076.               else
  1077.                 P^ := (P^ and $F0) or ((C and $F0) shr 4);
  1078.  
  1079.               Inc(X);
  1080.             end;
  1081.           end;
  1082.         end else
  1083.         begin
  1084.           {  Encoding mode  }
  1085.           for i:=0 to B1-1 do
  1086.           begin
  1087.             P := Pointer(Integer(Dest)+X shr 1);
  1088.             if X and 1=0 then
  1089.               P^ := (P^ and $0F) or (B2 and $F0)
  1090.             else
  1091.               P^ := (P^ and $F0) or ((B2 and $F0) shr 4);
  1092.  
  1093.             Inc(X);
  1094.  
  1095.             // Swap nibble
  1096.             B2 := (B2 shr 4) or (B2 shl 4);
  1097.           end;
  1098.         end;
  1099.  
  1100.         {  Word arrangement  }
  1101.         Inc(Src, Longint(Src) and 1);
  1102.       end;
  1103.     finally
  1104.       FreeMem(SrcDataP);
  1105.     end;
  1106.   end;
  1107.  
  1108.   procedure DecodeRLE8;
  1109.   var
  1110.     SrcDataP: Pointer;
  1111.     B1, B2: Byte;
  1112.     Dest, Src: PByte;
  1113.     X, Y: Integer;
  1114.   begin
  1115.     GetMem(SrcDataP, BI.biSizeImage);
  1116.     try
  1117.       Stream.ReadBuffer(SrcDataP^, BI.biSizeImage);
  1118.  
  1119.       Dest := Image.TopPBits;
  1120.       Src := SrcDataP;
  1121.       X := 0;
  1122.       Y := 0;
  1123.  
  1124.       while True do
  1125.       begin
  1126.         B1 := Src^; Inc(Src);
  1127.         B2 := Src^; Inc(Src);
  1128.  
  1129.         if B1=0 then
  1130.         begin
  1131.           case B2 of
  1132.             0: begin  {  End of line  }
  1133.                  X := 0; Inc(Y);
  1134.                  Dest := Pointer(Longint(Image.TopPBits)+Y*Image.NextLine+X);
  1135.                end;
  1136.             1: Break; {  End of bitmap  }
  1137.             2: begin  {  Difference of coordinates  }
  1138.                  Inc(X, B1); Inc(Y, B2); Inc(Src, 2);
  1139.                  Dest := Pointer(Longint(Image.TopPBits)+Y*Image.NextLine+X);
  1140.                end;
  1141.           else
  1142.             {  Absolute mode  }
  1143.             Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2);
  1144.           end;
  1145.         end else
  1146.         begin
  1147.           {  Encoding mode  }
  1148.           FillChar(Dest^, B1, B2); Inc(Dest, B1);
  1149.         end;
  1150.  
  1151.         {  Word arrangement  }
  1152.         Inc(Src, Longint(Src) and 1);
  1153.       end;
  1154.     finally
  1155.       FreeMem(SrcDataP);
  1156.     end;
  1157.   end;
  1158.  
  1159. var
  1160.   BC: TBitmapCoreHeader;
  1161.   RGBTriples: array[0..255] of TRGBTriple;
  1162.   RGBQuads: array[0..255] of TRGBQuad;
  1163.   i, PalCount, j: Integer;
  1164.   OS2: Boolean;
  1165.   PixelFormat: TDIBPixelFormat;
  1166. begin
  1167.   {  File header reading  }
  1168.   i := Stream.Read(BF, SizeOf(TBitmapFileHeader));
  1169.   if i=0 then Exit;
  1170.   if i<>SizeOf(TBitmapFileHeader) then
  1171.     raise EDXTextureImageError.Create(SInvalidDIB);
  1172.  
  1173.   {  Is the head 'BM'?  }
  1174.   if BF.bfType<>Ord('B') + Ord('M')*$100 then
  1175.     raise EDXTextureImageError.Create(SInvalidDIB);
  1176.  
  1177.   {  Reading of size of header  }
  1178.   i := Stream.Read(BI.biSize, 4);
  1179.   if i<>4 then
  1180.     raise EDXTextureImageError.Create(SInvalidDIB);
  1181.  
  1182.   {  Kind check of DIB  }
  1183.   OS2 := False;
  1184.  
  1185.   case BI.biSize of
  1186.     SizeOf(TBitmapCoreHeader):
  1187.       begin
  1188.         {  OS/2 type  }
  1189.         Stream.ReadBuffer(Pointer(Integer(@BC)+4)^, SizeOf(TBitmapCoreHeader)-4);
  1190.  
  1191.         FilLChar(BI, SizeOf(BI), 0);
  1192.         with BI do
  1193.         begin
  1194.           biClrUsed := 0;
  1195.           biCompression := BI_RGB;
  1196.           biBitCount := BC.bcBitCount;
  1197.           biHeight := BC.bcHeight;
  1198.           biWidth := BC.bcWidth;
  1199.         end;
  1200.  
  1201.         OS2 := True;
  1202.       end;
  1203.     SizeOf(TBitmapInfoHeader):
  1204.       begin
  1205.         {  Windows type  }
  1206.         Stream.ReadBuffer(Pointer(Integer(@BI)+4)^, SizeOf(TBitmapInfoHeader)-4);
  1207.       end;
  1208.   else
  1209.     raise EDXTextureImageError.Create(SInvalidDIB);
  1210.   end;
  1211.  
  1212.   {  Bit mask reading  }
  1213.   if BI.biCompression = BI_BITFIELDS then
  1214.   begin
  1215.     Stream.ReadBuffer(PixelFormat, SizeOf(PixelFormat));
  1216.   end else
  1217.   begin
  1218.     if BI.biBitCount=16 then
  1219.     begin
  1220.       PixelFormat.RBitMask := $7C00;
  1221.       PixelFormat.GBitMask := $03E0;
  1222.       PixelFormat.BBitMask := $001F;
  1223.     end else if (BI.biBitCount=24) or (BI.biBitCount=32) then
  1224.     begin
  1225.       PixelFormat.RBitMask := $00FF0000;
  1226.       PixelFormat.GBitMask := $0300FF00;
  1227.       PixelFormat.BBitMask := $000000FF;
  1228.     end;
  1229.   end;
  1230.  
  1231.   {  DIB making  }
  1232.   if BI.biHeight<0 then
  1233.   begin
  1234.     BI.biHeight := -BI.biHeight;
  1235.     TopDown := True;
  1236.   end else
  1237.     TopDown := False;
  1238.  
  1239.   if BI.biBitCount in [1, 4, 8] then
  1240.   begin
  1241.     Image.SetSize(DXTextureImageType_PaletteIndexedColor, BI.biWidth, BI.biHeight, BI.biBitCount,
  1242.       (((BI.biWidth*BI.biBitCount)+31) div 32)*4);
  1243.  
  1244.     Image.idx_index := dxtMakeChannel(1 shl BI.biBitCount-1, True);
  1245.     Image.PackedPixelOrder := True;
  1246.   end else
  1247.   begin          
  1248.     Image.SetSize(DXTextureImageType_RGBColor, BI.biWidth, BI.biHeight, BI.biBitCount,
  1249.       (((BI.biWidth*BI.biBitCount)+31) div 32)*4);
  1250.  
  1251.     Image.rgb_red := dxtMakeChannel(PixelFormat.RBitMask, False);
  1252.     Image.rgb_green := dxtMakeChannel(PixelFormat.GBitMask, False);
  1253.     Image.rgb_blue := dxtMakeChannel(PixelFormat.BBitMask, False);
  1254.  
  1255.     j := Image.rgb_red.BitCount+Image.rgb_green.BitCount+Image.rgb_blue.BitCount;
  1256.     if j<BI.biBitCount then
  1257.       Image.rgb_alpha := dxtMakeChannel((1 shl (BI.biBitCount-j)-1) shl j, False);
  1258.  
  1259.     Image.PackedPixelOrder := False;
  1260.   end;
  1261.  
  1262.   {  palette reading  }
  1263.   PalCount := BI.biClrUsed;
  1264.   if (PalCount=0) and (BI.biBitCount<=8) then
  1265.     PalCount := 1 shl BI.biBitCount;
  1266.   if PalCount>256 then PalCount := 256;
  1267.  
  1268.   if OS2 then
  1269.   begin
  1270.     {  OS/2 type  }
  1271.     Stream.ReadBuffer(RGBTriples, SizeOf(TRGBTriple)*PalCount);
  1272.     for i:=0 to PalCount-1 do
  1273.     begin
  1274.       Image.idx_palette[i].peRed := RGBTriples[i].rgbtRed;
  1275.       Image.idx_palette[i].peGreen := RGBTriples[i].rgbtGreen;
  1276.       Image.idx_palette[i].peBlue := RGBTriples[i].rgbtBlue;
  1277.     end;
  1278.   end else
  1279.   begin
  1280.     {  Windows type  }
  1281.     Stream.ReadBuffer(RGBQuads, SizeOf(TRGBQuad)*PalCount);
  1282.     for i:=0 to PalCount-1 do
  1283.     begin
  1284.       Image.idx_palette[i].peRed := RGBQuads[i].rgbRed;
  1285.       Image.idx_palette[i].peGreen := RGBQuads[i].rgbGreen;
  1286.       Image.idx_palette[i].peBlue := RGBQuads[i].rgbBlue;
  1287.     end;
  1288.   end;
  1289.  
  1290.   {  Pixel data reading  }
  1291.   case BI.biCompression of
  1292.     BI_RGB      : DecodeRGB;
  1293.     BI_BITFIELDS: DecodeRGB;
  1294.     BI_RLE4     : DecodeRLE4;
  1295.     BI_RLE8     : DecodeRLE8;
  1296.   else
  1297.     raise EDXTextureImageError.Create(SInvalidDIB);
  1298.   end;
  1299. end;
  1300.  
  1301. initialization
  1302. finalization
  1303.   _DXTextureImageLoadFuncList.Free;
  1304. end.
  1305.