有没有Delphi大佬

奔放的牛

有没有Delphi大佬帮忙转易语言

奔放的牛

落单的拖鞋 发表于 2025-5-13 14:04
发来看看

代码放不上来

奔放的牛

[Delphi] 纯文本查看 复制代码

unit was;

interface

uses
  SysUtils, Classes, Graphics, Dialogs, StrUtils;

type
  TWasPixel = record
    Alpha: Byte;
    Index: Byte;
  end;

  TWasImageInfo = record
    Key_X: Integer;
    Key_Y: Integer;
    Width: Integer;
    Height: Integer;
  end;

  TWasImage = record
    Info: TWasImageInfo;
    Data: array of TWasPixel;
  end;

  TWasFileInfo = record
    wfType: Word;
    whSize: Word;
    SpriteCount: Word;
    FrameCount: Word;
    MaxWidth: Word;
    MaxHeight: Word;
    Key_X: Word;
    Key_Y: Word;
  end;

  HighPal = array [0..255] of Word;
  
  TWasFile = class
  private
    // 图片信息
    Info: TWasFileInfo;
    Data: array of TWasImage;
    HeadData: array of Byte;  // 存储多余的文件头
    HeadDataSize: Integer;

    // 2个调色板
    OriginalPal: array [0..255] of Word;
    CurrentPal: array [0..255] of Word;

    // 原始文件
    FName: string;
    FSize: Cardinal;
    FData: array of Byte;
    fInitialized: Boolean;

    // xxxxxxxxxxxxxxxxxx
    procedure DecodeFromStream(var Dest: TWasImage; Stream: TStream);
    procedure Init();
    procedure Burn();
  public
    constructor Create();
    destructor Destroy(); override;
    // 相关方法
    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
    procedure Draw(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);
    procedure DrawByKey(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);
    function GetSpriteCount(): Integer;
    function GetFrameCount(): Integer;
    function GetWidth(): Integer;
    function GetHeight(): Integer;
    function GetFileName(): String;
    function GetIsInit(): Boolean;
    procedure GetCurrentPal(var aHighPal: HighPal);
    procedure GetOriginalPal(var aHighPal: HighPal);
    procedure SetCurrentPal(aHighPal: HighPal);
    procedure ResetCurrentPal();
    procedure SaveToTGA();
    procedure DrawToTGA(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);
    procedure Close;
  end;

function PosLast(substr1,str1: widestring):Integer;

implementation

procedure TWasFile.Close;
begin
  Burn;
  Init;
end;

procedure TWasFile.Init();
begin
  Info.wfType := 0;
  Info.whSize := 0;
  Info.SpriteCount := 0;
  Info.FrameCount := 0;
  Info.MaxWidth := 0;
  Info.MaxHeight := 0;
  Info.Key_X := 0;
  Info.Key_Y := 0;

  Self.FName := '';
  Self.FSize := 0;

  Self.HeadDataSize := 0;
end;

procedure TWasFile.Burn();
var
  i: Integer;
begin
  for i:=Low(Data) to High(Data) do
  begin
    Data.Data := nil;
  end;
  Data := nil;
  FData := nil;

  HeadData := nil;
  
  fInitialized := false;
end;

constructor TWasFile.Create();
begin
  Init;
  fInitialized := false;
end;

destructor TWasFile.Destroy();
begin
  Burn;
end;

procedure TWasFile.DecodeFromStream(var Dest: TWasImage; Stream: TStream);
var
  StartPos: Int64;  // 文件在 Stream 中的 Offset
  LineOffset: array of Cardinal;
  x,y: Integer;
  tmp, tmp2: Byte;
  alpha: Byte;
  i: Integer;
  Width, Height: Integer;
begin
  StartPos := Stream.Position;
  Stream.Read(Dest.Info, SizeOf(Dest.Info));

  Width := Dest.Info.Width;
  Height := Dest.Info.Height;

  LineOffset := nil;
  SetLength(LineOffset, Height);
  Dest.Data := nil;
  SetLength(Dest.Data, Width * Height);

  for i:=Low(Dest.Data) to High(Dest.Data) do
  begin
    // 初始化Data，因为后面有跳过某些字节的操作
    Dest.Data.Alpha := $0;
    Dest.Data.Index := $0;
  end;

  Stream.Read(LineOffset[0], 4 * Height);

  for y:=0 to Height-1 do
  begin
    x := 0;
    Stream.Seek(StartPos + LineOffset[y], soFromBeginning);
    while (x < Width) do
    begin
      Stream.Read(tmp, 1);
      case (tmp and $C0) of
        $00:  // 00 - 透明色
        begin
          if (tmp and $20)>0 then
          begin
            tmp2 := tmp and $1F;  // alpha
            Stream.Read(tmp, 1);
            Dest.Data[y*Width+x].Index := tmp;
            Dest.Data[y*Width+x].Alpha := tmp2;
            Inc(x);
          end
          else if tmp<>0 then
          begin
            // 重复alpha像素的分支
            tmp2 := tmp and $1F;  // 次数
            Stream.Read(alpha, 1);
            alpha := alpha and $1F;
            Stream.Read(tmp, 1);
            for i:=1 to tmp2 do
            begin
              Dest.Data[y*Width+x].Alpha := alpha;
              Dest.Data[y*Width+x].Index := tmp;
              Inc(x);
            end;
          end
          else
          begin
            // tmp 是$0表示数据段结束
            if x>Width then
              raise Exception.Create('第'+IntToStr(y)+'行遇到错误数据啦！');
            x := Width;
          end;
        end;
        $40:  // 01 - 像素组
        begin
          tmp2 := tmp and $3F;
          for i:=1 to tmp2 do
          begin
            Stream.Read(tmp, 1);
            Dest.Data[y*Width+x].Alpha := 32;//$1F;
            Dest.Data[y*Width+x].Index := tmp;
            inc(x);
          end;
        end;
        $80:  // 10 - 重复n次
        begin
          tmp2 := tmp and $3F;
          Stream.Read(tmp, 1);
          for i:=1 to tmp2 do
          begin
            Dest.Data[y*Width+x].Alpha := 32;//$1F;
            Dest.Data[y*Width+x].Index := tmp;
            inc(x);
          end;
        end;
        $C0:  // 11 - 跳过n字节
        begin
          tmp2 := tmp and $3F;
          x := x + tmp2;
        end;
      end;  // end of case

      if x>Width then
        raise Exception.Create('第'+IntToStr(y)+'行遇到错误数据啦！');
    end;  // end of while
  end;
  LineOffset := nil;
end;

procedure TWasFile.LoadFromFile(const FileName: string);
var
  Stream: TStream;
  FileOffset: array of Cardinal;
  i: Integer;
begin
  Stream := TMemoryStream.Create;
  try
    TMemoryStream(Stream).LoadFromFile(FileName);
    Burn;
    Init;
    Stream.Read(Info, SizeOf(Info));
    if Info.wfType <> $5053 then
      raise Exception.Create('错误的文件标识！');
    if Info.whSize < $0C then
      raise Exception.Create('错误的文件版本，请与作者联系！')
    else if Info.whSize > $0C then
    begin
      // 当文件头大小大于$0C的时候
      HeadDataSize := Info.whSize - $0C;
      SetLength(HeadData, HeadDataSize);
      Stream.Read(HeadData[0], HeadDataSize);
    end;
    if (Info.SpriteCount < 1) or (Info.FrameCount < 1) then
      raise Exception.Create('错误的精灵数或帧数！');
    // 开始加载图片
    i := Info.SpriteCount * Info.FrameCount;
    SetLength(Data, i);
    SetLength(FileOffset, i);
    Stream.Read(OriginalPal[0], 512); // 高彩调色板
    Stream.Read(FileOffset[0], 4*i);  // 子文件偏移量

    for i:=Low(FileOffset) to High(FileOffset) do
    begin
      if FileOffset=0 then
      begin
        // 想不出更合适的办法了
        with Data do
        begin
          Info.Width := 1;
          Info.Height := 1;
          Info.Key_X := 0;
          Info.Key_Y := 0;
          SetLength(Data, 1);
          Data[0].Alpha := $0;
          Data[0].Index := $0;
        end;
      end
      else
      begin
        Stream.Seek(FileOffset+Info.whSize+4, soFromBeginning);
        DecodeFromStream(Data, Stream);
      end;
    end;

    FName := FileName;
    FSize := Stream.Size - $204 - Info.whSize;
    FData := nil;
    SetLength(FData, FSize);
    Stream.Seek($4+Info.whSize, soFromBeginning);
    Stream.Read(CurrentPal[0], $200);
    Stream.Read(FData[0], FSize);
    fInitialized := true;
  finally
    Stream.Free;
  end;
end;

procedure TWasFile.DrawByKey(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);
var
  New_X: Integer;
  New_Y: Integer;
  New_Width: Integer;
  New_Height: Integer;
  New_Left: Integer;
  New_Top: Integer;

  i,j: Integer;
  pDest: PByteArray;
  Color: Word;
  Alpha: Byte;
