⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dxteximg.pas

📁 传奇客户端源码DClient很不错哦直的研究的游戏源码
💻 PAS
📖 第 1 页 / 共 3 页
字号:
  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 + -