dxteximg.pas

原版翎风(LF)引擎(M2)源码(Delphi)

            if FPackedPixelOrder then
              Result := (PByte(Integer(FTopPBits)+FNextLine*y+x shr 3)^ and Mask1[7-x and 7]) shr Shift1[7-x and 7]
            else
              Result := (PByte(Integer(FTopPBits)+FNextLine*y+x shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7];
          end;
      2 : begin
            if FPackedPixelOrder then
              Result := (PByte(Integer(FTopPBits)+FNextLine*y+x shr 2)^ and Mask2[3-x and 3]) shr Shift2[3-x and 3]
            else
              Result := (PByte(Integer(FTopPBits)+FNextLine*y+x shr 2)^ and Mask2[x and 3]) shr Shift2[x and 3];
          end;
      4 : begin
            if FPackedPixelOrder then
              Result := (PByte(Integer(FTopPBits)+FNextLine*y+x shr 1)^ and Mask4[1-x and 1]) shr Shift4[1-x and 1]
            else
              Result := (PByte(Integer(FTopPBits)+FNextLine*y+x shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1];
          end;
      8 : Result := PByte(Integer(FTopPBits)+FNextLine*y+x)^;
      16: Result := PWord(Integer(FTopPBits)+FNextLine*y+x*2)^;
      24: PByte3(@Result)^ := PByte3(Integer(FTopPBits)+FNextLine*y+x*3)^;
      32: Result := PDWORD(Integer(FTopPBits)+FNextLine*y+x*4)^;
    end;
  end;
end;

procedure TDXTextureImage.SetPixel(x, y: Integer; c: DWORD);
var
  P: PByte;
begin
  if (x>=0) and (x<FWidth) and (y>=0) and (y<FHeight) then
  begin
    case FBitCount of
      1 : begin
            P := Pointer(Integer(FTopPBits)+FNextLine*y+x shr 3);
            if FPackedPixelOrder then
              P^ := (P^ and (not Mask1[7-x and 7])) or ((c and 1) shl Shift1[7-x and 7])
            else
              P^ := (P^ and (not Mask1[x and 7])) or ((c and 1) shl Shift1[x and 7]);
          end;
      2 : begin
            P := Pointer(Integer(FTopPBits)+FNextLine*y+x shr 2);
            if FPackedPixelOrder then
              P^ := (P^ and (not Mask2[3-x and 3])) or ((c and 3) shl Shift2[3-x and 3])
            else
              P^ := (P^ and (not Mask2[x and 3])) or ((c and 3) shl Shift2[x and 3]);
          end;
      4 : begin
            P := Pointer(Integer(FTopPBits)+FNextLine*y+x shr 1);
            if FPackedPixelOrder then
              P^ := (P^ and (not Mask4[1-x and 1])) or ((c and 7) shl Shift4[1-x and 1])
            else
              P^ := (P^ and (not Mask4[x and 1])) or ((c and 7) shl Shift4[x and 1]);
          end;
      8 : PByte(Integer(FTopPBits)+FNextLine*y+x)^ := c;
      16: PWord(Integer(FTopPBits)+FNextLine*y+x*2)^ := c;
      24: PByte3(Integer(FTopPBits)+FNextLine*y+x*3)^ := PByte3(@c)^;
      32: PDWORD(Integer(FTopPBits)+FNextLine*y+x*4)^ := c;
    end;
  end;
end;

procedure TDXTextureImage.LoadFromFile(const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TDXTextureImage.LoadFromStream(Stream: TStream);
var
  i, p: Integer;
begin
  Clear;

  p := Stream.Position;
  for i:=0 to DXTextureImageLoadFuncList.Count-1 do
  begin
    Stream.Position := p;
    try
      TDXTextureImageLoadFunc(DXTextureImageLoadFuncList[i])(Stream, Self);
      Exit;
    except
      Clear;
    end;
  end;

  raise EDXTextureImageError.Create(SNotSupportGraphicFile);
end;

procedure TDXTextureImage.SaveToFile(const FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure DXTextureImage_SaveDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage); forward;

procedure TDXTextureImage.SaveToStream(Stream: TStream);
begin
  DXTextureImage_SaveDXTextureImageFunc(Stream, Self);
end;

{  DXTextureImage_LoadDXTextureImageFunc  }

const
  DXTextureImageFile_Type     = 'dxt:';
  DXTextureImageFile_Version  = $100;

  DXTextureImageCompress_None = 0;

  DXTextureImageFileCategoryType_Image             = $100;

  DXTextureImageFileBlockID_EndFile                = 0;
  DXTextureImageFileBlockID_EndGroup               = 1;
  DXTextureImageFileBlockID_StartGroup             = 2;
  DXTextureImageFileBlockID_Image_Format           = DXTextureImageFileCategoryType_Image + 1;
  DXTextureImageFileBlockID_Image_PixelData        = DXTextureImageFileCategoryType_Image + 2;
  DXTextureImageFileBlockID_Image_GroupInfo        = DXTextureImageFileCategoryType_Image + 3;
  DXTextureImageFileBlockID_Image_Name             = DXTextureImageFileCategoryType_Image + 4;
  DXTextureImageFileBlockID_Image_TransparentColor = DXTextureImageFileCategoryType_Image + 5;

type
  TDXTextureImageFileHeader = packed record
    FileType: array[0..4] of Char;
    ver: DWORD;
  end;

  TDXTextureImageFileBlockHeader = packed record
    ID: DWORD;
    Size: Integer;
  end;

  TDXTextureImageFileBlockHeader_StartGroup = packed record
    CategoryType: DWORD;
  end;

  TDXTextureImageHeader_Image_Format = packed record
    ImageType: TDXTextureImageType;
    Width: DWORD;
    Height: DWORD;
    BitCount: DWORD;
    WidthBytes: DWORD;
  end;

  TDXTextureImageHeader_Image_Format_Index = packed record
    idx_index_Mask: DWORD;
    idx_alpha_Mask: DWORD;
    idx_palette: array[0..255] of TPaletteEntry;
  end;

  TDXTextureImageHeader_Image_Format_RGB = packed record
    rgb_red_Mask: DWORD;
    rgb_green_Mask: DWORD;
    rgb_blue_Mask: DWORD;
    rgb_alpha_Mask: DWORD;
  end;

  TDXTextureImageHeader_Image_GroupInfo = packed record
    ImageGroupType: DWORD;
    ImageID: DWORD;
  end;

  TDXTextureImageHeader_Image_TransparentColor = packed record
    Transparent: Boolean;
    TransparentColor: DWORD;
  end;

procedure DXTextureImage_LoadDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage);

  procedure ReadGroup_Image(Image: TDXTextureImage);
  var
    i: Integer;
    BlockHeader: TDXTextureImageFileBlockHeader;
    NextPos: Integer;
    SubImage: TDXTextureImage;
    Header_StartGroup: TDXTextureImageFileBlockHeader_StartGroup;
    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;
    ImageName: string;
  begin
    while True do
    begin
      Stream.ReadBuffer(BlockHeader, SizeOf(BlockHeader));
      NextPos := Stream.Position + BlockHeader.Size;

      case BlockHeader.ID of
        DXTextureImageFileBlockID_EndGroup:
          begin
            {  End of group  }
            Break;
          end;
        DXTextureImageFileBlockID_StartGroup:
          begin
            {  Beginning of group  }
            Stream.ReadBuffer(Header_StartGroup, SizeOf(Header_StartGroup));
            case Header_StartGroup.CategoryType of
              DXTextureImageFileCategoryType_Image:
                begin
                  {  Image group  }
                  SubImage := TDXTextureImage.CreateSub(Image);
                  try
                    ReadGroup_Image(SubImage);
                  except
                    SubImage.Free;
                    raise;
                  end;
                end;
            end;
          end;
        DXTextureImageFileBlockID_Image_Format:
          begin
            {  Image information reading (size etc.)  }
            Stream.ReadBuffer(Header_Image_Format, SizeOf(Header_Image_Format));

            if (Header_Image_Format.ImageType<>DXTextureImageType_PaletteIndexedColor) and
              (Header_Image_Format.ImageType<>DXTextureImageType_RGBColor) then
              raise EDXTextureImageError.Create(SInvalidDXTFile);

            Image.SetSize(Header_Image_Format.ImageType, Header_Image_Format.Width, Header_Image_Format.Height,
              Header_Image_Format.BitCount, Header_Image_Format.Widthbytes);

            if Header_Image_Format.ImageType=DXTextureImageType_PaletteIndexedColor then
            begin
              {  INDEX IMAGE  }
              Stream.ReadBuffer(Header_Image_Format_Index, SizeOf(Header_Image_Format_Index));

              Image.idx_index := dxtMakeChannel(Header_Image_Format_Index.idx_index_Mask, True);
              Image.idx_alpha := dxtMakeChannel(Header_Image_Format_Index.idx_alpha_Mask, False);

              for i:=0 to 255 do
                Image.idx_palette[i] := Header_Image_Format_Index.idx_palette[i];
            end else if Header_Image_Format.ImageType=DXTextureImageType_RGBColor then
            begin
              {  RGB IMAGE  }
              Stream.ReadBuffer(Header_Image_Format_RGB, SizeOf(Header_Image_Format_RGB));

              Image.rgb_red := dxtMakeChannel(Header_Image_Format_RGB.rgb_red_Mask, False);
              Image.rgb_green := dxtMakeChannel(Header_Image_Format_RGB.rgb_green_Mask, False);
              Image.rgb_blue := dxtMakeChannel(Header_Image_Format_RGB.rgb_blue_Mask, False);
              Image.rgb_alpha := dxtMakeChannel(Header_Image_Format_RGB.rgb_alpha_Mask, False);
            end;
          end;
        DXTextureImageFileBlockID_Image_Name:
          begin
            {  Name reading  }
            SetLength(ImageName, BlockHeader.Size);
            Stream.ReadBuffer(ImageName[1], BlockHeader.Size);

            Image.ImageName := ImageName;
          end;
        DXTextureImageFileBlockID_Image_GroupInfo:
          begin
            {  Image group information reading  }
            Stream.ReadBuffer(Header_Image_GroupInfo, SizeOf(Header_Image_GroupInfo));

            Image.ImageGroupType := Header_Image_GroupInfo.ImageGroupType;
            Image.ImageID := Header_Image_GroupInfo.ImageID;
          end;
        DXTextureImageFileBlockID_Image_TransparentColor:
          begin
            {  Transparent color information reading  }
            Stream.ReadBuffer(Header_Image_TransparentColor, SizeOf(Header_Image_TransparentColor));

            Image.Transparent := Header_Image_TransparentColor.Transparent;
            Image.TransparentColor := Header_Image_TransparentColor.TransparentColor;
          end;
        DXTextureImageFileBlockID_Image_PixelData:
          begin
            {  Pixel data reading  }
            for i:=0 to Image.Height-1 do
              Stream.ReadBuffer(Image.ScanLine[i]^, Header_Image_Format.Widthbytes);
          end;
      end;

      Stream.Seek(NextPos, soFromBeginning);
    end;
  end;

var
  FileHeader: TDXTextureImageFileHeader;
  BlockHeader: TDXTextureImageFileBlockHeader;
  Header_StartGroup: TDXTextureImageFileBlockHeader_StartGroup;
  NextPos: Integer;
begin
  {  File header reading  }
  Stream.ReadBuffer(FileHeader, SizeOf(FileHeader));

  if FileHeader.FileType<>DXTextureImageFile_Type then
    raise EDXTextureImageError.Create(SInvalidDXTFile);
  if FileHeader.ver<>DXTextureImageFile_Version then
    raise EDXTextureImageError.Create(SInvalidDXTFile);

  while True do
  begin
    Stream.ReadBuffer(BlockHeader, SizeOf(BlockHeader));
    NextPos := Stream.Position + BlockHeader.Size;

    case BlockHeader.ID of
      DXTextureImageFileBlockID_EndFile:
        begin
          {  End of file  }
          Break;
        end;
      DXTextureImageFileBlockID_StartGroup:
        begin
          {  Beginning of group  }
          Stream.ReadBuffer(Header_StartGroup, SizeOf(Header_StartGroup));
          case Header_StartGroup.CategoryType of
            DXTextureImageFileCategoryType_Image: ReadGroup_Image(Image);
          end;
        end;
    end;
    
    Stream.Seek(NextPos, soFromBeginning);
  end;
end;

type
  PDXTextureImageFileBlockHeaderWriter_BlockInfo = ^TDXTextureImageFileBlockHeaderWriter_BlockInfo;
  TDXTextureImageFileBlockHeaderWriter_BlockInfo = record
    BlockID: DWORD;
    StreamPos: Integer;
  end;

  TDXTextureImageFileBlockHeaderWriter = class
  private
    FStream: TStream;
    FList: TList;
  public
    constructor Create(Stream: TStream);
    destructor Destroy; override;
    procedure StartBlock(BlockID: DWORD);
    procedure EndBlock;
    procedure WriteBlock(BlockID: DWORD);
    procedure StartGroup(CategoryType: DWORD);
    procedure EndGroup;
  end;

constructor TDXTextureImageFileBlockHeaderWriter.Create(Stream: TStream);
begin
  inherited Create;
  FStream := Stream;
  FList := TList.Create;
end;

destructor TDXTextureImageFileBlockHeaderWriter.Destroy;
var
  i: Integer;
begin
  for i:=0 to FList.Count-1 do
    Dispose(PDXTextureImageFileBlockHeaderWriter_BlockInfo(FList[i]));
  FList.Free;
  inherited Destroy;
end;

procedure TDXTextureImageFileBlockHeaderWriter.StartBlock(BlockID: DWORD);
var
  BlockInfo: PDXTextureImageFileBlockHeaderWriter_BlockInfo;
  BlockHeader: TDXTextureImageFileBlockHeader;
begin
  New(BlockInfo);
  BlockInfo.BlockID := BlockID;
  BlockInfo.StreamPos := FStream.Position;
  FList.Add(BlockInfo);

  BlockHeader.ID := BlockID;
  BlockHeader.Size := 0;
  FStream.WriteBuffer(BlockHeader, SizeOf(BlockHeader));
end;

procedure TDXTextureImageFileBlockHeaderWriter.EndBlock;
var
  BlockHeader: TDXTextureImageFileBlockHeader;
  BlockInfo: PDXTextureImageFileBlockHeaderWriter_BlockInfo;
  CurStreamPos: Integer;
begin
  CurStreamPos := FStream.Position;
  try
    BlockInfo := FList[FList.Count-1];

    FStream.Position := BlockInfo.StreamPos;
    BlockHeader.ID := BlockInfo.BlockID;
    BlockHeader.Size := CurStreamPos-(BlockInfo.StreamPos+SizeOf(TDXTextureImageFileBlockHeader));
    FStream.WriteBuffer(BlockHeader, SizeOf(BlockHeader));
  finally
    FStream.Position := CurStreamPos;

    Dispose(FList[FList.Count-1]);
    FList.Count := FList.Count-1;
  end;
end;

procedure TDXTextureImageFileBlockHeaderWriter.WriteBlock(BlockID: DWORD);
var
  BlockHeader: TDXTextureImageFileBlockHeader;
begin
  BlockHeader.ID := BlockID;
  BlockHeader.Size := 0;
  FStream.WriteBuffer(BlockHeader, SizeOf(BlockHeader));
end;

procedure TDXTextureImageFileBlockHeaderWriter.StartGroup(CategoryType: DWORD);
var
  Header_StartGroup: TDXTextureImageFileBlockHeader_StartGroup;
begin
  StartBlock(DXTextureImageFileBlockID_StartGroup);

  Header_StartGroup.CategoryType := CategoryType;
  FStream.WriteBuffer(Header_StartGroup, SizeOf(Header_StartGroup));
end;

procedure TDXTextureImageFileBlockHeaderWriter.EndGroup;
begin
  WriteBlock(DXTextureImageFileBlockID_EndGroup);
  EndBlock;
end;

procedure DXTextureImage_SaveDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage);
var
  BlockHeaderWriter: TDXTextureImageFileBlockHeaderWriter;