begin
  if not fInitialized then
    raise Exception.Create('没加载图片，画什么啊！');
  if (Index<0) or (Index>(Info.SpriteCount * Info.FrameCount)) then
    raise Exception.Create('没有第'+IntToStr(Index)+'张图片，没法画！');

  // 裁减
  New_X := X - Data[Index].Info.Key_X;
  New_Y := Y - Data[Index].Info.Key_Y;
  New_Width := Data[Index].Info.Width;
  New_Height := Data[Index].Info.Height;
  New_Left := 0;
  New_Top := 0;

  if (New_X > Dest.Width) or (New_Y > Dest.Height) then
    exit;
  if (New_X + New_Width) > Dest.Width then
    New_Width := Dest.Width - New_X;
  if (New_Y + New_Height) > Dest.Height then
    New_Height := Dest.Height - New_Y;

  if New_X < 0 then
  begin
    New_Left := -New_X;
    New_X := 0;
  end;
  if New_Y < 0 then
  begin
    New_Top := -New_Y;
    New_Y := 0
  end;

  for i:=New_Top to New_Height-1 do
  begin
    pDest := Dest.ScanLine[New_Y+i-New_Top];
    Inc(LongWord(pDest), 3*New_X);
    for j:=New_Left to New_Width-1 do
    begin
      Color := CurrentPal[Data[Index].Data[i*Data[Index].Info.Width+j].Index];
      Alpha := Data[Index].Data[i*Data[Index].Info.Width+j].Alpha;
      pDest[0] := (((Color and $001F) shl 3) - pDest[0]) * Alpha div 32 + pDest[0];
      pDest[1] := (((Color and $07E0) shr 3) - pDest[1]) * Alpha div 32 + pDest[1];
      pDest[2] := (((Color and $F800) shr 8) - pDest[2]) * Alpha div 32 + pDest[2];
      Inc(LongWord(pDest), 3);
    end;
  end;
end;

procedure TWasFile.Draw(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);
begin
  DrawByKey(Dest, X+Data[Index].Info.Key_X, Y+Data[Index].Info.Key_Y, Index);
end;

procedure TWasFile.SaveToFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    Stream.Write(Info, SizeOf(Info));
    Stream.Write(HeadData[0], HeadDataSize);
    Stream.Write(CurrentPal[0], $200);
    Stream.Write(FData[0], FSize);
  finally
    Stream.Free;
  end;
end;

function TWasFile.GetSpriteCount(): Integer;
begin
  Result := Info.SpriteCount;
end;

function TWasFile.GetFrameCount(): Integer;
begin
  Result := Info.FrameCount;
end;

function TWasFile.GetWidth(): Integer;
begin
  Result := Info.MaxWidth;
end;

function TWasFile.GetHeight(): Integer;
begin
  Result := Info.MaxHeight;
end;

function TWasFile.GetFileName(): String;
begin
  Result := FName;
end;

function TWasFile.GetIsInit(): Boolean;
begin
  Result := fInitialized;
end;

procedure TWasFile.GetCurrentPal(var aHighPal: HighPal);
var
  i: Integer;
begin
  for i:=0 to 255 do
  begin
    aHighPal := CurrentPal;
  end;
end;

procedure TWasFile.GetOriginalPal(var aHighPal: HighPal);
var
  i: Integer;
begin
  for i:=0 to 255 do
  begin
    aHighPal := OriginalPal;
  end;
end;

procedure TWasFile.SetCurrentPal(aHighPal: HighPal);
var
  i: Integer;
begin
  for i:=0 to 255 do
  begin
    CurrentPal := aHighPal;
  end;
end;

procedure TWasFile.ResetCurrentPal();
var
  i: Integer;
begin
  for i:=0 to 255 do
  begin
    CurrentPal := OriginalPal;
  end;
end;

procedure TWasFile.SaveToTGA();
var
  fs1: TStream;
  i,l,x,y: Integer;
  path: widestring;
  FileName: widestring;
  tmp: Byte;
  bufbmp: TBitmap;
  pDest: PByteArray;
begin
  FileName := FName;
  i := PosLast('.', FileName);
  path := LeftStr(FileName, i-1);

  bufbmp := TBitmap.Create;
  bufbmp.PixelFormat := pf32bit;
  bufbmp.Width := Info.MaxWidth;
  bufbmp.Height := Info.MaxHeight;

  for i:=Low(Data) to High(Data) do
  begin
    FileName := path + Format('%x%.3d.tga',[(i div Info.FrameCount),(i mod Info.FrameCount)]);
    fs1 := TFileStream.Create(FileName, fmCreate);
    l := $00020000;
    fs1.Write(l, 4);
    l := $0;
    fs1.Write(l, 4);
    fs1.Write(l, 4);
    fs1.Write(Info.MaxWidth, 2);
    fs1.Write(Info.MaxHeight, 2);
    tmp := $20;
    fs1.Write(tmp, 1);
    tmp := $08; // 原点在左下用$08,原点在左上用$28;
    fs1.Write(tmp, 1);

    // 清空bufbmp
    for y:=0 to bufbmp.Height-1 do
    begin
      pDest := bufbmp.ScanLine[y];
      for x:=0 to bufbmp.Width-1 do
      begin
        pDest[0]:=0;
        pDest[1]:=0;
        pDest[2]:=0;
        pDest[3]:=0;
        Inc(LongWord(pDest), 4);
      end;
    end;

    DrawToTGA(bufbmp, Info.Key_X, Info.Key_Y, i);

    for y:=bufbmp.Height-1 downto 0 do
    begin
      pDest := bufbmp.ScanLine[y];
      fs1.Write(pDest[0], 4*bufbmp.Width);
    end;
    
    fs1.Free;
  end;
  bufbmp := nil;
end;

function PosLast(substr1,str1: widestring):Integer;
var
  str2: widestring;
  i,l: Integer;
  sum: Integer;
begin
  sum := 0;
  str2 := str1;
//  i := Pos('\',str1);
  i := Pos(substr1, str2);
  while i<>0 do
  begin
    l := Length(str2);
    sum := sum + i;
    str2 := RightStr(str2, l-i);
    i := Pos(substr1, str2);
  end;
  Result := sum;
end;

// 仅为TGA服务
procedure TWasFile.DrawToTGA(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);
var
  New_X: Integer;
  New_Y: Integer;
  New_Width: Integer;
  New_Height: Integer;
  New_Left: Integer;
  New_Top: Integer;

  i,j: Integer;
  pDest: PByteArray;
  Color: Word;
  Alpha: Byte;
begin
  if not fInitialized then
    raise Exception.Create('没加载图片，画什么啊！');
  if (Index<0) or (Index>(Info.SpriteCount * Info.FrameCount)) then
    raise Exception.Create('没有第'+IntToStr(Index)+'张图片，没法画！');

  // 裁减
  New_X := X - Data[Index].Info.Key_X;
  New_Y := Y - Data[Index].Info.Key_Y;
  New_Width := Data[Index].Info.Width;
  New_Height := Data[Index].Info.Height;
  New_Left := 0;
  New_Top := 0;

  if (New_X > Dest.Width) or (New_Y > Dest.Height) then
    exit;
  if (New_X + New_Width) > Dest.Width then
    New_Width := Dest.Width - New_X;
  if (New_Y + New_Height) > Dest.Height then
    New_Height := Dest.Height - New_Y;

  if New_X < 0 then
  begin
    New_Left := -New_X;
    New_X := 0;
  end;
  if New_Y < 0 then
  begin
    New_Top := -New_Y;
    New_Y := 0
  end;

  for i:=New_Top to New_Height-1 do
  begin
    pDest := Dest.ScanLine[New_Y+i-New_Top];
    Inc(LongWord(pDest), 4*New_X);
    for j:=New_Left to New_Width-1 do
    begin
      Color := CurrentPal[Data[Index].Data[i*Data[Index].Info.Width+j].Index];
      Alpha := Data[Index].Data[i*Data[Index].Info.Width+j].Alpha;
      if Alpha=0 then
      begin
        // 0号调色板不一定是黑色，为了photoshop里显示的效果
        // 强制写入黑色
        pDest[0] := 0;
        pDest[1] := 0;
        pDest[2] := 0;
        pDest[3] := 0;
      end
      else if Alpha=32 then
      begin
        pDest[0] := ((Color and $001F) shl 3) and $F8;
        pDest[0] := pDest[0] or ((pDest[0] shr 3) and 7);
        pDest[1] := ((Color and $07E0) shr 3) and $FC;
        pDest[1] := pDest[1] or ((pDest[1] shr 2) and 3);
        pDest[2] := ((Color and $F800) shr 8) and $F8;
        pDest[2] := pDest[2] or ((pDest[2] shr 3) and 7);
        pDest[3] := 255;
      end
      else
      begin
        // alpha 像素导出处
        // 貌似wascompress是先合并再导出，而不是直接导出，所以发黑
{        pDest[0] := (((Color and $001F) shl 3) * Alpha div 32) and $F8;
        pDest[0] := pDest[0] or ((pDest[0] shr 3) and 7);
        pDest[1] := (((Color and $07E0) shr 3) * Alpha div 32) and $FC;
        pDest[1] := pDest[1] or ((pDest[1] shr 2) and 3);
        pDest[2] := (((Color and $F800) shr 8) * Alpha div 32) and $F8;
        pDest[2] := pDest[2] or ((pDest[2] shr 3) and 7);}

        // 正常的TGA导出
        pDest[0] := ((Color and $001F) shl 3) and $F8;
        pDest[0] := pDest[0] or ((pDest[0] shr 3) and 7);
        pDest[1] := ((Color and $07E0) shr 3) and $FC;
        pDest[1] := pDest[1] or ((pDest[1] shr 2) and 3);
        pDest[2] := ((Color and $F800) shr 8) and $F8;
        pDest[2] := pDest[2] or ((pDest[2] shr 3) and 7);
        pDest[3]:=Alpha*8;
      end;
      Inc(LongWord(pDest), 4);
    end;
  end;
end;


end.

奔放的牛

unit was;  interface  uses   SysUtils, Classes, Graphics, Dialogs, StrUtils;  type   TWasPixel = record     Alpha: Byte;     Index: Byte;   end;    TWasImageInfo = record     Key_X: Integer;     Key_Y: Integer;     Width: Integer;     Height: Integer;   end;    TWasImage = record     Info: TWasImageInfo;     Data: array of TWasPixel;   end;    TWasFileInfo = record     wfType: Word;     whSize: Word;     SpriteCount: Word;     FrameCount: Word;     MaxWidth: Word;     MaxHeight: Word;     Key_X: Word;     Key_Y: Word;   end;    HighPal = array [0..255] of Word;      TWasFile = class   private     // 图片信息     Info: TWasFileInfo;     Data: array of TWasImage;     HeadData: array of Byte;  // 存储多余的文件头     HeadDataSize: Integer;      // 2个调色板     OriginalPal: array [0..255] of Word;     CurrentPal: array [0..255] of Word;      // 原始文件     FName: string;     FSize: Cardinal;     FData: array of Byte;     fInitialized: Boolean;      // xxxxxxxxxxxxxxxxxx     procedure DecodeFromStream(var Dest: TWasImage; Stream: TStream);     procedure Init();     procedure Burn();   public     constructor Create();     destructor Destroy(); override;     // 相关方法     procedure LoadFromFile(const FileName: string);     procedure SaveToFile(const FileName: string);     procedure Draw(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);     procedure DrawByKey(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);     function GetSpriteCount(): Integer;     function GetFrameCount(): Integer;     function GetWidth(): Integer;     function GetHeight(): Integer;     function GetFileName(): String;     function GetIsInit(): Boolean;     procedure GetCurrentPal(var aHighPal: HighPal);     procedure GetOriginalPal(var aHighPal: HighPal);     procedure SetCurrentPal(aHighPal: HighPal);     procedure ResetCurrentPal();     procedure SaveToTGA();     procedure DrawToTGA(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);     procedure Close;   end;  function PosLast(substr1,str1: widestring):Integer;  implementation  procedure TWasFile.Close; begin   Burn;   Init; end;  procedure TWasFile.Init(); begin   Info.wfType := 0;   Info.whSize := 0;   Info.SpriteCount := 0;   Info.FrameCount := 0;   Info.MaxWidth := 0;   Info.MaxHeight := 0;   Info.Key_X := 0;   Info.Key_Y := 0;    Self.FName := '';   Self.FSize := 0;    Self.HeadDataSize := 0; end;  procedure TWasFile.Burn(); var   i: Integer; begin   for i:=Low(Data) to High(Data) do   begin     Data[i].Data := nil;   end;   Data := nil;   FData := nil;    HeadData := nil;      fInitialized := false; end;  constructor TWasFile.Create(); begin   Init;   fInitialized := false; end;  destructor TWasFile.Destroy(); begin   Burn; end;  procedure TWasFile.DecodeFromStream(var Dest: TWasImage; Stream: TStream); var   StartPos: Int64;  // 文件在 Stream 中的 Offset   LineOffset: array of Cardinal;   x,y: Integer;   tmp, tmp2: Byte;   alpha: Byte;   i: Integer;   Width, Height: Integer; begin   StartPos := Stream.Position;   Stream.Read(Dest.Info, SizeOf(Dest.Info));    Width := Dest.Info.Width;   Height := Dest.Info.Height;    LineOffset := nil;   SetLength(LineOffset, Height);   Dest.Data := nil;   SetLength(Dest.Data, Width * Height);    for i:=Low(Dest.Data) to High(Dest.Data) do   begin     // 初始化Data，因为后面有跳过某些字节的操作     Dest.Data[i].Alpha := $0;     Dest.Data[i].Index := $0;   end;    Stream.Read(LineOffset[0], 4 * Height);    for y:=0 to Height-1 do   begin     x := 0;     Stream.Seek(StartPos + LineOffset[y], soFromBeginning);     while (x < Width) do     begin       Stream.Read(tmp, 1);       case (tmp and $C0) of         $00:  // 00 - 透明色         begin           if (tmp and $20)>0 then           begin             tmp2 := tmp and $1F;  // alpha             Stream.Read(tmp, 1);             Dest.Data[y*Width+x].Index := tmp;             Dest.Data[y*Width+x].Alpha := tmp2;             Inc(x);           end           else if tmp<>0 then           begin             // 重复alpha像素的分支             tmp2 := tmp and $1F;  // 次数             Stream.Read(alpha, 1);             alpha := alpha and $1F;             Stream.Read(tmp, 1);             for i:=1 to tmp2 do             begin               Dest.Data[y*Width+x].Alpha := alpha;               Dest.Data[y*Width+x].Index := tmp;               Inc(x);             end;           end           else           begin             // tmp 是$0表示数据段结束             if x>Width then               raise Exception.Create('第'+IntToStr(y)+'行遇到错误数据啦！');             x := Width;           end;         end;         $40:  // 01 - 像素组         begin           tmp2 := tmp and $3F;           for i:=1 to tmp2 do           begin             Stream.Read(tmp, 1);             Dest.Data[y*Width+x].Alpha := 32;//$1F;             Dest.Data[y*Width+x].Index := tmp;             inc(x);           end;         end;         $80:  // 10 - 重复n次         begin           tmp2 := tmp and $3F;           Stream.Read(tmp, 1);           for i:=1 to tmp2 do           begin             Dest.Data[y*Width+x].Alpha := 32;//$1F;             Dest.Data[y*Width+x].Index := tmp;             inc(x);           end;         end;         $C0:  // 11 - 跳过n字节         begin           tmp2 := tmp and $3F;           x := x + tmp2;         end;       end;  // end of case        if x>Width then         raise Exception.Create('第'+IntToStr(y)+'行遇到错误数据啦！');     end;  // end of while   end;   LineOffset := nil; end;  procedure TWasFile.LoadFromFile(const FileName: string); var   Stream: TStream;   FileOffset: array of Cardinal;   i: Integer; begin   Stream := TMemoryStream.Create;   try     TMemoryStream(Stream).LoadFromFile(FileName);     Burn;     Init;     Stream.Read(Info, SizeOf(Info));     if Info.wfType <> $5053 then       raise Exception.Create('错误的文件标识！');     if Info.whSize < $0C then       raise Exception.Create('错误的文件版本，请与作者联系！')     else if Info.whSize > $0C then     begin       // 当文件头大小大于$0C的时候       HeadDataSize := Info.whSize - $0C;       SetLength(HeadData, HeadDataSize);       Stream.Read(HeadData[0], HeadDataSize);     end;     if (Info.SpriteCount < 1) or (Info.FrameCount < 1) then       raise Exception.Create('错误的精灵数或帧数！');     // 开始加载图片     i := Info.SpriteCount * Info.FrameCount;     SetLength(Data, i);     SetLength(FileOffset, i);     Stream.Read(OriginalPal[0], 512); // 高彩调色板     Stream.Read(FileOffset[0], 4*i);  // 子文件偏移量      for i:=Low(FileOffset) to High(FileOffset) do     begin       if FileOffset[i]=0 then       begin         // 想不出更合适的办法了         with Data[i] do         begin           Info.Width := 1;           Info.Height := 1;           Info.Key_X := 0;           Info.Key_Y := 0;           SetLength(Data, 1);           Data[0].Alpha := $0;           Data[0].Index := $0;         end;       end       else       begin         Stream.Seek(FileOffset[i]+Info.whSize+4, soFromBeginning);         DecodeFromStream(Data[i], Stream);       end;     end;      FName := FileName;     FSize := Stream.Size - $204 - Info.whSize;     FData := nil;     SetLength(FData, FSize);     Stream.Seek($4+Info.whSize, soFromBeginning);     Stream.Read(CurrentPal[0], $200);     Stream.Read(FData[0], FSize);     fInitialized := true;   finally     Stream.Free;   end; end;  procedure TWasFile.DrawByKey(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer); var   New_X: Integer;   New_Y: Integer;   New_Width: Integer;   New_Height: Integer;   New_Left: Integer;   New_Top: Integer;    i,j: Integer;   pDest: PByteArray;   Color: Word;   Alpha: Byte; begin   if not fInitialized then     raise Exception.Create('没加载图片，画什么啊！');   if (Index<0) or (Index>(Info.SpriteCount * Info.FrameCount)) then     raise Exception.Create('没有第'+IntToStr(Index)+'张图片，没法画！');    // 裁减   New_X := X - Data[Index].Info.Key_X;   New_Y := Y - Data[Index].Info.Key_Y;   New_Width := Data[Index].Info.Width;   New_Height := Data[Index].Info.Height;   New_Left := 0;   New_Top := 0;    if (New_X > Dest.Width) or (New_Y > Dest.Height) then     exit;   if (New_X + New_Width) > Dest.Width then     New_Width := Dest.Width - New_X;   if (New_Y + New_Height) > Dest.Height then     New_Height := Dest.Height - New_Y;    if New_X < 0 then   begin     New_Left := -New_X;     New_X := 0;   end;   if New_Y < 0 then   begin     New_Top := -New_Y;     New_Y := 0   end;    for i:=New_Top to New_Height-1 do   begin     pDest := Dest.ScanLine[New_Y+i-New_Top];     Inc(LongWord(pDest), 3*New_X);     for j:=New_Left to New_Width-1 do     begin       Color := CurrentPal[Data[Index].Data[i*Data[Index].Info.Width+j].Index];       Alpha := Data[Index].Data[i*Data[Index].Info.Width+j].Alpha;       pDest[0] := (((Color and $001F) shl 3) - pDest[0]) * Alpha div 32 + pDest[0];       pDest[1] := (((Color and $07E0) shr 3) - pDest[1]) * Alpha div 32 + pDest[1];       pDest[2] := (((Color and $F800) shr 8) - pDest[2]) * Alpha div 32 + pDest[2];       Inc(LongWord(pDest), 3);     end;   end; end;  procedure TWasFile.Draw(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer); begin   DrawByKey(Dest, X+Data[Index].Info.Key_X, Y+Data[Index].Info.Key_Y, Index); end;  procedure TWasFile.SaveToFile(const FileName: string); var   Stream: TStream; begin   Stream := TFileStream.Create(FileName, fmCreate);   try     Stream.Write(Info, SizeOf(Info));     Stream.Write(HeadData[0], HeadDataSize);     Stream.Write(CurrentPal[0], $200);     Stream.Write(FData[0], FSize);   finally     Stream.Free;   end; end;  function TWasFile.GetSpriteCount(): Integer; begin   Result := Info.SpriteCount; end;  function TWasFile.GetFrameCount(): Integer; begin   Result := Info.FrameCount; end;  function TWasFile.GetWidth(): Integer; begin   Result := Info.MaxWidth; end;  function TWasFile.GetHeight(): Integer; begin   Result := Info.MaxHeight; end;  function TWasFile.GetFileName(): String; begin   Result := FName; end;  function TWasFile.GetIsInit(): Boolean; begin   Result := fInitialized; end;  procedure TWasFile.GetCurrentPal(var aHighPal: HighPal); var   i: Integer; begin   for i:=0 to 255 do   begin     aHighPal[i] := CurrentPal[i];   end; end;  procedure TWasFile.GetOriginalPal(var aHighPal: HighPal); var   i: Integer; begin   for i:=0 to 255 do   begin     aHighPal[i] := OriginalPal[i];   end; end;  procedure TWasFile.SetCurrentPal(aHighPal: HighPal); var   i: Integer; begin   for i:=0 to 255 do   begin     CurrentPal[i] := aHighPal[i];   end; end;  procedure TWasFile.ResetCurrentPal(); var   i: Integer; begin   for i:=0 to 255 do   begin     CurrentPal[i] := OriginalPal[i];   end; end;  procedure TWasFile.SaveToTGA(); var   fs1: TStream;   i,l,x,y: Integer;   path: widestring;   FileName: widestring;   tmp: Byte;   bufbmp: TBitmap;   pDest: PByteArray; begin   FileName := FName;   i := PosLast('.', FileName);   path := LeftStr(FileName, i-1);    bufbmp := TBitmap.Create;   bufbmp.PixelFormat := pf32bit;   bufbmp.Width := Info.MaxWidth;   bufbmp.Height := Info.MaxHeight;    for i:=Low(Data) to High(Data) do   begin     FileName := path + Format('%x%.3d.tga',[(i div Info.FrameCount),(i mod Info.FrameCount)]);     fs1 := TFileStream.Create(FileName, fmCreate);     l := $00020000;     fs1.Write(l, 4);     l := $0;     fs1.Write(l, 4);     fs1.Write(l, 4);     fs1.Write(Info.MaxWidth, 2);     fs1.Write(Info.MaxHeight, 2);     tmp := $20;     fs1.Write(tmp, 1);     tmp := $08; // 原点在左下用$08,原点在左上用$28;     fs1.Write(tmp, 1);      // 清空bufbmp     for y:=0 to bufbmp.Height-1 do     begin       pDest := bufbmp.ScanLine[y];       for x:=0 to bufbmp.Width-1 do       begin         pDest[0]:=0;         pDest[1]:=0;         pDest[2]:=0;         pDest[3]:=0;         Inc(LongWord(pDest), 4);       end;     end;      DrawToTGA(bufbmp, Info.Key_X, Info.Key_Y, i);      for y:=bufbmp.Height-1 downto 0 do     begin       pDest := bufbmp.ScanLine[y];       fs1.Write(pDest[0], 4*bufbmp.Width);     end;          fs1.Free;   end;   bufbmp := nil; end;  function PosLast(substr1,str1: widestring):Integer; var   str2: widestring;   i,l: Integer;   sum: Integer; begin   sum := 0;   str2 := str1; //  i := Pos('\',str1);   i := Pos(substr1, str2);   while i<>0 do   begin     l := Length(str2);     sum := sum + i;     str2 := RightStr(str2, l-i);     i := Pos(substr1, str2);   end;   Result := sum; end;  // 仅为TGA服务 procedure TWasFile.DrawToTGA(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer); var   New_X: Integer;   New_Y: Integer;   New_Width: Integer;   New_Height: Integer;   New_Left: Integer;   New_Top: Integer;    i,j: Integer;   pDest: PByteArray;   Color: Word;   Alpha: Byte; begin   if not fInitialized then     raise Exception.Create('没加载图片，画什么啊！');   if (Index<0) or (Index>(Info.SpriteCount * Info.FrameCount)) then     raise Exception.Create('没有第'+IntToStr(Index)+'张图片，没法画！');    // 裁减   New_X := X - Data[Index].Info.Key_X;   New_Y := Y - Data[Index].Info.Key_Y;   New_Width := Data[Index].Info.Width;   New_Height := Data[Index].Info.Height;   New_Left := 0;   New_Top := 0;    if (New_X > Dest.Width) or (New_Y > Dest.Height) then     exit;   if (New_X + New_Width) > Dest.Width then     New_Width := Dest.Width - New_X;   if (New_Y + New_Height) > Dest.Height then     New_Height := Dest.Height - New_Y;    if New_X < 0 then   begin     New_Left := -New_X;     New_X := 0;   end;   if New_Y < 0 then   begin     New_Top := -New_Y;     New_Y := 0   end;    for i:=New_Top to New_Height-1 do   begin     pDest := Dest.ScanLine[New_Y+i-New_Top];     Inc(LongWord(pDest), 4*New_X);     for j:=New_Left to New_Width-1 do     begin       Color := CurrentPal[Data[Index].Data[i*Data[Index].Info.Width+j].Index];       Alpha := Data[Index].Data[i*Data[Index].Info.Width+j].Alpha;       if Alpha=0 then       begin         // 0号调色板不一定是黑色，为了photoshop里显示的效果         // 强制写入黑色         pDest[0] := 0;         pDest[1] := 0;         pDest[2] := 0;         pDest[3] := 0;       end       else if Alpha=32 then       begin         pDest[0] := ((Color and $001F) shl 3) and $F8;         pDest[0] := pDest[0] or ((pDest[0] shr 3) and 7);         pDest[1] := ((Color and $07E0) shr 3) and $FC;         pDest[1] := pDest[1] or ((pDest[1] shr 2) and 3);         pDest[2] := ((Color and $F800) shr 8) and $F8;         pDest[2] := pDest[2] or ((pDest[2] shr 3) and 7);         pDest[3] := 255;       end       else       begin         // alpha 像素导出处         // 貌似wascompress是先合并再导出，而不是直接导出，所以发黑 {        pDest[0] := (((Color and $001F) shl 3) * Alpha div 32) and $F8;         pDest[0] := pDest[0] or ((pDest[0] shr 3) and 7);         pDest[1] := (((Color and $07E0) shr 3) * Alpha div 32) and $FC;         pDest[1] := pDest[1] or ((pDest[1] shr 2) and 3);         pDest[2] := (((Color and $F800) shr 8) * Alpha div 32) and $F8;         pDest[2] := pDest[2] or ((pDest[2] shr 3) and 7);}          // 正常的TGA导出         pDest[0] := ((Color and $001F) shl 3) and $F8;         pDest[0] := pDest[0] or ((pDest[0] shr 3) and 7);         pDest[1] := ((Color and $07E0) shr 3) and $FC;         pDest[1] := pDest[1] or ((pDest[1] shr 2) and 3);         pDest[2] := ((Color and $F800) shr 8) and $F8;         pDest[2] := pDest[2] or ((pDest[2] shr 3) and 7);         pDest[3]:=Alpha*8;       end;       Inc(LongWord(pDest), 4);     end;   end; end;   end.

奔放的牛

落单的拖鞋 发表于 2025-5-13 14:04
发来看看

  

unit was;
interface
uses
SysUtils, Classes, Graphics, Dialogs, StrUtils;
type
TWasPixel = record
Alpha: Byte;
Index: Byte;
end;
TWasImageInfo = record
Key_X: Integer;
Key_Y: Integer;
Width: Integer;
Height: Integer;
end;
TWasImage = record
Info: TWasImageInfo;
Data: array of TWasPixel;
end;
TWasFileInfo = record
wfType: Word;
whSize: Word;
SpriteCount: Word;
FrameCount: Word;
MaxWidth: Word;
MaxHeight: Word;
Key_X: Word;
Key_Y: Word;
end;
HighPal = array [0..255] of Word;

TWasFile = class
private
// 图片信息
Info: TWasFileInfo;
Data: array of TWasImage;
HeadData: array of Byte;  // 存储多余的文件头
HeadDataSize: Integer;
// 2个调色板
OriginalPal: array [0..255] of Word;
CurrentPal: array [0..255] of Word;
// 原始文件
FName: string;
FSize: Cardinal;
FData: array of Byte;
fInitialized: Boolean;
// xxxxxxxxxxxxxxxxxx
procedure DecodeFromStream (var Dest: TWasImage; Stream: TStream);
procedure Init ();
procedure Burn ();
public
constructor Create ();
destructor Destroy (); override;
// 相关方法
procedure LoadFromFile (const FileName: string);
procedure SaveToFile (const FileName: string);
procedure Draw (Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);
procedure DrawByKey (Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);
function GetSpriteCount (): Integer;
function GetFrameCount (): Integer;
function GetWidth (): Integer;
function GetHeight (): Integer;
function GetFileName (): String;
function GetIsInit (): Boolean;
procedure GetCurrentPal (var aHighPal: HighPal);
procedure GetOriginalPal (var aHighPal: HighPal);
procedure SetCurrentPal (aHighPal: HighPal);
procedure ResetCurrentPal ();
procedure SaveToTGA ();
procedure DrawToTGA (Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);
procedure Close;
end;
function PosLast (substr1,str1: widestring):Integer;
implementation
procedure TWasFile.Close;
begin
Burn;
Init;
end;
procedure TWasFile.Init ();
begin
Info.wfType := 0;
Info.whSize := 0;
Info.SpriteCount := 0;
Info.FrameCount := 0;
Info.MaxWidth := 0;
Info.MaxHeight := 0;
Info.Key_X := 0;
Info.Key_Y := 0;
Self.FName := ' ';
Self.FSize := 0;
Self.HeadDataSize := 0;
end;
procedure TWasFile.Burn ();
var
i: Integer;
begin
for i:=Low (Data) to High (Data) do
begin
Data[i].Data := nil;
end;
Data := nil;
FData := nil;
HeadData := nil;

fInitialized := false;
end;
constructor TWasFile.Create ();
begin
Init;
fInitialized := false;
end;
destructor TWasFile.Destroy ();
begin
Burn;
end;
procedure TWasFile.DecodeFromStream (var Dest: TWasImage; Stream: TStream);
var
StartPos: Int64;  // 文件在 Stream 中的 Offset
LineOffset: array of Cardinal;
x,y: Integer;
tmp, tmp2: Byte;
alpha: Byte;
i: Integer;
Width, Height: Integer;
begin
StartPos := Stream.Position;
Stream.Read (Dest.Info, SizeOf (Dest.Info));
Width := Dest.Info.Width;
Height := Dest.Info.Height;
LineOffset := nil;
SetLength (LineOffset, Height);
Dest.Data := nil;
SetLength (Dest.Data, Width * Height);
for i:=Low (Dest.Data) to High (Dest.Data) do
begin
// 初始化Data，因为后面有跳过某些字节的操作
Dest.Data[i].Alpha := $0;
Dest.Data[i].Index := $0;
end;
Stream.Read (LineOffset[0], 4 * Height);
for y:=0 to Height-1 do
begin
x := 0;
Stream.Seek (StartPos + LineOffset[y], soFromBeginning);
while (x < Width) do
begin
Stream.Read (tmp, 1);
case (tmp and $C0) of
$00:  // 00 - 透明色
begin
if (tmp and $20)>0 then
begin
tmp2 := tmp and $1F;  // alpha
Stream.Read (tmp, 1);
Dest.Data[y*Width+x].Index := tmp;
Dest.Data[y*Width+x].Alpha := tmp2;
Inc (x);
end
else if tmp<>0 then
begin
// 重复alpha像素的分支
tmp2 := tmp and $1F;  // 次数
Stream.Read (alpha, 1);
alpha := alpha and $1F;
Stream.Read (tmp, 1);
for i:=1 to tmp2 do
begin
Dest.Data[y*Width+x].Alpha := alpha;
Dest.Data[y*Width+x].Index := tmp;
Inc (x);
end;
end
else
begin
// tmp 是$0表示数据段结束
if x>Width then
raise Exception.Create ( ' 第'+IntToStr(y)+'行遇到错误数据啦！');
x := Width;
end;
end;
$40:  // 01 - 像素组
begin
tmp2 := tmp and $3F;
for i:=1 to tmp2 do
begin
Stream.Read (tmp, 1);
Dest.Data[y*Width+x].Alpha := 32;//$1F;
Dest.Data[y*Width+x].Index := tmp;
inc (x);
end;
end;
$80:  // 10 - 重复n次
begin
tmp2 := tmp and $3F;
Stream.Read (tmp, 1);
for i:=1 to tmp2 do
begin
Dest.Data[y*Width+x].Alpha := 32;//$1F;
Dest.Data[y*Width+x].Index := tmp;
inc (x);
end;
end;
$C0:  // 11 - 跳过n字节
begin
tmp2 := tmp and $3F;
x := x + tmp2;
end;
end;  // end of case
if x>Width then
raise Exception.Create ( ' 第'+IntToStr(y)+'行遇到错误数据啦！');
end;  // end of while
end;
LineOffset := nil;
end;
procedure TWasFile.LoadFromFile (const FileName: string);
var
Stream: TStream;
FileOffset: array of Cardinal;
i: Integer;
begin
Stream := TMemoryStream.Create;
try
TMemoryStream (Stream).LoadFromFile (FileName);
Burn;
Init;
Stream.Read (Info, SizeOf (Info));
if Info.wfType <> $5053 then
raise Exception.Create ( ' 错误的文件标识！');
if Info.whSize < $0C then
raise Exception.Create ( ' 错误的文件版本，请与作者联系！')
else if Info.whSize > $0C then
begin
// 当文件头大小大于$0C的时候
HeadDataSize := Info.whSize - $0C;
SetLength (HeadData, HeadDataSize);
Stream.Read (HeadData[0], HeadDataSize);
end;
if (Info.SpriteCount < 1) or (Info.FrameCount < 1) then
raise Exception.Create ( ' 错误的精灵数或帧数！');
// 开始加载图片
i := Info.SpriteCount * Info.FrameCount;
SetLength (Data, i);
SetLength (FileOffset, i);
Stream.Read (OriginalPal[0], 512); // 高彩调色板
Stream.Read (FileOffset[0], 4*i);  // 子文件偏移量
for i:=Low (FileOffset) to High (FileOffset) do
begin
if FileOffset[i]=0 then
begin
// 想不出更合适的办法了
with Data[i] do
begin
Info.Width := 1;
Info.Height := 1;
Info.Key_X := 0;
Info.Key_Y := 0;
SetLength (Data, 1);
Data[0].Alpha := $0;
Data[0].Index := $0;
end;
end
else
begin
Stream.Seek (FileOffset[i]+Info.whSize+4, soFromBeginning);
DecodeFromStream (Data[i], Stream);
end;
end;
FName := FileName;
FSize := Stream.Size - $204 - Info.whSize;
FData := nil;
SetLength (FData, FSize);
Stream.Seek ($4+Info.whSize, soFromBeginning);
Stream.Read (CurrentPal[0], $200);
Stream.Read (FData[0], FSize);
fInitialized := true;
finally
Stream.Free;
end;
end;
procedure TWasFile.DrawByKey (Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);
var
New_X: Integer;
New_Y: Integer;
New_Width: Integer;
New_Height: Integer;
New_Left: Integer;
New_Top: Integer;
i,j: Integer;
pDest: PByteArray;
Color: Word;
Alpha: Byte;
begin
if not fInitialized then
raise Exception.Create ( ' 没加载图片，画什么啊！');
if (Index<0) or (Index> (Info.SpriteCount * Info.FrameCount)) then
raise Exception.Create ( ' 没有第'+IntToStr(Index)+'张图片，没法画！');
// 裁减
New_X := X - Data[Index].Info.Key_X;
New_Y := Y - Data[Index].Info.Key_Y;
New_Width := Data[Index].Info.Width;
New_Height := Data[Index].Info.Height;
New_Left := 0;
New_Top := 0;
if (New_X > Dest.Width) or (New_Y > Dest.Height) then
exit;
if (New_X + New_Width) > Dest.Width then
New_Width := Dest.Width - New_X;
if (New_Y + New_Height) > Dest.Height then
New_Height := Dest.Height - New_Y;
if New_X < 0 then
begin
New_Left := -New_X;
New_X := 0;
end;
if New_Y < 0 then
begin
New_Top := -New_Y;
New_Y := 0
end;
for i:=New_Top to New_Height-1 do
begin
pDest := Dest.ScanLine[New_Y+i-New_Top];
Inc (LongWord (pDest), 3*New_X);
for j:=New_Left to New_Width-1 do
begin
Color := CurrentPal[Data[Index].Data[i*Data[Index].Info.Width+j].Index];
Alpha := Data[Index].Data[i*Data[Index].Info.Width+j].Alpha;
pDest[0] := ( ( (Color and $001F) shl 3) - pDest[0]) * Alpha div 32 + pDest[0];
pDest[1] := ( ( (Color and $07E0) shr 3) - pDest[1]) * Alpha div 32 + pDest[1];
pDest[2] := ( ( (Color and $F800) shr 8) - pDest[2]) * Alpha div 32 + pDest[2];
Inc (LongWord (pDest), 3);
end;
end;
end;
procedure TWasFile.Draw (Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);
begin
DrawByKey (Dest, X+Data[Index].Info.Key_X, Y+Data[Index].Info.Key_Y, Index);
end;
procedure TWasFile.SaveToFile (const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create (FileName, fmCreate);
try
Stream.Write (Info, SizeOf (Info));
Stream.Write (HeadData[0], HeadDataSize);
Stream.Write (CurrentPal[0], $200);
Stream.Write (FData[0], FSize);
finally
Stream.Free;
end;
end;
function TWasFile.GetSpriteCount (): Integer;
begin
Result := Info.SpriteCount;
end;
function TWasFile.GetFrameCount (): Integer;
begin
Result := Info.FrameCount;
end;
function TWasFile.GetWidth (): Integer;
begin
Result := Info.MaxWidth;
end;
function TWasFile.GetHeight (): Integer;
begin
Result := Info.MaxHeight;
end;
function TWasFile.GetFileName (): String;
begin
Result := FName;
end;
function TWasFile.GetIsInit (): Boolean;
begin
Result := fInitialized;
end;
procedure TWasFile.GetCurrentPal (var aHighPal: HighPal);
var
i: Integer;
begin
for i:=0 to 255 do
begin
aHighPal[i] := CurrentPal[i];
end;
end;
procedure TWasFile.GetOriginalPal (var aHighPal: HighPal);
var
i: Integer;
begin
for i:=0 to 255 do
begin
aHighPal[i] := OriginalPal[i];
end;
end;
procedure TWasFile.SetCurrentPal (aHighPal: HighPal);
var
i: Integer;
begin
for i:=0 to 255 do
begin
CurrentPal[i] := aHighPal[i];
end;
end;
procedure TWasFile.ResetCurrentPal ();
var
i: Integer;
begin
for i:=0 to 255 do
begin
CurrentPal[i] := OriginalPal[i];
end;
end;
procedure TWasFile.SaveToTGA ();
var
fs1: TStream;
i,l,x,y: Integer;
path: widestring;
FileName: widestring;
tmp: Byte;
bufbmp: TBitmap;
pDest: PByteArray;
begin
FileName := FName;
i := PosLast ( ' .', FileName);
path := LeftStr (FileName, i-1);
bufbmp := TBitmap.Create;
bufbmp.PixelFormat := pf32bit;
bufbmp.Width := Info.MaxWidth;
bufbmp.Height := Info.MaxHeight;
for i:=Low (Data) to High (Data) do
begin
FileName := path + Format ( ' %x%.3d.tga',[(i div Info.FrameCount),(i mod Info.FrameCount)]);
fs1 := TFileStream.Create (FileName, fmCreate);
l := $00020000;
fs1.Write (l, 4);
l := $0;
fs1.Write (l, 4);
fs1.Write (l, 4);
fs1.Write (Info.MaxWidth, 2);
fs1.Write (Info.MaxHeight, 2);
tmp := $20;
fs1.Write (tmp, 1);
tmp := $08; // 原点在左下用$08,原点在左上用$28;
fs1.Write (tmp, 1);
// 清空bufbmp
for y:=0 to bufbmp.Height-1 do
begin
pDest := bufbmp.ScanLine[y];
for x:=0 to bufbmp.Width-1 do
begin
pDest[0]:=0;
pDest[1]:=0;
pDest[2]:=0;
pDest[3]:=0;
Inc (LongWord (pDest), 4);
end;
end;
DrawToTGA (bufbmp, Info.Key_X, Info.Key_Y, i);
for y:=bufbmp.Height-1 downto 0 do
begin
pDest := bufbmp.ScanLine[y];
fs1.Write (pDest[0], 4*bufbmp.Width);
end;

fs1.Free;
end;
bufbmp := nil;
end;
function PosLast (substr1,str1: widestring):Integer;
var
str2: widestring;
i,l: Integer;
sum: Integer;
begin
sum := 0;
str2 := str1;
//  i := Pos ( ' \',str1);
i := Pos (substr1, str2);
while i<>0 do
begin
l := Length (str2);
sum := sum + i;
str2 := RightStr (str2, l-i);
i := Pos (substr1, str2);
end;
Result := sum;
end;
// 仅为TGA服务
procedure TWasFile.DrawToTGA (Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);
var
New_X: Integer;
New_Y: Integer;
New_Width: Integer;
New_Height: Integer;
New_Left: Integer;
New_Top: Integer;
i,j: Integer;
pDest: PByteArray;
Color: Word;
Alpha: Byte;
begin
if not fInitialized then
raise Exception.Create ( ' 没加载图片，画什么啊！');
if (Index<0) or (Index> (Info.SpriteCount * Info.FrameCount)) then
raise Exception.Create ( ' 没有第'+IntToStr(Index)+'张图片，没法画！');
// 裁减
New_X := X - Data[Index].Info.Key_X;
New_Y := Y - Data[Index].Info.Key_Y;
New_Width := Data[Index].Info.Width;
New_Height := Data[Index].Info.Height;
New_Left := 0;
New_Top := 0;
if (New_X > Dest.Width) or (New_Y > Dest.Height) then
exit;
if (New_X + New_Width) > Dest.Width then
New_Width := Dest.Width - New_X;
if (New_Y + New_Height) > Dest.Height then
New_Height := Dest.Height - New_Y;
if New_X < 0 then
begin
New_Left := -New_X;
New_X := 0;
end;
if New_Y < 0 then
begin
New_Top := -New_Y;
New_Y := 0
end;
for i:=New_Top to New_Height-1 do
begin
pDest := Dest.ScanLine[New_Y+i-New_Top];
Inc (LongWord (pDest), 4*New_X);
for j:=New_Left to New_Width-1 do
begin
Color := CurrentPal[Data[Index].Data[i*Data[Index].Info.Width+j].Index];
Alpha := Data[Index].Data[i*Data[Index].Info.Width+j].Alpha;
if Alpha=0 then
begin
// 0号调色板不一定是黑色，为了photoshop里显示的效果
// 强制写入黑色
pDest[0] := 0;
pDest[1] := 0;
pDest[2] := 0;
pDest[3] := 0;
end
else if Alpha=32 then
begin
pDest[0] := ( (Color and $001F) shl 3) and $F8;
pDest[0] := pDest[0] or ( (pDest[0] shr 3) and 7);
pDest[1] := ( (Color and $07E0) shr 3) and $FC;
pDest[1] := pDest[1] or ( (pDest[1] shr 2) and 3);
pDest[2] := ( (Color and $F800) shr 8) and $F8;
pDest[2] := pDest[2] or ( (pDest[2] shr 3) and 7);
pDest[3] := 255;
end
else
begin
// alpha 像素导出处
// 貌似wascompress是先合并再导出，而不是直接导出，所以发黑
{        pDest[0] := ( ( (Color and $001F) shl 3) * Alpha div 32) and $F8;
pDest[0] := pDest[0] or ( (pDest[0] shr 3) and 7);
pDest[1] := ( ( (Color and $07E0) shr 3) * Alpha div 32) and $FC;
pDest[1] := pDest[1] or ( (pDest[1] shr 2) and 3);
pDest[2] := ( ( (Color and $F800) shr 8) * Alpha div 32) and $F8;
pDest[2] := pDest[2] or ( (pDest[2] shr 3) and 7);}
// 正常的TGA导出
pDest[0] := ( (Color and $001F) shl 3) and $F8;
pDest[0] := pDest[0] or ( (pDest[0] shr 3) and 7);
pDest[1] := ( (Color and $07E0) shr 3) and $FC;
pDest[1] := pDest[1] or ( (pDest[1] shr 2) and 3);
pDest[2] := ( (Color and $F800) shr 8) and $F8;
pDest[2] := pDest[2] or ( (pDest[2] shr 3) and 7);
pDest[3]:=Alpha*8;
end;
Inc (LongWord (pDest), 4);
end;
end;
end;
end.

unit was;<br /> <br /> interface<br /> <br /> uses<br />   SysUtils, Classes, Graphics, Dialogs, StrUtils;<br /> <br /> type<br />   TWasPixel = record<br />     Alpha: Byte;<br />     Index: Byte;<br />   end;<br /> <br />   TWasImageInfo = record<br />     Key_X: Integer;<br />     Key_Y: Integer;<br />     Width: Integer;<br />     Height: Integer;<br />   end;<br /> <br />   TWasImage = record<br />     Info: TWasImageInfo;<br />     Data: array of TWasPixel;<br />   end;<br /> <br />   TWasFileInfo = record<br />     wfType: Word;<br />     whSize: Word;<br />     SpriteCount: Word;<br />     FrameCount: Word;<br />     MaxWidth: Word;<br />     MaxHeight: Word;<br />     Key_X: Word;<br />     Key_Y: Word;<br />   end;<br /> <br />   HighPal = array [0..255] of Word;<br />   <br />   TWasFile = class<br />   private<br />     // 图片信息<br />     Info: TWasFileInfo;<br />     Data: array of TWasImage;<br />     HeadData: array of Byte;  // 存储多余的文件头<br />     HeadDataSize: Integer;<br /> <br />     // 2个调色板<br />     OriginalPal: array [0..255] of Word;<br />     CurrentPal: array [0..255] of Word;<br /> <br />     // 原始文件<br />     FName: string;<br />     FSize: Cardinal;<br />     FData: array of Byte;<br />     fInitialized: Boolean;<br /> <br />     // xxxxxxxxxxxxxxxxxx<br />     procedure DecodeFromStream(var Dest: TWasImage; Stream: TStream);<br />     procedure Init();<br />     procedure Burn();<br />   public<br />     constructor Create();<br />     destructor Destroy(); override;<br />     // 相关方法<br />     procedure LoadFromFile(const FileName: string);<br />     procedure SaveToFile(const FileName: string);<br />     procedure Draw(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);<br />     procedure DrawByKey(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);<br />     function GetSpriteCount(): Integer;<br />     function GetFrameCount(): Integer;<br />     function GetWidth(): Integer;<br />     function GetHeight(): Integer;<br />     function GetFileName(): String;<br />     function GetIsInit(): Boolean;<br />     procedure GetCurrentPal(var aHighPal: HighPal);<br />     procedure GetOriginalPal(var aHighPal: HighPal);<br />     procedure SetCurrentPal(aHighPal: HighPal);<br />     procedure ResetCurrentPal();<br />     procedure SaveToTGA();<br />     procedure DrawToTGA(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);<br />     procedure Close;<br />   end;<br /> <br /> function PosLast(substr1,str1: widestring):Integer;<br /> <br /> implementation<br /> <br /> procedure TWasFile.Close;<br /> begin<br />   Burn;<br />   Init;<br /> end;<br /> <br /> procedure TWasFile.Init();<br /> begin<br />   Info.wfType := 0;<br />   Info.whSize := 0;<br />   Info.SpriteCount := 0;<br />   Info.FrameCount := 0;<br />   Info.MaxWidth := 0;<br />   Info.MaxHeight := 0;<br />   Info.Key_X := 0;<br />   Info.Key_Y := 0;<br /> <br />   Self.FName := '';<br />   Self.FSize := 0;<br /> <br />   Self.HeadDataSize := 0;<br /> end;<br /> <br /> procedure TWasFile.Burn();<br /> var<br />   i: Integer;<br /> begin<br />   for i:=Low(Data) to High(Data) do<br />   begin<br />     Data<i>.Data := nil;<br />   end;<br />   Data := nil;<br />   FData := nil;<br /> <br />   HeadData := nil;<br />   <br />   fInitialized := false;<br /> end;<br /> <br /> constructor TWasFile.Create();<br /> begin<br />   Init;<br />   fInitialized := false;<br /> end;<br /> <br /> destructor TWasFile.Destroy();<br /> begin<br />   Burn;<br /> end;<br /> <br /> procedure TWasFile.DecodeFromStream(var Dest: TWasImage; Stream: TStream);<br /> var<br />   StartPos: Int64;  // 文件在 Stream 中的 Offset<br />   LineOffset: array of Cardinal;<br />   x,y: Integer;<br />   tmp, tmp2: Byte;<br />   alpha: Byte;<br />   i: Integer;<br />   Width, Height: Integer;<br /> begin<br />   StartPos := Stream.Position;<br />   Stream.Read(Dest.Info, SizeOf(Dest.Info));<br /> <br />   Width := Dest.Info.Width;<br />   Height := Dest.Info.Height;<br /> <br />   LineOffset := nil;<br />   SetLength(LineOffset, Height);<br />   Dest.Data := nil;<br />   SetLength(Dest.Data, Width * Height);<br /> <br />   for i:=Low(Dest.Data) to High(Dest.Data) do<br />   begin<br />     // 初始化Data，因为后面有跳过某些字节的操作<br />     Dest.Data<i>.Alpha := $0;<br />     Dest.Data<i>.Index := $0;<br />   end;<br /> <br />   Stream.Read(LineOffset[0], 4 * Height);<br /> <br />   for y:=0 to Height-1 do<br />   begin<br />     x := 0;<br />     Stream.Seek(StartPos + LineOffset[y], soFromBeginning);<br />     while (x < Width) do<br />     begin<br />       Stream.Read(tmp, 1);<br />       case (tmp and $C0) of<br />         $00:  // 00 - 透明色<br />         begin<br />           if (tmp and $20)>0 then<br />           begin<br />             tmp2 := tmp and $1F;  // alpha<br />             Stream.Read(tmp, 1);<br />             Dest.Data[y*Width+x].Index := tmp;<br />             Dest.Data[y*Width+x].Alpha := tmp2;<br />             Inc(x);<br />           end<br />           else if tmp<>0 then<br />           begin<br />             // 重复alpha像素的分支<br />             tmp2 := tmp and $1F;  // 次数<br />             Stream.Read(alpha, 1);<br />             alpha := alpha and $1F;<br />             Stream.Read(tmp, 1);<br />             for i:=1 to tmp2 do<br />             begin<br />               Dest.Data[y*Width+x].Alpha := alpha;<br />               Dest.Data[y*Width+x].Index := tmp;<br />               Inc(x);<br />             end;<br />           end<br />           else<br />           begin<br />             // tmp 是$0表示数据段结束<br />             if x>Width then<br />               raise Exception.Create('第'+IntToStr(y)+'行遇到错误数据啦！');<br />             x := Width;<br />           end;<br />         end;<br />         $40:  // 01 - 像素组<br />         begin<br />           tmp2 := tmp and $3F;<br />           for i:=1 to tmp2 do<br />           begin<br />             Stream.Read(tmp, 1);<br />             Dest.Data[y*Width+x].Alpha := 32;//$1F;<br />             Dest.Data[y*Width+x].Index := tmp;<br />             inc(x);<br />           end;<br />         end;<br />         $80:  // 10 - 重复n次<br />         begin<br />           tmp2 := tmp and $3F;<br />           Stream.Read(tmp, 1);<br />           for i:=1 to tmp2 do<br />           begin<br />             Dest.Data[y*Width+x].Alpha := 32;//$1F;<br />             Dest.Data[y*Width+x].Index := tmp;<br />             inc(x);<br />           end;<br />         end;<br />         $C0:  // 11 - 跳过n字节<br />         begin<br />           tmp2 := tmp and $3F;<br />           x := x + tmp2;<br />         end;<br />       end;  // end of case<br /> <br />       if x>Width then<br />         raise Exception.Create('第'+IntToStr(y)+'行遇到错误数据啦！');<br />     end;  // end of while<br />   end;<br />   LineOffset := nil;<br /> end;<br /> <br /> procedure TWasFile.LoadFromFile(const FileName: string);<br /> var<br />   Stream: TStream;<br />   FileOffset: array of Cardinal;<br />   i: Integer;<br /> begin<br />   Stream := TMemoryStream.Create;<br />   try<br />     TMemoryStream(Stream).LoadFromFile(FileName);<br />     Burn;<br />     Init;<br />     Stream.Read(Info, SizeOf(Info));<br />     if Info.wfType <> $5053 then<br />       raise Exception.Create('错误的文件标识！');<br />     if Info.whSize < $0C then<br />       raise Exception.Create('错误的文件版本，请与作者联系！')<br />     else if Info.whSize > $0C then<br />     begin<br />       // 当文件头大小大于$0C的时候<br />       HeadDataSize := Info.whSize - $0C;<br />       SetLength(HeadData, HeadDataSize);<br />       Stream.Read(HeadData[0], HeadDataSize);<br />     end;<br />     if (Info.SpriteCount < 1) or (Info.FrameCount < 1) then<br />       raise Exception.Create('错误的精灵数或帧数！');<br />     // 开始加载图片<br />     i := Info.SpriteCount * Info.FrameCount;<br />     SetLength(Data, i);<br />     SetLength(FileOffset, i);<br />     Stream.Read(OriginalPal[0], 512); // 高彩调色板<br />     Stream.Read(FileOffset[0], 4*i);  // 子文件偏移量<br /> <br />     for i:=Low(FileOffset) to High(FileOffset) do<br />     begin<br />       if FileOffset<i>=0 then<br />       begin<br />         // 想不出更合适的办法了<br />         with Data<i> do<br />         begin<br />           Info.Width := 1;<br />           Info.Height := 1;<br />           Info.Key_X := 0;<br />           Info.Key_Y := 0;<br />           SetLength(Data, 1);<br />           Data[0].Alpha := $0;<br />           Data[0].Index := $0;<br />         end;<br />       end<br />       else<br />       begin<br />         Stream.Seek(FileOffset<i>+Info.whSize+4, soFromBeginning);<br />         DecodeFromStream(Data<i>, Stream);<br />       end;<br />     end;<br /> <br />     FName := FileName;<br />     FSize := Stream.Size - $204 - Info.whSize;<br />     FData := nil;<br />     SetLength(FData, FSize);<br />     Stream.Seek($4+Info.whSize, soFromBeginning);<br />     Stream.Read(CurrentPal[0], $200);<br />     Stream.Read(FData[0], FSize);<br />     fInitialized := true;<br />   finally<br />     Stream.Free;<br />   end;<br /> end;<br /> <br /> procedure TWasFile.DrawByKey(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);<br /> var<br />   New_X: Integer;<br />   New_Y: Integer;<br />   New_Width: Integer;<br />   New_Height: Integer;<br />   New_Left: Integer;<br />   New_Top: Integer;<br /> <br />   i,j: Integer;<br />   pDest: PByteArray;<br />   Color: Word;<br />   Alpha: Byte;<br /> begin<br />   if not fInitialized then<br />     raise Exception.Create('没加载图片，画什么啊！');<br />   if (Index<0) or (Index>(Info.SpriteCount * Info.FrameCount)) then<br />     raise Exception.Create('没有第'+IntToStr(Index)+'张图片，没法画！');<br /> <br />   // 裁减<br />   New_X := X - Data[Index].Info.Key_X;<br />   New_Y := Y - Data[Index].Info.Key_Y;<br />   New_Width := Data[Index].Info.Width;<br />   New_Height := Data[Index].Info.Height;<br />   New_Left := 0;<br />   New_Top := 0;<br /> <br />   if (New_X > Dest.Width) or (New_Y > Dest.Height) then<br />     exit;<br />   if (New_X + New_Width) > Dest.Width then<br />     New_Width := Dest.Width - New_X;<br />   if (New_Y + New_Height) > Dest.Height then<br />     New_Height := Dest.Height - New_Y;<br /> <br />   if New_X < 0 then<br />   begin<br />     New_Left := -New_X;<br />     New_X := 0;<br />   end;<br />   if New_Y < 0 then<br />   begin<br />     New_Top := -New_Y;<br />     New_Y := 0<br />   end;<br /> <br />   for i:=New_Top to New_Height-1 do<br />   begin<br />     pDest := Dest.ScanLine[New_Y+i-New_Top];<br />     Inc(LongWord(pDest), 3*New_X);<br />     for j:=New_Left to New_Width-1 do<br />     begin<br />       Color := CurrentPal[Data[Index].Data[i*Data[Index].Info.Width+j].Index];<br />       Alpha := Data[Index].Data[i*Data[Index].Info.Width+j].Alpha;<br />       pDest[0] := (((Color and $001F) shl 3) - pDest[0]) * Alpha div 32 + pDest[0];<br />       pDest[1] := (((Color and $07E0) shr 3) - pDest[1]) * Alpha div 32 + pDest[1];<br />       pDest[2] := (((Color and $F800) shr 8) - pDest[2]) * Alpha div 32 + pDest[2];<br />       Inc(LongWord(pDest), 3);<br />     end;<br />   end;<br /> end;<br /> <br /> procedure TWasFile.Draw(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);<br /> begin<br />   DrawByKey(Dest, X+Data[Index].Info.Key_X, Y+Data[Index].Info.Key_Y, Index);<br /> end;<br /> <br /> procedure TWasFile.SaveToFile(const FileName: string);<br /> var<br />   Stream: TStream;<br /> begin<br />   Stream := TFileStream.Create(FileName, fmCreate);<br />   try<br />     Stream.Write(Info, SizeOf(Info));<br />     Stream.Write(HeadData[0], HeadDataSize);<br />     Stream.Write(CurrentPal[0], $200);<br />     Stream.Write(FData[0], FSize);<br />   finally<br />     Stream.Free;<br />   end;<br /> end;<br /> <br /> function TWasFile.GetSpriteCount(): Integer;<br /> begin<br />   Result := Info.SpriteCount;<br /> end;<br /> <br /> function TWasFile.GetFrameCount(): Integer;<br /> begin<br />   Result := Info.FrameCount;<br /> end;<br /> <br /> function TWasFile.GetWidth(): Integer;<br /> begin<br />   Result := Info.MaxWidth;<br /> end;<br /> <br /> function TWasFile.GetHeight(): Integer;<br /> begin<br />   Result := Info.MaxHeight;<br /> end;<br /> <br /> function TWasFile.GetFileName(): String;<br /> begin<br />   Result := FName;<br /> end;<br /> <br /> function TWasFile.GetIsInit(): Boolean;<br /> begin<br />   Result := fInitialized;<br /> end;<br /> <br /> procedure TWasFile.GetCurrentPal(var aHighPal: HighPal);<br /> var<br />   i: Integer;<br /> begin<br />   for i:=0 to 255 do<br />   begin<br />     aHighPal<i> := CurrentPal<i>;<br />   end;<br /> end;<br /> <br /> procedure TWasFile.GetOriginalPal(var aHighPal: HighPal);<br /> var<br />   i: Integer;<br /> begin<br />   for i:=0 to 255 do<br />   begin<br />     aHighPal<i> := OriginalPal<i>;<br />   end;<br /> end;<br /> <br /> procedure TWasFile.SetCurrentPal(aHighPal: HighPal);<br /> var<br />   i: Integer;<br /> begin<br />   for i:=0 to 255 do<br />   begin<br />     CurrentPal<i> := aHighPal<i>;<br />   end;<br /> end;<br /> <br /> procedure TWasFile.ResetCurrentPal();<br /> var<br />   i: Integer;<br /> begin<br />   for i:=0 to 255 do<br />   begin<br />     CurrentPal<i> := OriginalPal<i>;<br />   end;<br /> end;<br /> <br /> procedure TWasFile.SaveToTGA();<br /> var<br />   fs1: TStream;<br />   i,l,x,y: Integer;<br />   path: widestring;<br />   FileName: widestring;<br />   tmp: Byte;<br />   bufbmp: TBitmap;<br />   pDest: PByteArray;<br /> begin<br />   FileName := FName;<br />   i := PosLast('.', FileName);<br />   path := LeftStr(FileName, i-1);<br /> <br />   bufbmp := TBitmap.Create;<br />   bufbmp.PixelFormat := pf32bit;<br />   bufbmp.Width := Info.MaxWidth;<br />   bufbmp.Height := Info.MaxHeight;<br /> <br />   for i:=Low(Data) to High(Data) do<br />   begin<br />     FileName := path + Format('%x%.3d.tga',[(i div Info.FrameCount),(i mod Info.FrameCount)]);<br />     fs1 := TFileStream.Create(FileName, fmCreate);<br />     l := $00020000;<br />     fs1.Write(l, 4);<br />     l := $0;<br />     fs1.Write(l, 4);<br />     fs1.Write(l, 4);<br />     fs1.Write(Info.MaxWidth, 2);<br />     fs1.Write(Info.MaxHeight, 2);<br />     tmp := $20;<br />     fs1.Write(tmp, 1);<br />     tmp := $08; // 原点在左下用$08,原点在左上用$28;<br />     fs1.Write(tmp, 1);<br /> <br />     // 清空bufbmp<br />     for y:=0 to bufbmp.Height-1 do<br />     begin<br />       pDest := bufbmp.ScanLine[y];<br />       for x:=0 to bufbmp.Width-1 do<br />       begin<br />         pDest[0]:=0;<br />         pDest[1]:=0;<br />         pDest[2]:=0;<br />         pDest[3]:=0;<br />         Inc(LongWord(pDest), 4);<br />       end;<br />     end;<br /> <br />     DrawToTGA(bufbmp, Info.Key_X, Info.Key_Y, i);<br /> <br />     for y:=bufbmp.Height-1 downto 0 do<br />     begin<br />       pDest := bufbmp.ScanLine[y];<br />       fs1.Write(pDest[0], 4*bufbmp.Width);<br />     end;<br />     <br />     fs1.Free;<br />   end;<br />   bufbmp := nil;<br /> end;<br /> <br /> function PosLast(substr1,str1: widestring):Integer;<br /> var<br />   str2: widestring;<br />   i,l: Integer;<br />   sum: Integer;<br /> begin<br />   sum := 0;<br />   str2 := str1;<br /> //  i := Pos('\',str1);<br />   i := Pos(substr1, str2);<br />   while i<>0 do<br />   begin<br />     l := Length(str2);<br />     sum := sum + i;<br />     str2 := RightStr(str2, l-i);<br />     i := Pos(substr1, str2);<br />   end;<br />   Result := sum;<br /> end;<br /> <br /> // 仅为TGA服务<br /> procedure TWasFile.DrawToTGA(Dest: TBitmap; X: Integer; Y: Integer; Index: Integer);<br /> var<br />   New_X: Integer;<br />   New_Y: Integer;<br />   New_Width: Integer;<br />   New_Height: Integer;<br />   New_Left: Integer;<br />   New_Top: Integer;<br /> <br />   i,j: Integer;<br />   pDest: PByteArray;<br />   Color: Word;<br />   Alpha: Byte;<br /> begin<br />   if not fInitialized then<br />     raise Exception.Create('没加载图片，画什么啊！');<br />   if (Index<0) or (Index>(Info.SpriteCount * Info.FrameCount)) then<br />     raise Exception.Create('没有第'+IntToStr(Index)+'张图片，没法画！');<br /> <br />   // 裁减<br />   New_X := X - Data[Index].Info.Key_X;<br />   New_Y := Y - Data[Index].Info.Key_Y;<br />   New_Width := Data[Index].Info.Width;<br />   New_Height := Data[Index].Info.Height;<br />   New_Left := 0;<br />   New_Top := 0;<br /> <br />   if (New_X > Dest.Width) or (New_Y > Dest.Height) then<br />     exit;<br />   if (New_X + New_Width) > Dest.Width then<br />     New_Width := Dest.Width - New_X;<br />   if (New_Y + New_Height) > Dest.Height then<br />     New_Height := Dest.Height - New_Y;<br /> <br />   if New_X < 0 then<br />   begin<br />     New_Left := -New_X;<br />     New_X := 0;<br />   end;<br />   if New_Y < 0 then<br />   begin<br />     New_Top := -New_Y;<br />     New_Y := 0<br />   end;<br /> <br />   for i:=New_Top to New_Height-1 do<br />   begin<br />     pDest := Dest.ScanLine[New_Y+i-New_Top];<br />     Inc(LongWord(pDest), 4*New_X);<br />     for j:=New_Left to New_Width-1 do<br />     begin<br />       Color := CurrentPal[Data[Index].Data[i*Data[Index].Info.Width+j].Index];<br />       Alpha := Data[Index].Data[i*Data[Index].Info.Width+j].Alpha;<br />       if Alpha=0 then<br />       begin<br />         // 0号调色板不一定是黑色，为了photoshop里显示的效果<br />         // 强制写入黑色<br />         pDest[0] := 0;<br />         pDest[1] := 0;<br />         pDest[2] := 0;<br />         pDest[3] := 0;<br />       end<br />       else if Alpha=32 then<br />       begin<br />         pDest[0] := ((Color and $001F) shl 3) and $F8;<br />         pDest[0] := pDest[0] or ((pDest[0] shr 3) and 7);<br />         pDest[1] := ((Color and $07E0) shr 3) and $FC;<br />         pDest[1] := pDest[1] or ((pDest[1] shr 2) and 3);<br />         pDest[2] := ((Color and $F800) shr 8) and $F8;<br />         pDest[2] := pDest[2] or ((pDest[2] shr 3) and 7);<br />         pDest[3] := 255;<br />       end<br />       else<br />       begin<br />         // alpha 像素导出处<br />         // 貌似wascompress是先合并再导出，而不是直接导出，所以发黑<br /> {        pDest[0] := (((Color and $001F) shl 3) * Alpha div 32) and $F8;<br />         pDest[0] := pDest[0] or ((pDest[0] shr 3) and 7);<br />         pDest[1] := (((Color and $07E0) shr 3) * Alpha div 32) and $FC;<br />         pDest[1] := pDest[1] or ((pDest[1] shr 2) and 3);<br />         pDest[2] := (((Color and $F800) shr 8) * Alpha div 32) and $F8;<br />         pDest[2] := pDest[2] or ((pDest[2] shr 3) and 7);}<br /> <br />         // 正常的TGA导出<br />         pDest[0] := ((Color and $001F) shl 3) and $F8;<br />         pDest[0] := pDest[0] or ((pDest[0] shr 3) and 7);<br />         pDest[1] := ((Color and $07E0) shr 3) and $FC;<br />         pDest[1] := pDest[1] or ((pDest[1] shr 2) and 3);<br />         pDest[2] := ((Color and $F800) shr 8) and $F8;<br />         pDest[2] := pDest[2] or ((pDest[2] shr 3) and 7);<br />         pDest[3]:=Alpha*8;<br />       end;<br />       Inc(LongWord(pDest), 4);<br />     end;<br />   end;<br /> end;<br /> <br /> <br /> end.

落单的拖鞋

发来看看

戴眼镜的小狼

什么代码，出多少钱，给我发消息