unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls, ComCtrls;

const

//------------------------------------------------------------------------------
  Warning =
    '本程序仅供大家学习研究之用，不含任何商业成分。'#13#10 +
    '未经许可，任何企业或个人不得将之用于商业用途。'#13#10 +
    '对使用本程序可能引起的所有问题，本人概不负责。'#13#10 +
    #09#09#09'作者'#09 + 'Game Sprite'#13#10 +
    #09#09#09'感谢'#09 + '谜の名侦探';

//------------------------------------------------------------------------------

  Sgl_Title = 'Shanda Game Lib.';

// Targa Graphic

const
  TARGA_NO_COLORMAP = 0;
  TARGA_COLORMAP = 1;

  TARGA_EMPTY_IMAGE = 0;
  TARGA_INDEXED_IMAGE = 1;
  TARGA_TRUECOLOR_IMAGE = 2;
  TARGA_BW_IMAGE = 3;
  TARGA_INDEXED_RLE_IMAGE = 9;
  TARGA_TRUECOLOR_RLE_IMAGE = 10;
  TARGA_BW_RLE_IMAGE = 11;

procedure TargaEncode32(Source, Dest: PDWord; Count: Integer; var BytesStored: Integer);
procedure TargaBuild32(Stream: TStream; ASource: PDWord; AWidth, AHeight: Integer; const AImageID: string; Compressed: Boolean);

type
  TTargaHeader = packed record
    IDLength,
      ColorMapType,
      ImageType: Byte;
    ColorMapOrigin,
      ColorMapSize: Word;
    ColorMapEntrySize: Byte;
    XOrigin,
      YOrigin,
      Width,
      Height: Word;
    PixelSize: Byte;
    ImageDescriptor: Byte;
  end;

//------------------------------------------------------------------------------
// SGL File

  TSglHeader = packed record
    shTitle: array[0..31] of Char;
    shComp: DWord;
    shOffset: DWord;
  end;

  TSglImage = packed record
    siUnknown1: Byte;
    siFormat: Byte;
    siFrames: Word;
    siUnknown2: Word;
  end;
  PSglImage = ^TSglImage;

  TSglFrame = packed record
    sfWidth: Smallint;
    sfHeight: Smallint;
    sfX: Smallint;
    sfY: Smallint;
    sfXBlocks: Byte;
    sfYBlocks: Byte;
  end;
  PSglFrame = ^TSglFrame;

  TSglFile = class(TObject)
  private
    FStream: TStream;
    FFileName: string;
    FHeaderInfo: TSglHeader;
    FImageCount: Integer;
    FImageOffs: array of DWord;
    FFrameOffs: array of DWord;
    FFrames: array of TSglFrame;

    FDumpImageInfo: TSglImage;
    FImageInfo: TSglImage;
    FImageIndex: Integer;
    function GetImageCount: Integer;
    function GetImageOffset(Index: Integer): DWord;
    procedure SetImageIndex(const Value: Integer);
    function GetFrameCount: Integer;
    function GetFrame(Index: Integer): PSglFrame;
    function GetFrameOffset(Index: Integer): DWord;
    function GetImage(Index: Integer): PSglImage;
  protected
    procedure ReadFrames;
    function SGL_Decode1(ASrc, ADst: PByte; AWidth, AHeight: Integer): Boolean;
    function SGL_Decode2(ASrc, ADst: PByte; AWidth, AHeight: Integer): Boolean;
    function SGL_RLE8_Decode(ASrc, ADst: PByte; ASrcSize, ADstSize: Integer): Boolean;
    function SGL_RLE8_Decode2(ASrc, ADst: PByte; ASrcSize, ADstSize: Integer): Boolean;
    function SGL_RLE16_Decode(ASrc, ADst: PWord; ASrcSize, ADstSize: Integer): Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    function Open(FileName: string): Boolean;
    procedure Close;
    function DecodeFrame16(AFrame: Integer; ADst: PByte; AWidthBytes: Integer; ChooseColor: TColor = clWhite): Boolean;
    function DecodeFrame32(AFrame: Integer; ADst: PByte; AWidthBytes: Integer): Boolean;

    property FileName: string read FFileName;
    property HeaderInfo: TSglHeader read FHeaderInfo;
    property ImageInfo: TSglImage read FImageInfo;
    property Images[Index: Integer]: PSglImage read GetImage;
    property Frames[Index: Integer]: PSglFrame read GetFrame;
    property ImageOffsets[Index: Integer]: DWord read GetImageOffset;
    property FrameOffsets[Index: Integer]: DWord read GetFrameOffset;
    property ImageCount: Integer read GetImageCount;
    property FrameCount: Integer read GetFrameCount;
    property ImageIndex: Integer read FImageIndex write SetImageIndex;

  published

  end;

//------------------------------------------------------------------------------
// Main Form

  TMyFrame = record
    mfSglFile: TSglFile;
    mfSglImage: Integer;
    mfSglFrame: Integer;
  end;

  TMyImage = record
    miTitle: string;
    miCount: Integer;
    miColor: TColor;
    miFrames: array of TMyFrame;
  end;
  PMyImage = ^TMyImage;

//------------------------------------------------------------------------------
  TFormMain = class(TForm)
    PanelMain: TPanel;
    Splitter2: TSplitter;
    PanelList: TPanel;
    Splitter1: TSplitter;
    Splitter3: TSplitter;
    PopupMenu1: TPopupMenu;
    miOpenSGL: TMenuItem;
    miCloseSGL: TMenuItem;
    miCloseAllSGL: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    PopupMenu2: TPopupMenu;
    PopupMenu3: TPopupMenu;
    miSaveSGLImage: TMenuItem;
    miSaveSGLFrame: TMenuItem;
    PopupMenu6: TPopupMenu;
    miCopyImage: TMenuItem;
    miBGColor: TMenuItem;
    ColorDialog1: TColorDialog;
    PanelFrame: TPanel;
    PanelFile: TPanel;
    PanelImage: TPanel;
    Label3: TLabel;
    ListView3: TListView;
    ListView2: TListView;
    Label2: TLabel;
    ListView1: TListView;
    Label1: TLabel;
    PanelView: TPanel;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    PanelConvert: TPanel;
    Splitter5: TSplitter;
    Panel2: TPanel;
    Label4: TLabel;
    ListView5: TListView;
    Panel4: TPanel;
    Label6: TLabel;
    ListView4: TListView;
    Splitter6: TSplitter;
    PopupMenu4: TPopupMenu;
    miAddCImage: TMenuItem;
    miDeleteCImage: TMenuItem;
    PopupMenu5: TPopupMenu;
    miDeleteFrame: TMenuItem;
    miDeleteAllCImage: TMenuItem;
    miSaveCImageAsBMP: TMenuItem;
    miDeleteAllFrame: TMenuItem;
    miSaveCImage: TMenuItem;
    StatusBar1: TStatusBar;
    miSaveSGLImageAsTGA: TMenuItem;
    miSaveSGLFrameAsTGA: TMenuItem;
    miSaveCImageAsTGA: TMenuItem;
    miAddSGLImage: TMenuItem;
    miAddSGLFrame: TMenuItem;
    miDeleteImage: TMenuItem;
    miColoration: TMenuItem;
    miChooseColor: TMenuItem;
    procedure miOpenSGLClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure miCloseSGLClick(Sender: TObject);
    procedure miCloseAllSGLClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure miSaveSGLImageClick(Sender: TObject);
    procedure miSaveSGLFrameClick(Sender: TObject);
    procedure miBGColorClick(Sender: TObject);
    procedure miCopyImageClick(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure ListView2SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure ListView3SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure ListView2Data(Sender: TObject; Item: TListItem);
    procedure ListView3Data(Sender: TObject; Item: TListItem);
    procedure miAddCImageClick(Sender: TObject);
    procedure miDeleteCImageClick(Sender: TObject);
    procedure miDeleteAllCImageClick(Sender: TObject);
    procedure ListView4Data(Sender: TObject; Item: TListItem);
    procedure ListView4SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure ListView5SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure ListView5Data(Sender: TObject; Item: TListItem);
    procedure miAddSGLFrameClick(Sender: TObject);
    procedure miAddSGLImageClick(Sender: TObject);
    procedure miSaveCImageAsBMPClick(Sender: TObject);
    procedure miDeleteFrameClick(Sender: TObject);
    procedure miDeleteAllFrameClick(Sender: TObject);
    procedure miSaveCImageClick(Sender: TObject);
    procedure ListView4DataStateChange(Sender: TObject; StartIndex,
      EndIndex: Integer; OldState, NewState: TItemStates);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure PopupMenu2Popup(Sender: TObject);
    procedure PopupMenu3Popup(Sender: TObject);
    procedure PopupMenu4Popup(Sender: TObject);
    procedure PopupMenu5Popup(Sender: TObject);
    procedure ListView4MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListView4MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListView4MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ListView4Edited(Sender: TObject; Item: TListItem;
      var S: string);
    procedure miSaveSGLImageAsTGAClick(Sender: TObject);
    procedure miSaveSGLFrameAsTGAClick(Sender: TObject);
    procedure miSaveCImageAsTGAClick(Sender: TObject);
    procedure miDeleteImageClick(Sender: TObject);
    procedure miColorationClick(Sender: TObject);
    procedure miChooseColorClick(Sender: TObject);
  private
    { Private declarations }
    FSglFile: TSglFile;
    FBGColor: TColor;
    FChooseColor: TColor;
    FSglList: TList;
    FAddCount: Integer;
    FMyImage: PMyImage;
    FMyImageList: TList;
    FImageChanged: Boolean;
    FMouseDown: Boolean;
    FMouseDownIndex: Integer;
    FCX: Integer;
    FCY: Integer;
    FCWidth: Integer;
    FCHeight: Integer;
    FCFrames: Integer;
    FAddRange: string;
    procedure AddCImage(const ATitle: string);
    procedure ConvertGraphicsToBMP(const FileName: string; Images: PMyImage);
    procedure UpdateListView4;
    procedure ConvertGraphicsToTga(const FileName: string;
      Images: PMyImage);
  public
    { Public declarations }
  end;
//------------------------------------------------------------------------------

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

uses Clipbrd;

//------------------------------------------------------------------------------
// Targa Graphics Encode
//------------------------------------------------------------------------------

procedure TargaEncode32(Source, Dest: PDWord; Count: Integer; var BytesStored: Integer);
var
  DiffCount: Integer;
  SameCount: Integer;
  SourcePtr: PDWord;
  TargetPtr: PDWord;
  P: PDWord;
  I: Integer;
  C: Integer;
  Pixel: DWord;
begin
  BytesStored := 0;
  SourcePtr := Source;
  TargetPtr := Dest;

  while Count > 0 do
  begin

    DiffCount := 0;
    P := SourcePtr;
    if Count = 1 then
      DiffCount := 1
    else
    begin
      Pixel := P^;
      for I := 1 to Count - 1 do
      begin
        Inc(P);
        if P^ = Pixel then Break;
        Pixel := P^;
        Inc(DiffCount);
      end;
      if P^ <> Pixel then Inc(DiffCount);
    end;

    Dec(Count, DiffCount);
    while DiffCount > 0 do
    begin
      if DiffCount > 128 then
        C := 128
      else
        C := DiffCount;
      PByte(TargetPtr)^ := C - 1;
      Inc(PByte(TargetPtr));
      Inc(BytesStored, C * 4 + 1);
      MoveMemory(TargetPtr, SourcePtr, C * 4);
      Inc(TargetPtr, C);
      Inc(SourcePtr, C);
      Dec(DiffCount, C);
    end;

    SameCount := 1;
    P := SourcePtr;
    Pixel := P^;
    for I := 1 to Count - 1 do
    begin
      Inc(P);
      if P^ <> Pixel then Break;
      Inc(SameCount);
    end;

    if SameCount > 1 then
    begin
      Dec(Count, SameCount);
      while SameCount > 0 do
      begin
        if SameCount > 128 then
          C := 128
        else
          C := SameCount;
        PByte(TargetPtr)^ := (C - 1) or $80;
        Inc(PByte(TargetPtr));
        Inc(BytesStored, 5);
        TargetPtr^ := SourcePtr^;
        Inc(TargetPtr);
        Inc(SourcePtr, C);
        Dec(SameCount, C);
      end;
    end;
  end;
end;

procedure TargaBuild32(Stream: TStream; ASource: PDWord; AWidth, AHeight: Integer; const AImageID: string; Compressed: Boolean);
var
  RLEBuffer: PDWord;
  I: Integer;
  LineSize: Integer;
  WriteLength: Integer;
  Header: TTargaHeader;
begin
  with Header do
  begin
    IDLength := Length(AImageID);
    ColorMapType := 0;
    if not Compressed then
      ImageType := TARGA_TRUECOLOR_IMAGE
    else
      ImageType := TARGA_TRUECOLOR_RLE_IMAGE;

    ColorMapOrigin := 0;
    ColorMapSize := 256;
    ColorMapEntrySize := 24;
    XOrigin := 0;
    YOrigin := 0;
    Width := AWidth;
    Height := AHeight;
    PixelSize := 32;
    ImageDescriptor := $20;
  end;

  Stream.Write(Header, SizeOf(Header));
  if Header.IDLength > 0 then Stream.Write(AImageID[1], Header.IDLength);

  LineSize := AWidth * 4;
  // finally write image data
  if Compressed then
  begin
    GetMem(RLEBuffer, 2 * LineSize);
    try
      for I := 0 to AHeight - 1 do
      begin
        TargaEncode32(ASource, RLEBuffer, AWidth, WriteLength);
        Stream.WriteBuffer(RLEBuffer^, WriteLength);
        Inc(ASource, AWidth);
      end;
    finally
      FreeMem(RLEBuffer);
    end;
  end
  else
  begin
    for I := 0 to AHeight - 1 do
    begin
      Stream.WriteBuffer(ASource^, LineSize);
      Inc(ASource, AWidth);
    end;
  end;
end;

//------------------------------------------------------------------------------
// TSglFile
//------------------------------------------------------------------------------

procedure TSglFile.Close;
begin
  if FStream <> nil then
  begin
    FStream.Free;
    FStream := nil;
  end;
  SetLength(FImageOffs, 0);
  FillChar(FHeaderInfo, SizeOf(TSglHeader), 0);
  FillChar(FImageInfo, SizeOf(TSglImage), 0);
  FImageIndex := -1;
  FFileName := '';

end;

constructor TSglFile.Create;
begin

end;


function TSglFile.SGL_Decode2(ASrc, ADst: PByte; AWidth,
  AHeight: Integer): Boolean;
const
  MASK = $000000F0;
  MULT = $00005556;
var
  wR1: Word;
  wG1: Word;
  wB1: Word;
  wA1: Word;
  wR2: Word;
  wG2: Word;
  wB2: Word;
  wA2: Word;
  I: Integer;
  J: Integer;
  dwTemp: DWord;
  lpPixel: PWord;
  Pal: array[0..3] of Word;
begin
  for J := 0 to AHeight div 4 - 1 do
  begin
    for I := 0 to AWidth div 4 - 1 do
    begin
      lpPixel := PWord(Integer(ADst) + I * 8);

      //dwTemp = $FFB7A572, Pal[0] = $FBA7, Pal[1] = $F752
      dwTemp := PDWord(ASrc)^;
      Inc(ASrc, 4);

      wB1 := (dwTemp) and MASK; //wB1 = 0070
      wG1 := (dwTemp shr 8) and MASK; //wG1 = 00A0
      wR1 := (dwTemp shr 16) and MASK; //wR1 = 00B0
      wA1 := (dwTemp shr 24) and MASK; //wA1 = 00F0

      wB2 := (dwTemp shl 4) and MASK; //wB2 = 0020
      wG2 := (dwTemp shr 4) and MASK; //wG2 = 0050
      wR2 := (dwTemp shr 12) and MASK; //wR2 = 0070
      wA2 := (dwTemp shr 20) and MASK; //wA2 = 00F0

      Pal[0] := wB1 shr 4 or wG1 or wR1 shl 4 or wA1 shl 8; //Pal[0] = $FBA7
      Pal[1] := wB2 shr 4 or wG2 or wR2 shl 4 or wA2 shl 8; //Pal[1] = $F752
      Pal[2] :=
        ((wB1 shl 1 + wB2) * MULT shr 16 + 8) and MASK shr 4 or
        ((wG1 shl 1 + wG2) * MULT shr 16 + 8) and MASK or
        ((wR1 shl 1 + wR2) * MULT shr 16 + 8) and MASK shl 4 or
        ((wA1 shl 1 + wA2) * MULT shr 16 + 8) and MASK shl 8; //Pal[2] = $FA85
      Pal[3] :=
        ((wB2 shl 1 + wB1) * MULT shr 16 + 8) and MASK shr 4 or
        ((wG2 shl 1 + wG1) * MULT shr 16 + 8) and MASK or
        ((wR2 shl 1 + wR1) * MULT shr 16 + 8) and MASK shl 4 or
        ((wA2 shl 1 + wA1) * MULT shr 16 + 8) and MASK shl 8; //Pal[2] = $F874

      dwTemp := PDWord(ASrc)^;
      Inc(ASrc, 4);

      lpPixel^ := Pal[dwTemp and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 2) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 4) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 6) and 3];
      Inc(lpPixel, AWidth - 3);

      lpPixel^ := Pal[(dwTemp shr 8) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 10) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 12) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 14) and 3];
      Inc(lpPixel, AWidth - 3);

      lpPixel^ := Pal[(dwTemp shr 16) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 18) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 20) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 22) and 3];
      Inc(lpPixel, AWidth - 3);

      lpPixel^ := Pal[(dwTemp shr 24) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 26) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 28) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 30) and 3];
    end;
    Inc(ADst, AWidth * 8);
  end;
  Result := True;
end;

function TSglFile.SGL_Decode1(ASrc, ADst: PByte; AWidth,
  AHeight: Integer): Boolean;
const
  MASK = $000000F0;
  MULT = $00005556;
var
  wR1: Word;
  wG1: Word;
  wB1: Word;
  wR2: Word;
  wG2: Word;
  wB2: Word;
  I: Integer;
  J: Integer;
  dwTemp: DWord;
  lpPixel: PWord;
  Pal: array[0..3] of Word;
begin
  for J := 0 to AHeight div 4 - 1 do
  begin
    for I := 0 to AWidth div 4 - 1 do
    begin
      lpPixel := PWord(Integer(ADst) + I * 8);

      //dwTemp = $FFB7A572, Color1 = $FBA7, Color2 = $F752
      dwTemp := PDWord(ASrc)^;
      Inc(ASrc, 3);

      wB1 := (dwTemp) and MASK; //wB1 = 0070
      wG1 := (dwTemp shr 8) and MASK; //wG1 = 00A0
      wR1 := (dwTemp shr 16) and MASK; //wR1 = 00B0

      wB2 := (dwTemp shl 4) and MASK; //wB2 = 0020
      wG2 := (dwTemp shr 4) and MASK; //wG2 = 0050
      wR2 := (dwTemp shr 12) and MASK; //wR2 = 0070

      Pal[0] := wB1 shr 4 or wG1 or wR1 shl 4 or $F000; //Pal[0] = $FBA7
      Pal[1] := wB2 shr 4 or wG2 or wR2 shl 4 or $F000; //Pal[1] = $F752
      Pal[2] := //Pal[2] = $FA85
        ((wB1 shl 1 + wB2) * MULT shr 16 + 8) and MASK shr 4 or
        ((wG1 shl 1 + wG2) * MULT shr 16 + 8) and MASK or
        ((wR1 shl 1 + wR2) * MULT shr 16 + 8) and MASK shl 4 or $F000;
      Pal[3] := //Pal[2] = $F874
        ((wB2 shl 1 + wB1) * MULT shr 16 + 8) and MASK shr 4 or
        ((wG2 shl 1 + wG1) * MULT shr 16 + 8) and MASK or
        ((wR2 shl 1 + wR1) * MULT shr 16 + 8) and MASK shl 4 or $F000;

      dwTemp := PDWord(ASrc)^;
      Inc(ASrc, 4);

      lpPixel^ := Pal[dwTemp and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 2) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 4) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 6) and 3];
      Inc(lpPixel, AWidth - 3);

      lpPixel^ := Pal[(dwTemp shr 8) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 10) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 12) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 14) and 3];
      Inc(lpPixel, AWidth - 3);

      lpPixel^ := Pal[(dwTemp shr 16) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 18) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 20) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 22) and 3];
      Inc(lpPixel, AWidth - 3);

      lpPixel^ := Pal[(dwTemp shr 24) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 26) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 28) and 3];
      Inc(lpPixel);
      lpPixel^ := Pal[(dwTemp shr 30) and 3];
    end;
    Inc(ADst, AWidth * 8);
  end;
  Result := True;
end;

function TSglFile.SGL_RLE16_Decode(ASrc, ADst: PWord; ASrcSize,
  ADstSize: Integer): Boolean;
var
  L: Byte;
begin
  while (ASrcSize > 0) and (ADstSize > 0) do
  begin
    if (PByte(ASrc)^ and $80) = 0 then
    begin
      L := PByte(ASrc)^;
      Inc(PByte(ASrc));
      Dec(ASrcSize, 3);
      if L > ADstSize then L := ADstSize;
      Dec(ADstSize, L * 2);
      for L := 1 to L do
      begin
        ADst^ := ASrc^;
        Inc(ADst);
      end;
      Inc(ASrc);
    end
    else
    begin
      L := PByte(ASrc)^ and $7F;
      Inc(PByte(ASrc));
      Dec(ASrcSize, L * 2 + 1);
      if L > ADstSize then L := ADstSize;
      Dec(ADstSize, L * 2);
      for L := 1 to L do
      begin
        ADst^ := ASrc^;
        Inc(ADst);
        Inc(ASrc);
      end;
    end;
  end;
  Result := True;
end;

function TSglFile.SGL_RLE8_Decode(ASrc, ADst: PByte; ASrcSize,
  ADstSize: Integer): Boolean;
var
  L: Byte;
begin
  while (ASrcSize > 0) and (ADstSize > 0) do
  begin
    if (PByte(ASrc)^ and $80) = 0 then
    begin
      L := ASrc^;
      Inc(ASrc);
      Dec(ASrcSize, 2);
      if L > ADstSize then L := ADstSize;
      Dec(ADstSize, L);
      for L := 1 to L do
      begin
        ADst^ := ASrc^;
        Inc(ADst);
      end;
      Inc(ASrc);
    end
    else
    begin
      L := PByte(ASrc)^ and $7F;
      Inc(PByte(ASrc));
      Dec(ASrcSize, L + 1);
      if L > ADstSize then L := ADstSize;
      Dec(ADstSize, L);
      for L := 1 to L do
      begin
        ADst^ := ASrc^;
        Inc(ADst);
        Inc(ASrc);
      end;
    end;
  end;
  Result := True;
end;

function TSglFile.SGL_RLE8_Decode2(ASrc, ADst: PByte; ASrcSize,
  ADstSize: Integer): Boolean;
var
  L: Byte;
begin
  while (ASrcSize > 0) and (ADstSize > 0) do
  begin
    if (PByte(ASrc)^ and $80) = 0 then
    begin
      L := ASrc^ * 2;
      Inc(ASrc);
      Dec(ASrcSize, 2);
      if L > ADstSize then L := ADstSize;
      Dec(ADstSize, L);
      for L := 1 to L do
      begin
        ADst^ := ASrc^;
        Inc(ADst);
      end;
      Inc(ASrc);
    end
    else
    begin
      L := PByte(ASrc)^ and $7F;
      Inc(PByte(ASrc));
      Dec(ASrcSize, L + 1);
      if L > ADstSize then L := ADstSize;
      Dec(ADstSize, L);
      for L := 1 to L do
      begin
        ADst^ := ASrc^;
        Inc(ADst);
        ADst^ := ASrc^;
        Inc(ADst);
        Inc(ASrc);
      end;
    end;
  end;
  Result := True;
end;

function TSglFile.DecodeFrame16(AFrame: Integer; ADst: PByte;
  AWidthBytes: Integer; ChooseColor: TColor): Boolean;

  function Coloration4444(ScrCol1, ScrCol2: Word): Word;
  var
    R1, G1, B1: Byte;
  begin
    case ScrCol1 of
      $0000: Result := 0;
      $FFFF: Result := ScrCol2;
    else
      B1 := ((ScrCol1 shr 1) and $0F) * (ScrCol2 and $0F) div $0F;
      G1 := ((ScrCol1 shr 7) and $0F) * ((ScrCol2 shr 4) and $0F) div $0F;
      R1 := ((ScrCol1 shr 12) and $0F) * ((ScrCol2 shr 8) and $0F) div $0F;

      if B1 > $0F then B1 := $0F;
      if G1 > $0F then G1 := $0F;
      if R1 > $0F then R1 := $0F;

      Result := (B1 or (G1 shl 4) or (R1 shl 8) or (ScrCol2 and $F000));
    end;
  end;

  function Coloration565(ScrCol1, ScrCol2: Word): Word;
  var
    R1, G1, B1: Byte;
  begin
    case ScrCol1 of
      $0000: Result := 0;
      $FFFF: Result := ScrCol2;
    else
      B1 := (ScrCol1 and $1F) * (ScrCol2 and $1F) div $1F;
      G1 := ((ScrCol1 shr 5) and $3F) * ((ScrCol2 shr 5) and $3F) div $3F;
      R1 := ((ScrCol1 shr 11) and $1F) * ((ScrCol2 shr 11) and $1F) div $1F;

      if B1 > $1F then B1 := $1F;
      if G1 > $3F then G1 := $3F;
      if R1 > $1F then R1 := $1F;

      Result := (B1 or (G1 shl 5) or (R1 shl 11));
    end;
  end;

  procedure Blend4444(ScrCol: Word; var DesCol: Word);
  var
    Alpha: Byte;
    dR, dG, dB: Byte;
  begin
    Alpha := (ScrCol shr 12) and $0F;
    case Alpha of
      $00: ;
      $0F: DesCol := (((ScrCol shl 1) and $1E) or
          (((ScrCol shr 2) and $3C) shl 5) or
          (((ScrCol shr 7) and $1E) shl 11));
    else
      dB := DesCol and $1F;
      dG := (DesCol shr 5) and $3F;
      dR := (DesCol shr 11) and $1F;

      DesCol := ((Alpha * ((ScrCol shl 1) and $1E - dB) shr 4 + dB) or
        ((Alpha * ((ScrCol shr 2) and $3C - dG) shr 4 + dG) shl 5) or
        ((Alpha * ((ScrCol shr 7) and $1E - dR) shr 4 + dR) shl 11));
    end;
  end;

  procedure Blend4448(Alpha: Byte; ScrCol: Word; var DesCol: Word);
  var
    dR, dG, dB: Byte;
  begin
    case Alpha of
      $00: ;
      $FF: DesCol := (((ScrCol shl 1) and $1E) or
          (((ScrCol shr 2) and $3C) shl 5) or
          (((ScrCol shr 7) and $1E) shl 11));
    else
      dB := DesCol and $1F;
      dG := (DesCol shr 5) and $3F;
      dR := (DesCol shr 11) and $1F;

      DesCol := ((Alpha * ((ScrCol shl 1) and $1E - dB) shr 8 + dB) or
        ((Alpha * ((ScrCol shr 2) and $3C - dG) shr 8 + dG) shl 5) or
        ((Alpha * ((ScrCol shr 7) and $1E - dR) shr 8 + dR) shl 11));
    end;
  end;

  procedure Blend5658(Alpha: Byte; ScrCol: Word; var DesCol: Word);
  var
    //sR, sG, sB: Byte;
    dR, dG, dB: Byte;
    //R, G, B: Byte;
  begin
    case Alpha of
      $00: ;
      $0F: DesCol := ScrCol;
    else
      {sB := ScrCol and $1F;
      sG := (ScrCol shr 5) and $3F;
      sR := (ScrCol shr 11) and $1F;}
      dB := DesCol and $1F;
      dG := (DesCol shr 5) and $3F;
      dR := (DesCol shr 11) and $1F;
      {B := Alpha * (sB - dB) shr 8 + dB;
      G := Alpha * (sG - dG) shr 8 + dG;
      R := Alpha * (sR - dR) shr 8 + dR;

      DesCol := (B or (G shl 5) or (R shl 11)); }

      DesCol := ((Alpha * ((ScrCol and $1F) - dB) shr 8 + dB) or
        ((Alpha * (((ScrCol shr 5) and $3F) - dG) shr 8 + dG) shl 5) or
        ((Alpha * (((ScrCol shr 11) and $1F) - dR) shr 8 + dR) shl 11));
    end;
  end;
var
  I: Integer;
  J: Integer;
  X: Integer;
  Y: Integer;
  W: Byte;
  H: Byte;
  nSize: DWord;
  lpSrc: PWord;
  lpData: PWord;
  lpAlpha: PByte;
  lpDLine: PByte;
  lpSCur: PWord;
  lpDCur: PWord;
  lpACur: PByte;
  wColor: Word;
  FrameInfo: PSglFrame;
begin
  Result := False;
  if (AFrame < Low(FFrames)) and (AFrame > High(FFrames)) then Exit;

  wColor := ((ChooseColor shr 19) and $001F) or ((ChooseColor shr 5) and $07E0) or ((ChooseColor shl 8) and $F800);
  FrameInfo := @FFrames[AFrame];
  FStream.Seek(FFrameOffs[AFrame] + SizeOf(TSglFrame), soBeginning);
  case FImageInfo.siFormat of
//------------------------------------------------------------------------------
    $02: //未压缩  （高速版本）
      begin
        for Y := 0 to FrameInfo.sfYBlocks - 1 do
          for X := 0 to FrameInfo.sfXBlocks - 1 do
          begin
            FStream.ReadBuffer(W, SizeOf(Byte));
            FStream.ReadBuffer(H, SizeOf(Byte));
            nSize := (H + 1) * (W + 1) * 2;
            if FStream.Position + nSize > FStream.Size then Exit;

            GetMem(lpSrc, nSize);
            try
              FStream.ReadBuffer(lpSrc^, nSize);

              lpSCur := lpSrc;
              lpDLine := PByte(Integer(ADst) + Y * 256 * AWidthBytes + X * 256 * 2);
              for J := 0 to H do
              begin
                lpDCur := PWord(lpDLine);
                for I := 0 to W do
                begin
                  Blend4444(Coloration4444(wColor, lpSCur^), lpDCur^);
                  //Blend4444(lpSCur^, lpDCur^);
                  Inc(lpSCur);
                  Inc(lpDCur);
                end;
                Inc(lpDLine, AWidthBytes);
              end;

            finally
              FreeMem(lpSrc);
            end;
          end;
        Result := True;
      end;
//------------------------------------------------------------------------------
    $82: //未压缩 有Alpha （高速版本）
      begin
        nSize := FrameInfo.sfHeight * FrameInfo.sfWidth * 2;
        if FStream.Position + nSize > FStream.Size then Exit;
        GetMem(lpSrc, nSize);
        try
          FStream.ReadBuffer(lpSrc^, nSize);

          nSize := FrameInfo.sfHeight * FrameInfo.sfWidth;
          if FStream.Position + nSize > FStream.Size then Exit;
          GetMem(lpAlpha, nSize);
          try
            FStream.ReadBuffer(lpAlpha^, nSize);

            lpACur := lpAlpha;
            lpSCur := lpSrc;
            lpDLine := PByte(ADst);
            for Y := 1 to FrameInfo.sfHeight do
            begin
              lpDCur := PWord(lpDLine);
              for X := 1 to FrameInfo.sfWidth do
              begin
                Blend5658(lpACur^, Coloration565(wColor, lpSCur^), lpDCur^);
                //Blend5658(lpACur^, lpSCur^, lpDCur^);
                Inc(lpACur);
                Inc(lpSCur);
                Inc(lpDCur);
              end;
              Inc(lpDLine, AWidthBytes);
            end;

            Result := True;
          finally
            FreeMem(lpAlpha);
          end;
        finally
          FreeMem(lpSrc);
        end;
      end;
//------------------------------------------------------------------------------
    $88: //未压缩  （高速版本）
      begin
        nSize := FrameInfo.sfHeight * FrameInfo.sfWidth * 2;
        if FStream.Position + nSize > FStream.Size then Exit;

        GetMem(lpSrc, nSize);
        try
          FStream.ReadBuffer(lpSrc^, nSize);

          lpSCur := lpSrc;
          lpDLine := PByte(ADst);
          for Y := 1 to FrameInfo.sfHeight do
          begin
            lpDCur := PWord(lpDLine);
            for X := 1 to FrameInfo.sfWidth do
            begin
              if (lpSCur^ <> $FF00) then
                lpDCur^ := Coloration565(wColor, lpSCur^);
                //lpDCur^ := lpSCur^;
              Inc(lpSCur);
              Inc(lpDCur);
            end;
            Inc(lpDLine, AWidthBytes);
          end;

          Result := True;
        finally
          FreeMem(lpSrc);
        end;

      end;
//------------------------------------------------------------------------------
    $06: //已压缩 有Alpha（高速版本）
      begin
        FStream.ReadBuffer(nSize, SizeOf(DWord));
        if FStream.Position + nSize > FStream.Size then Exit;
        I := FrameInfo.sfHeight * FrameInfo.sfWidth * 2;
        GetMem(lpSrc, I);
        try
          GetMem(lpData, nSize);
          try
            FStream.ReadBuffer(lpData^, nSize);
            SGL_RLE16_Decode(lpData, lpSrc, nSize, I);
          finally
            FreeMem(lpData);
          end;

          FStream.ReadBuffer(nSize, SizeOf(DWord));
          if FStream.Position + nSize > FStream.Size then Exit;
          I := FrameInfo.sfHeight * FrameInfo.sfWidth;
          GetMem(lpAlpha, I);
          try
            GetMem(lpData, nSize);
            try
              FStream.ReadBuffer(lpData^, nSize);
              SGL_RLE8_Decode(PByte(lpData), lpAlpha, nSize, I);
            finally
              FreeMem(lpData);
            end;

            lpACur := lpAlpha;
            lpSCur := lpSrc;
            lpDLine := PByte(ADst);
            for Y := 1 to FrameInfo.sfHeight do
            begin
              lpDCur := PWord(lpDLine);
              for X := 1 to FrameInfo.sfWidth do
              begin
                Blend5658(lpACur^, Coloration565(wColor, lpSCur^), lpDCur^);
                //Blend5658(lpACur^, lpSCur^, lpDCur^);
                Inc(lpACur);
                Inc(lpSCur);
                Inc(lpDCur);
              end;
              Inc(lpDLine, AWidthBytes);
            end;

            Result := True;
          finally
            FreeMem(lpAlpha);
          end;
        finally
          FreeMem(lpSrc);
        end;
      end;
//------------------------------------------------------------------------------
    $18: //已压缩  （高速版本）
      begin
        FStream.ReadBuffer(nSize, SizeOf(DWord));
        if FStream.Position + nSize > FStream.Size then Exit;

        I := FrameInfo.sfHeight * FrameInfo.sfWidth * 2;
        GetMem(lpSrc, I);
        try
          GetMem(lpData, nSize);
          try
            FStream.ReadBuffer(lpData^, nSize);
            SGL_RLE16_Decode(lpData, lpSrc, nSize, I);
          finally
            FreeMem(lpData);
          end;

          lpSCur := lpSrc;
          lpDLine := PByte(ADst);
          for Y := 1 to FrameInfo.sfHeight do
          begin
            lpDCur := PWord(lpDLine);
            for X := 1 to FrameInfo.sfWidth do
            begin
              if (lpSCur^ <> $FF00) then
                lpDCur^ := Coloration565(wColor, lpSCur^);
                //lpDCur^ := lpSCur^;
              Inc(lpSCur);
              Inc(lpDCur);
            end;
            Inc(lpDLine, AWidthBytes);
          end;

          Result := True;
        finally
          FreeMem(lpSrc);
        end;
      end;
//------------------------------------------------------------------------------
    $28: //已压缩  （高速版本）
      (*begin
        FStream.ReadBuffer(nSize, SizeOf(DWord));
        if FStream.Position + nSize > FStream.Size then Exit;

        I := FrameInfo.sfHeight * FrameInfo.sfWidth * 2;
        GetMem(lpSrc, I);
        try
          GetMem(lpData, nSize);
          try
            FStream.ReadBuffer(lpData^, nSize);
            //SGL_Decode1(PByte(lpData), PByte(lpSrc), FrameInfo.sfWidth, FrameInfo.sfHeight);
          finally
            FreeMem(lpData);
          end;

          lpSCur := lpSrc;
          lpDLine := PByte(ADst);
          for Y := 1 to FrameInfo.sfHeight do
          begin
            lpDCur := PWord(lpDLine);
            for X := 1 to FrameInfo.sfWidth do
            begin
              Blend4444(lpSCur^, lpDCur^);
              Inc(lpSCur);
              Inc(lpDCur);
            end;
            Inc(lpDLine, AWidthBytes);
          end;

          Result := True;
        finally
          FreeMem(lpSrc);
        end;
      end*);
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
    $11, $12: //已压缩  （高画质版本）
      begin
        for Y := 0 to FrameInfo.sfYBlocks - 1 do
          for X := 0 to FrameInfo.sfXBlocks - 1 do
          begin
            FStream.ReadBuffer(W, SizeOf(Byte));
            FStream.ReadBuffer(H, SizeOf(Byte));
            FStream.ReadBuffer(nSize, SizeOf(DWord));
            if FStream.Position + nSize > FStream.Size then Exit;

            I := (H + 1) * (W + 1) * 2;
            GetMem(lpSrc, I);
            try
              GetMem(lpData, nSize);
              try
                FStream.ReadBuffer(lpData^, nSize);
                SGL_RLE16_Decode(lpData, lpSrc, nSize, I);
              finally
                FreeMem(lpData);
              end;

              lpSCur := lpSrc;
              lpDLine := PByte(Integer(ADst) + Y * 256 * AWidthBytes + X * 256 * 2);
              for J := 0 to H do
              begin
                lpDCur := PWord(lpDLine);
                for I := 0 to W do
                begin
                  Blend4444(Coloration4444(wColor, lpSCur^), lpDCur^);
                  //Blend4444(lpSCur^, lpDCur^);
                  Inc(lpSCur);
                  Inc(lpDCur);
                end;
                Inc(lpDLine, AWidthBytes);
              end;

            finally
              FreeMem(lpSrc);
            end;
          end;
        Result := True;
      end;
//------------------------------------------------------------------------------
    $22: //已压缩  （高画质版本）
      begin
        for Y := 0 to FrameInfo.sfYBlocks - 1 do
          for X := 0 to FrameInfo.sfXBlocks - 1 do
          begin
            FStream.ReadBuffer(W, SizeOf(Byte));
            FStream.ReadBuffer(H, SizeOf(Byte));
            FStream.ReadBuffer(nSize, SizeOf(DWord));
            if FStream.Position + nSize > FStream.Size then Exit;

            I := (H + 1) * (W + 1) * 2;
            GetMem(lpSrc, I);
            try
              GetMem(lpData, nSize);
              try
                FStream.ReadBuffer(lpData^, nSize);
                SGL_Decode1(PByte(lpData), PByte(lpSrc), W + 1, H + 1);
              finally
                FreeMem(lpData);
              end;

              lpSCur := lpSrc;
              lpDLine := PByte(Integer(ADst) + Y * 256 * AWidthBytes + X * 256 * 2);
              for J := 0 to H do
              begin
                lpDCur := PWord(lpDLine);
                for I := 0 to W do
                begin
                  Blend4444(Coloration4444(wColor, lpSCur^), lpDCur^);
                  //Blend4444(lpSCur^, lpDCur^);
                  Inc(lpSCur);
                  Inc(lpDCur);
                end;
                Inc(lpDLine, AWidthBytes);
              end;

            finally
              FreeMem(lpSrc);
            end;
          end;
        Result := True;
      end;
//------------------------------------------------------------------------------
    $62: //已压缩  有Alpha通道（高画质版本）
      begin
        for Y := 0 to FrameInfo.sfYBlocks - 1 do
          for X := 0 to FrameInfo.sfXBlocks - 1 do
          begin
            FStream.ReadBuffer(W, SizeOf(Byte));
            FStream.ReadBuffer(H, SizeOf(Byte));
            FStream.ReadBuffer(nSize, SizeOf(DWord));
            if FStream.Position + nSize > FStream.Size then Exit;

            I := (H + 1) * (W + 1) * 2;
            GetMem(lpSrc, I);
            try
              GetMem(lpData, nSize);
              try
                FStream.ReadBuffer(lpData^, nSize);
                SGL_Decode1(PByte(lpData), PByte(lpSrc), W + 1, H + 1);
              finally
                FreeMem(lpData);
              end;

              FStream.ReadBuffer(nSize, SizeOf(DWord));
              if FStream.Position + nSize > FStream.Size then Exit;
              I := (H + 1) * (W + 1);
              GetMem(lpAlpha, I);
              try
                GetMem(lpData, nSize);
                try
                  FStream.ReadBuffer(lpData^, nSize);
                  SGL_RLE8_Decode2(PByte(lpData), lpAlpha, nSize, I);
                finally
                  FreeMem(lpData);
                end;

                lpACur := lpAlpha;
                lpSCur := lpSrc;
                lpDLine := PByte(Integer(ADst) + Y * 256 * AWidthBytes + X * 256 * 2);
                for J := 0 to H do
                begin
                  lpDCur := PWord(lpDLine);
                  for I := 0 to W do
                  begin
                    Blend4448(lpACur^, Coloration4444(wColor, lpSCur^), lpDCur^);
                    //Blend4448(lpACur^, lpSCur^, lpDCur^);
                    Inc(lpACur);
                    Inc(lpSCur);
                    Inc(lpDCur);
                  end;
                  Inc(lpDLine, AWidthBytes);
                end;

              finally
                FreeMem(lpAlpha);
              end;
            finally
              FreeMem(lpSrc);
            end;
          end;
        Result := True;
      end;
//------------------------------------------------------------------------------
  end;

end;

function TSglFile.DecodeFrame32(AFrame: Integer; ADst: PByte;
  AWidthBytes: Integer): Boolean;

var
  I: Integer;
  J: Integer;
  X: Integer;
  Y: Integer;
  W: Byte;
  H: Byte;
  nSize: DWord;
  lpSrc: PWord;
  lpData: PWord;
  lpAlpha: PByte;
  lpDLine: PByte;
  lpSCur: PWord;
  lpDCur: PDWord;
  lpACur: PByte;
  FrameInfo: PSglFrame;
begin
  Result := False;
  if (AFrame < Low(FFrames)) and (AFrame > High(FFrames)) then Exit;

  FrameInfo := @FFrames[AFrame];
  FStream.Seek(FFrameOffs[AFrame] + SizeOf(TSglFrame), soBeginning);
  case FImageInfo.siFormat of
//------------------------------------------------------------------------------
    $02: //未压缩  （高速版本）
      begin
        for Y := 0 to FrameInfo.sfYBlocks - 1 do
          for X := 0 to FrameInfo.sfXBlocks - 1 do
          begin
            FStream.ReadBuffer(W, SizeOf(Byte));
            FStream.ReadBuffer(H, SizeOf(Byte));
            nSize := (H + 1) * (W + 1) * 2;
            if FStream.Position + nSize > FStream.Size then Exit;

            GetMem(lpSrc, nSize);
            try
              FStream.ReadBuffer(lpSrc^, nSize);

              lpSCur := lpSrc;
              lpDLine := PByte(Integer(ADst) + Y * 256 * AWidthBytes + X * 256 * 4);
              for J := 0 to H do
              begin
                lpDCur := PDWord(lpDLine);
                for I := 0 to W do
                begin
                  //Blend(lpSCur^, lpDCur^);
                  lpDCur^ := (lpSCur^ and $F000 shl 16) or //Alpha
                    (lpSCur^ and $0F00 shl 12) or //Red
                    (lpSCur^ and $00F0 shl 8) or //Green
                    (lpSCur^ and $000F shl 4); //Blue
                  Inc(lpSCur);
                  Inc(lpDCur);
                end;
                Inc(lpDLine, AWidthBytes);
              end;

            finally
              FreeMem(lpSrc);
            end;
          end;
        Result := True;
      end;
//------------------------------------------------------------------------------
    $82: //未压缩 有Alpha （高速版本）
      begin
        nSize := FrameInfo.sfHeight * FrameInfo.sfWidth * 2;
        if FStream.Position + nSize > FStream.Size then Exit;
        GetMem(lpSrc, nSize);
        try
          FStream.ReadBuffer(lpSrc^, nSize);

          nSize := FrameInfo.sfHeight * FrameInfo.sfWidth;
          if FStream.Position + nSize > FStream.Size then Exit;
          GetMem(lpAlpha, nSize);
          try
            FStream.ReadBuffer(lpAlpha^, nSize);

            lpACur := lpAlpha;
            lpSCur := lpSrc;
            lpDLine := PByte(ADst);
            for Y := 1 to FrameInfo.sfHeight do
            begin
              lpDCur := PDWord(lpDLine);
              for X := 1 to FrameInfo.sfWidth do
              begin
                //AlphaBlend(lpACur^, lpSCur^, lpDCur^);
                lpDCur^ := (lpACur^ shl 24) or //Alpha
                  (lpSCur^ and $F800 shl 8) or //Red
                  (lpSCur^ and $07E0 shl 5) or //Green
                  (lpSCur^ and $001F shl 3); //Blue
                Inc(lpACur);
                Inc(lpSCur);
                Inc(lpDCur);
              end;
              Inc(lpDLine, AWidthBytes);
            end;

            Result := True;
          finally
            FreeMem(lpAlpha);
          end;
        finally
          FreeMem(lpSrc);
        end;
      end;
//------------------------------------------------------------------------------
    $88: //未压缩  （高速版本）
      begin
        nSize := FrameInfo.sfHeight * FrameInfo.sfWidth * 2;
        if FStream.Position + nSize > FStream.Size then Exit;

        GetMem(lpSrc, nSize);
        try
          FStream.ReadBuffer(lpSrc^, nSize);

          lpSCur := lpSrc;
          lpDLine := PByte(ADst);
          for Y := 1 to FrameInfo.sfHeight do
          begin
            lpDCur := PDWord(lpDLine);
            for X := 1 to FrameInfo.sfWidth do
            begin
              //if (lpSCur^ <> $FF00) then lpDCur^ := lpSCur^;
              lpDCur^ := $FF000000 or //Alpha
                (lpSCur^ and $F800 shl 8) or //Red
                (lpSCur^ and $07E0 shl 5) or //Green
                (lpSCur^ and $001F shl 3); //Blue
              Inc(lpSCur);
              Inc(lpDCur);
            end;
            Inc(lpDLine, AWidthBytes);
          end;

          Result := True;
        finally
          FreeMem(lpSrc);
        end;

      end;
//------------------------------------------------------------------------------
    $06: //已压缩 有Alpha（高速版本）
      begin
        FStream.ReadBuffer(nSize, SizeOf(DWord));
        if FStream.Position + nSize > FStream.Size then Exit;
        I := FrameInfo.sfHeight * FrameInfo.sfWidth * 2;
        GetMem(lpSrc, I);
        try
          GetMem(lpData, nSize);
          try
            FStream.ReadBuffer(lpData^, nSize);
            SGL_RLE16_Decode(lpData, lpSrc, nSize, I);
          finally
            FreeMem(lpData);
          end;

          FStream.ReadBuffer(nSize, SizeOf(DWord));
          if FStream.Position + nSize > FStream.Size then Exit;
          I := FrameInfo.sfHeight * FrameInfo.sfWidth;
          GetMem(lpAlpha, I);
          try
            GetMem(lpData, nSize);
            try
              FStream.ReadBuffer(lpData^, nSize);
              SGL_RLE8_Decode(PByte(lpData), lpAlpha, nSize, I);
            finally
              FreeMem(lpData);
            end;

            lpACur := lpAlpha;
            lpSCur := lpSrc;
            lpDLine := PByte(ADst);
            for Y := 1 to FrameInfo.sfHeight do
            begin
              lpDCur := PDWord(lpDLine);
              for X := 1 to FrameInfo.sfWidth do
              begin
                //AlphaBlend(lpACur^, lpSCur^, lpDCur^);
                lpDCur^ := (lpACur^ shl 24) or //Alpha
                  (lpSCur^ and $F800 shl 8) or //Red
                  (lpSCur^ and $07E0 shl 5) or //Green
                  (lpSCur^ and $001F shl 3); //Blue
                Inc(lpACur);
                Inc(lpSCur);
                Inc(lpDCur);
              end;
              Inc(lpDLine, AWidthBytes);
            end;

            Result := True;
          finally
            FreeMem(lpAlpha);
          end;
        finally
          FreeMem(lpSrc);
        end;
      end;
//------------------------------------------------------------------------------
    $18: //已压缩  （高速版本）
      begin
        FStream.ReadBuffer(nSize, SizeOf(DWord));
        if FStream.Position + nSize > FStream.Size then Exit;

        I := FrameInfo.sfHeight * FrameInfo.sfWidth * 2;
        GetMem(lpSrc, I);
        try
          GetMem(lpData, nSize);
          try
            FStream.ReadBuffer(lpData^, nSize);
            SGL_RLE16_Decode(lpData, lpSrc, nSize, I);
          finally
            FreeMem(lpData);
          end;

          lpSCur := lpSrc;
          lpDLine := PByte(ADst);
          for Y := 1 to FrameInfo.sfHeight do
          begin
            lpDCur := PDWord(lpDLine);
            for X := 1 to FrameInfo.sfWidth do
            begin
              //if (lpSCur^ <> $FF00) then lpDCur^ := lpSCur^;
              lpDCur^ := $FF000000 or //Alpha
                (lpSCur^ and $F800 shl 8) or //Red
                (lpSCur^ and $07E0 shl 5) or //Green
                (lpSCur^ and $001F shl 3); //Blue
              Inc(lpSCur);
              Inc(lpDCur);
            end;
            Inc(lpDLine, AWidthBytes);
          end;

          Result := True;
        finally
          FreeMem(lpSrc);
        end;
      end;
//------------------------------------------------------------------------------
    $28: ;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
    $11, $12: //已压缩  （高画质版本）
      begin
        for Y := 0 to FrameInfo.sfYBlocks - 1 do
          for X := 0 to FrameInfo.sfXBlocks - 1 do
          begin
            FStream.ReadBuffer(W, SizeOf(Byte));
            FStream.ReadBuffer(H, SizeOf(Byte));
            FStream.ReadBuffer(nSize, SizeOf(DWord));
            if FStream.Position + nSize > FStream.Size then Exit;

            I := (H + 1) * (W + 1) * 2;
            GetMem(lpSrc, I);
            try
              GetMem(lpData, nSize);
              try
                FStream.ReadBuffer(lpData^, nSize);
                SGL_RLE16_Decode(lpData, lpSrc, nSize, I);
              finally
                FreeMem(lpData);
              end;

              lpSCur := lpSrc;
              lpDLine := PByte(Integer(ADst) + Y * 256 * AWidthBytes + X * 256 * 4);
              for J := 0 to H do
              begin
                lpDCur := PDWord(lpDLine);
                for I := 0 to W do
                begin
                  //Blend(lpSCur^, lpDCur^);
                  lpDCur^ := (lpSCur^ and $F000 shl 16) or //Alpha
                    (lpSCur^ and $0F00 shl 12) or //Red
                    (lpSCur^ and $00F0 shl 8) or //Green
                    (lpSCur^ and $000F shl 4); //Blue
                  Inc(lpSCur);
                  Inc(lpDCur);
                end;
                Inc(lpDLine, AWidthBytes);
              end;

            finally
              FreeMem(lpSrc);
            end;
          end;
        Result := True;
      end;
//------------------------------------------------------------------------------
    $22: //已压缩  （高画质版本）
      begin
        for Y := 0 to FrameInfo.sfYBlocks - 1 do
          for X := 0 to FrameInfo.sfXBlocks - 1 do
          begin
            FStream.ReadBuffer(W, SizeOf(Byte));
            FStream.ReadBuffer(H, SizeOf(Byte));
            FStream.ReadBuffer(nSize, SizeOf(DWord));
            if FStream.Position + nSize > FStream.Size then Exit;

            I := (H + 1) * (W + 1) * 2;
            GetMem(lpSrc, I);
            try
              GetMem(lpData, nSize);
              try
                FStream.ReadBuffer(lpData^, nSize);
                SGL_Decode1(PByte(lpData), PByte(lpSrc), W + 1, H + 1);
              finally
                FreeMem(lpData);
              end;

              lpSCur := lpSrc;
              lpDLine := PByte(Integer(ADst) + Y * 256 * AWidthBytes + X * 256 * 4);
              for J := 0 to H do
              begin
                lpDCur := PDWord(lpDLine);
                for I := 0 to W do
                begin
                  //Blend4444(lpSCur^, lpDCur^);
                  lpDCur^ := (lpSCur^ and $F000 shl 16) or //Alpha
                    (lpSCur^ and $0F00 shl 12) or //Red
                    (lpSCur^ and $00F0 shl 8) or //Green
                    (lpSCur^ and $000F shl 4); //Blue
                  Inc(lpSCur);
                  Inc(lpDCur);
                end;
                Inc(lpDLine, AWidthBytes);
              end;

            finally
              FreeMem(lpSrc);
            end;
          end;
        Result := True;
      end;
//------------------------------------------------------------------------------
    $62: //已压缩  有Alpha通道（高画质版本）
      begin
        for Y := 0 to FrameInfo.sfYBlocks - 1 do
          for X := 0 to FrameInfo.sfXBlocks - 1 do
          begin
            FStream.ReadBuffer(W, SizeOf(Byte));
            FStream.ReadBuffer(H, SizeOf(Byte));
            FStream.ReadBuffer(nSize, SizeOf(DWord));
            if FStream.Position + nSize > FStream.Size then Exit;

            I := (H + 1) * (W + 1) * 2;
            GetMem(lpSrc, I);
            try
              GetMem(lpData, nSize);
              try
                FStream.ReadBuffer(lpData^, nSize);
                SGL_Decode1(PByte(lpData), PByte(lpSrc), W + 1, H + 1);
              finally
                FreeMem(lpData);
              end;

              FStream.ReadBuffer(nSize, SizeOf(DWord));
              if FStream.Position + nSize > FStream.Size then Exit;
              I := (H + 1) * (W + 1);
              GetMem(lpAlpha, I);
              try
                GetMem(lpData, nSize);
                try
                  FStream.ReadBuffer(lpData^, nSize);
                  SGL_RLE8_Decode2(PByte(lpData), lpAlpha, nSize, I);
                finally
                  FreeMem(lpData);
                end;

                lpACur := lpAlpha;
                lpSCur := lpSrc;
                lpDLine := PByte(Integer(ADst) + Y * 256 * AWidthBytes + X * 256 * 4);
                for J := 0 to H do
                begin
                  lpDCur := PDWord(lpDLine);
                  for I := 0 to W do
                  begin
                    //Blend4448(lpACur^, lpSCur^, lpDCur^);
                    lpDCur^ := (lpACur^ shl 24) or //Alpha
                      (lpSCur^ and $0F00 shl 12) or //Red
                      (lpSCur^ and $00F0 shl 8) or //Green
                      (lpSCur^ and $000F shl 4); //Blue
                    Inc(lpACur);
                    Inc(lpSCur);
                    Inc(lpDCur);
                  end;
                  Inc(lpDLine, AWidthBytes);
                end;

              finally
                FreeMem(lpAlpha);
              end;
            finally
              FreeMem(lpSrc);
            end;
          end;
        Result := True;
      end;
//------------------------------------------------------------------------------
  end;

end;

destructor TSglFile.Destroy;
begin
  Close;
  inherited;
end;

function TSglFile.GetFrame(Index: Integer): PSglFrame;
begin
  if (Index >= Low(FFrames)) and (Index <= High(FFrames)) then
    Result := @FFrames[Index]
  else
    Result := nil;
end;

function TSglFile.GetFrameCount: Integer;
begin
  Result := FImageInfo.siFrames;
end;

function TSglFile.GetFrameOffset(Index: Integer): DWord;
begin
  if (Index >= Low(FFrameOffs)) and (Index <= High(FFrameOffs)) then
    Result := FFrameOffs[Index]
  else
    Result := 0;
end;

function TSglFile.GetImage(Index: Integer): PSglImage;
begin
  if (Index >= Low(FImageOffs)) and (Index <= High(FImageOffs)) and (FImageOffs[Index] <> 0) then
  begin
    FStream.Position := FImageOffs[Index];
    FStream.ReadBuffer(FDumpImageInfo, SizeOf(TSglImage));
    Result := @FDumpImageInfo;
  end
  else
    Result := nil;

end;

function TSglFile.GetImageCount: Integer;
begin
  Result := FImageCount;
end;

function TSglFile.GetImageOffset(Index: Integer): DWord;
begin
  if (Index >= Low(FImageOffs)) and (Index <= High(FImageOffs)) then
    Result := FImageOffs[Index]
  else
    Result := 0;
end;

function TSglFile.Open(FileName: string): Boolean;
begin
  Close;
  Result := False;
  FStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    FStream.ReadBuffer(FHeaderInfo, SizeOf(TSglHeader));
    if AnsiCompareStr(FHeaderInfo.shTitle, Sgl_Title) <> 0 then Exit;

    FStream.Position := FHeaderInfo.shOffset;
    FStream.ReadBuffer(FImageCount, SizeOf(Integer));
    if Integer(FHeaderInfo.shOffset) + FImageCount * (SizeOf(DWord) + 16) > FStream.Size then Exit;
    SetLength(FImageOffs, FImageCount);
    FStream.ReadBuffer(FImageOffs[0], Length(FImageOffs) * SizeOf(DWord));

    FFileName := FileName;
    Result := True;
  finally
    if not Result then Close;
  end;
end;

procedure TSglFile.ReadFrames;
var
  I: Integer;
  nSize: Integer;
  nBlocks: Integer;
begin
  FStream.Position := FImageOffs[FImageIndex];
  FStream.ReadBuffer(FImageInfo, SizeOf(TSglImage));
  I := FImageInfo.siFrames;
  SetLength(FFrames, I);
  SetLength(FFrameOffs, I);
  FillChar(FFrames[0], I * SizeOf(TSglFrame), 0);
  FillChar(FFrameOffs[0], I * SizeOf(DWord), 0);
  for I := 0 to I - 1 do
  begin
    FFrameOffs[I] := FStream.Position;
    FStream.ReadBuffer(FFrames[I], SizeOf(TSglFrame));
    with FFrames[I] do
      case FImageInfo.siFormat of
        $82: //未压缩 有Alpha （高速版本）
          begin
            nSize := sfHeight * sfWidth * 4;
            FStream.Seek(nSize, soCurrent);
          end;

        $88: //未压缩  （高速版本）
          begin
            nSize := sfHeight * sfWidth * 2;
            FStream.Seek(nSize, soCurrent);
          end;

        $06: //已压缩 有Alpha（高速版本）
          begin
            FStream.ReadBuffer(nSize, SizeOf(Integer));
            FStream.Seek(nSize, soCurrent);
            FStream.ReadBuffer(nSize, SizeOf(Integer));
            FStream.Seek(nSize, soCurrent);
          end;

        $18, $28: //已压缩  （高速版本）
          begin
            FStream.ReadBuffer(nSize, SizeOf(Integer));
            FStream.Seek(nSize, soCurrent);
          end;

        $02: //未压缩 （高速版本）
          begin
            nBlocks := sfXBlocks * sfYBlocks;
            for nBlocks := 1 to nBlocks do
            begin
              FStream.ReadBuffer(nSize, SizeOf(Word));
              FStream.Seek((nSize and $00FF) * (nSize and $FF00) * 2, soCurrent);
            end;
          end;

        $11, $12, $22: //已压缩  （高画质版本）
          begin
            nBlocks := sfXBlocks * sfYBlocks;
            for nBlocks := 1 to nBlocks do
            begin
              FStream.Seek(2, soCurrent);
              FStream.ReadBuffer(nSize, SizeOf(Integer));
              FStream.Seek(nSize, soCurrent);
            end;
          end;

        $62: //已压缩  有Alpha（高画质版本）
          begin
            nBlocks := sfXBlocks * sfYBlocks;
            for nBlocks := 1 to nBlocks do
            begin
              FStream.Seek(2, soCurrent);
              FStream.ReadBuffer(nSize, SizeOf(Integer));
              FStream.Seek(nSize, soCurrent);
              FStream.ReadBuffer(nSize, SizeOf(Integer));
              FStream.Seek(nSize, soCurrent);
            end;
          end;

      else
        Break;
      end;
  end;
end;

procedure TSglFile.SetImageIndex(const Value: Integer);
begin
  if FImageIndex = Value then Exit;

  if (Value < Low(FImageOffs)) or (Value > High(FImageOffs)) then Exit;
  FImageIndex := Value;
  if FImageOffs[Value] <> 0 then
  begin
    FStream.Position := FImageOffs[Value];
    ReadFrames;
  end
  else
  begin
    SetLength(FFrames, 0);
    SetLength(FFrameOffs, 0);
    FillChar(FImageInfo, SizeOf(TSglImage), 0);
  end;
end;

//------------------------------------------------------------------------------
// TFormMain
//------------------------------------------------------------------------------

procedure TFormMain.FormCreate(Sender: TObject);
begin
  FAddCount := 1;
  FSglFile := nil;
  FBGColor := clWhite;
  FChooseColor := clWhite;
  Image1.Picture.Bitmap.Canvas.Brush.Color := FBGColor;
  Image1.Picture.Bitmap.PixelFormat := pf16Bit;
  FSglList := TList.Create;

  FAddRange := '100 - 200';
  FMyImage := nil;
  FMyImageList := TList.Create;
  AddCImage('图层' + IntToStr(FAddCount));

  Application.MessageBox(PChar(Warning), '传奇世界SGL察看器 - 声明');
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  miDeleteAllCImageClick(nil);
  miCloseAllSGLClick(nil);
  FSglList.Free;
  FMyImageList.Free;
end;

//------------------------------------------------------------------------------
// PopupMenu1

procedure TFormMain.PopupMenu1Popup(Sender: TObject);
begin
  miCloseSGL.Enabled := ListView1.SelCount <> 0;
  miCloseAllSGL.Enabled := ListView1.Items.Count <> 0;
end;

procedure TFormMain.miOpenSGLClick(Sender: TObject);
var
  I: Integer;
  Sgl: TSglFile;
begin
  if OpenDialog1.Execute then
  begin
    Sgl := nil;
    for I := 0 to OpenDialog1.Files.Count - 1 do
    begin
      if Sgl = nil then Sgl := TSglFile.Create;
      try
        if Sgl.Open(OpenDialog1.Files[I]) then
        begin
          FSglList.Add(Sgl);
          Sgl := nil;
        end;
      except
      end;
    end;
    if Sgl <> nil then Sgl.Free;
    ListView1.Items.Count := FSglList.Count;
    if ListView1.Items.Count <> 0 then
    begin
      ListView1.Items.Item[0].Selected := True;
      ListView1.Items.Item[0].Focused := True;
    end;
    ListView1.Repaint;
  end;
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.miCloseSGLClick(Sender: TObject);
var
  I: Integer;
begin
  for I := FSglList.Count - 1 downto 0 do
    if ListView1.Items.Item[I].Selected then
    begin
      TSglFile(FSglList[I]).Free;
      FSglList.Delete(I);
    end;

  FSglFile := nil;
  ListView1.Items.Count := 0;
  ListView2.Items.Count := 0;
  ListView3.Items.Count := 0;
  ListView1.Items.Count := FSglList.Count;
  if ListView1.Items.Count <> 0 then
  begin
    ListView1.Items.Item[0].Selected := True;
    ListView1.Items.Item[0].Focused := True;
  end;
  ListView1.Repaint;
  ListView2.Repaint;
  ListView3.Repaint;
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.miCloseAllSGLClick(Sender: TObject);
var
  I: Integer;
begin
  ListView1.Items.Count := 0;
  ListView2.Items.Count := 0;
  ListView3.Items.Count := 0;
  for I := FSglList.Count - 1 downto 0 do
  begin
    TSglFile(FSglList[I]).Free;
  end;
  FSglList.Clear;
  Image1.Picture.Bitmap.Handle := 0;
  ListView1.Repaint;
  ListView2.Repaint;
  ListView3.Repaint;
  FSglFile := nil;
  StatusBar1.SimpleText := '就绪';
end;

//------------------------------------------------------------------------------
// ListView1

procedure TFormMain.ListView1Data(Sender: TObject; Item: TListItem);
begin
  if (Item.Index < 0) or (Item.Index >= FSglList.Count) then Exit;
  Item.Caption := IntToStr(Item.Index);
  with TSglFile(FSglList[Item.Index]) do
  begin
    Item.SubItems.Add(ExtractFileName(FileName));
    Item.SubItems.Add(IntToStr(ImageCount));
    Item.SubItems.Add(IntToStr(HeaderInfo.shOffset));
    Item.SubItems.Add(ExtractFilePath(FileName));
  end;
end;

procedure TFormMain.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if (Item = nil) or not Selected then Exit;

  ListView2.Items.Count := 0;
  Image1.Picture.Bitmap.Handle := 0;

  FSglFile := TSglFile(FSglList[ListView1.Selected.Index]);
  ListView2.Items.Count := FSglFile.ImageCount;
  if ListView2.Items.Count <> 0 then
  begin
    ListView2.Items.Item[0].Selected := True;
    ListView2.Items.Item[0].Focused := True;
  end;
  ListView2.Repaint;
end;

//------------------------------------------------------------------------------
// PopupMenu2

procedure TFormMain.PopupMenu2Popup(Sender: TObject);
begin
  miAddSGLImage.Enabled := (FMyImage <> nil) and (ListView2.SelCount <> 0);
  miSaveSGLImage.Enabled := ListView2.SelCount <> 0;
  miSaveSGLImageAsTGA.Enabled := ListView2.SelCount <> 0;
end;

procedure TFormMain.miAddSGLImageClick(Sender: TObject);
var
  I: Integer;
  J: Integer;
  Image: PSglImage;
begin
  if (FMyImage = nil) or (FSglFile = nil) or (ListView2.SelCount = 0) then Exit;

  for J := 0 to FSglFile.FImageCount - 1 do
    if ListView2.Items.Item[J].Selected then
    begin
      Image := FSglFile.Images[J];
      if Image <> nil then
      begin
        SetLength(FMyImage.miFrames, FMyImage.miCount + Image.siFrames);
        for I := 0 to Image.siFrames - 1 do
          with FMyImage.miFrames[FMyImage.miCount] do
          begin
            mfSglFile := FSglFile;
            mfSglImage := J;
            mfSglFrame := I;
            Inc(FMyImage.miCount);
          end;
      end
      else
      begin
        SetLength(FMyImage.miFrames, FMyImage.miCount + 1);
        with FMyImage.miFrames[FMyImage.miCount] do
        begin
          mfSglFile := FSglFile;
          mfSglImage := J;
          mfSglFrame := -1;
          Inc(FMyImage.miCount);
        end;
      end;
    end;

  UpdateListView4;
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.miSaveSGLImageAsTGAClick(Sender: TObject);
var
  I, J, L1, L2: Integer;
  FileName: string;
  S: string;
  Data: PDWord;
  Stream: TFileStream;
begin
  if FSglFile = nil then Exit;
  if ListView2.SelCount = 0 then Exit;

  SaveDialog1.Filter := 'TGA 图形(*.tga)|*.tga|所有文件(*.*)|*.*';
  SaveDialog1.FileName := ExtractFileName(FSglFile.FileName);
  if SaveDialog1.Execute then
  begin
    FileName := SaveDialog1.FileName;
    Data := nil;
    try
      L1 := Length(IntToStr(FSglFile.FImageCount));
      for J := 0 to FSglFile.FImageCount - 1 do
        if ListView2.Items.Item[J].Selected then
        begin
          FSglFile.ImageIndex := J;
          L2 := Length(IntToStr(FSglFile.FrameCount));
          for I := 0 to FSglFile.FrameCount - 1 do
            if FSglFile.Frames[I] <> nil then
              with FSglFile.Frames[I]^ do
              begin
                ReAllocMem(Data, sfHeight * sfWidth * 4);
                ZeroMemory(Data, sfHeight * sfWidth * 4);
                FSglFile.DecodeFrame32(I, PByte(Data), sfWidth * 4);
                S := Format('%s_%.*d_%.*d.tga', [FileName, L1, J, L2, I]);
                StatusBar1.SimpleText := '保存TGA图形：' + S;
                Stream := TFileStream.Create(S, fmCreate);
                try
                  S := Format('"%s" I:%d F:%d X:%d Y:%d W:%d H:%d ', [ExtractFileName(FSglFile.FileName), J, I, sfX, sfY, sfWidth, sfHeight]);
                  TargaBuild32(Stream, Data, sfWidth, sfHeight, S, True);
                finally
                  Stream.Free;
                end;
                Application.ProcessMessages;
              end;
        end;
    finally
      if Data <> nil then FreeMem(Data);
    end;
    SaveDialog1.InitialDir := ExtractFilePath(SaveDialog1.FileName);
  end;
  StatusBar1.SimpleText := '就绪';
  FImageChanged := True;
end;

procedure TFormMain.miSaveSGLImageClick(Sender: TObject);
var
  I, J, L1, L2: Integer;
  BM: TBitmap;
  FileName: string;
  S: string;
begin
  if FSglFile = nil then Exit;
  if ListView2.SelCount = 0 then Exit;

  SaveDialog1.Filter := '位图(*.bmp)|*.bmp|所有文件(*.*)|*.*';
  SaveDialog1.FileName := ExtractFileName(FSglFile.FileName);
  if SaveDialog1.Execute then
  begin
    FileName := SaveDialog1.FileName;
    BM := TBitmap.Create;
    try
      BM.PixelFormat := pf16Bit;
      BM.Canvas.Brush.Color := FBGColor;

      L1 := Length(IntToStr(FSglFile.FImageCount));
      for J := 0 to FSglFile.FImageCount - 1 do
        if ListView2.Items.Item[J].Selected then
        begin
          FSglFile.ImageIndex := J;
          L2 := Length(IntToStr(FSglFile.FrameCount));
          for I := 0 to FSglFile.FrameCount - 1 do
            if FSglFile.Frames[I] <> nil then
              with FSglFile.Frames[I]^ do
              begin
                BM.Handle := 0;
                BM.Canvas.Brush.Color := FBGColor;
                BM.PixelFormat := pf16Bit;
                BM.Width := sfWidth;
                BM.Height := sfHeight;
                FSglFile.DecodeFrame16(I, BM.ScanLine[0], -((sfWidth * 2 + 3) and $FFFFFFFC), FChooseColor);
                S := Format('%s_%.*d_%.*d.bmp', [FileName, L1, J, L2, I]);
                StatusBar1.SimpleText := '保存位图：' + S;
                BM.SaveToFile(S);
                Application.ProcessMessages;
              end;
        end;
    finally
      BM.Free;
    end;
    SaveDialog1.InitialDir := ExtractFilePath(SaveDialog1.FileName);
  end;
  StatusBar1.SimpleText := '就绪';
  FImageChanged := True;
end;

//------------------------------------------------------------------------------
// ListView2

procedure TFormMain.ListView2Data(Sender: TObject; Item: TListItem);
var
  Image: PSglImage;
begin
  if (Item.Index < 0) or (Item.Index >= FSglFile.ImageCount) then Exit;
  Item.Caption := IntToStr(Item.Index);
  Image := FSglFile.Images[Item.Index];
  if Image <> nil then
    with Image^ do
    begin
      Item.SubItems.Add(IntToStr(siUnknown1));
      Item.SubItems.Add(IntToHex(siFormat, 2));
      Item.SubItems.Add(IntToStr(siFrames));
      Item.SubItems.Add(IntToStr(siUnknown2));
      Item.SubItems.Add(IntToHex(FSglFile.ImageOffsets[Item.Index], 8));
    end;
end;

procedure TFormMain.ListView2SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if (Item = nil) or not Selected then Exit;
  if FSglFile = nil then Exit;

  ListView3.Items.Count := 0;
  Image1.Picture.Bitmap.Handle := 0;

  FSglFile.ImageIndex := Item.Index;
  ListView3.Items.Count := FSglFile.FrameCount;
  if ListView3.Items.Count <> 0 then
  begin
    ListView3.Items.Item[0].Selected := True;
    ListView3.Items.Item[0].Focused := True;
  end;
  ListView3.Repaint;
  FImageChanged := False;
end;

//------------------------------------------------------------------------------
// PopupMenu3

procedure TFormMain.PopupMenu3Popup(Sender: TObject);
begin
  miAddSGLFrame.Enabled := (FMyImage <> nil) and (ListView3.SelCount <> 0);
  miSaveSGLFrame.Enabled := ListView3.SelCount <> 0;
  miSaveSGLFrameAsTGA.Enabled := ListView3.SelCount <> 0;
end;

procedure TFormMain.miSaveSGLFrameAsTGAClick(Sender: TObject);
var
  I, L: Integer;
  FileName: string;
  S: string;
  Data: PDWord;
  Stream: TFileStream;
begin
  if FSglFile = nil then Exit;
  if ListView3.SelCount = 0 then Exit;

  SaveDialog1.Filter := 'TGA 图形(*.tga)|*.tga|所有文件(*.*)|*.*';
  SaveDialog1.FileName := ExtractFileName(FSglFile.FileName);
  if SaveDialog1.Execute then
  begin
    FileName := SaveDialog1.FileName;
    Data := nil;
    try
      L := Length(IntToStr(FSglFile.FrameCount));
      for I := 0 to FSglFile.FrameCount - 1 do
        if ListView3.Items.Item[I].Selected then
          if FSglFile.Frames[I] <> nil then
            with FSglFile.Frames[I]^ do
            begin
              ReAllocMem(Data, sfHeight * sfWidth * 4);
              ZeroMemory(Data, sfHeight * sfWidth * 4);
              FSglFile.DecodeFrame32(I, PByte(Data), sfWidth * 4);

              S := Format('%s_%.d_%.*d.tga', [FileName, FSglFile.ImageIndex, L, I]);
              StatusBar1.SimpleText := '保存TGA图形：' + S;
              Stream := TFileStream.Create(S, fmCreate);
              try
                S := Format('"%s" I:%d F:%d X:%d Y:%d W:%d H:%d ', [ExtractFileName(FSglFile.FileName), FSglFile.ImageIndex, I, sfX, sfY, sfWidth, sfHeight]);
                TargaBuild32(Stream, Data, sfWidth, sfHeight, S, True);
              finally
                Stream.Free;
              end;
              Application.ProcessMessages;
            end;
    finally
      if Data <> nil then FreeMem(Data);
    end;
    SaveDialog1.InitialDir := ExtractFilePath(SaveDialog1.FileName);
  end;
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.miAddSGLFrameClick(Sender: TObject);
var
  I: Integer;
begin
  if (FMyImage = nil) or (FSglFile = nil) or (ListView3.SelCount = 0) then Exit;

  SetLength(FMyImage.miFrames, FMyImage.miCount + ListView3.SelCount);
  for I := 0 to FSglFile.FrameCount - 1 do
    if ListView3.Items.Item[I].Selected then
      with FMyImage.miFrames[FMyImage.miCount] do
      begin
        mfSglFile := FSglFile;
        mfSglImage := FSglFile.ImageIndex;
        mfSglFrame := I;
        Inc(FMyImage.miCount);
      end;

  UpdateListView4;
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.miSaveSGLFrameClick(Sender: TObject);
var
  I, L: Integer;
  BM: TBitmap;
  FileName: string;
  S: string;
begin
  if FSglFile = nil then Exit;
  if ListView3.SelCount = 0 then Exit;

  SaveDialog1.Filter := '位图(*.bmp)|*.bmp|所有文件(*.*)|*.*';
  SaveDialog1.FileName := ExtractFileName(FSglFile.FileName);
  if SaveDialog1.Execute then
  begin
    FileName := SaveDialog1.FileName;
    BM := TBitmap.Create;
    try
      BM.PixelFormat := pf16Bit;
      BM.Canvas.Brush.Color := FBGColor;

      L := Length(IntToStr(FSglFile.FrameCount));
      for I := 0 to FSglFile.FrameCount - 1 do
        if ListView3.Items.Item[I].Selected then
          if FSglFile.Frames[I] <> nil then
            with FSglFile.Frames[I]^ do
            begin
              BM.Handle := 0;
              BM.Canvas.Brush.Color := FBGColor;
              BM.PixelFormat := pf16Bit;
              BM.Width := sfWidth;
              BM.Height := sfHeight;
              S := Format('%s_%.d_%.*d.bmp', [FileName, FSglFile.ImageIndex, L, I]);
              StatusBar1.SimpleText := '保存位图：' + S;
              FSglFile.DecodeFrame16(I, BM.ScanLine[0], -((sfWidth * 2 + 3) and $FFFFFFFC), FChooseColor);
              BM.SaveToFile(S);
              Application.ProcessMessages;
            end;
    finally
      BM.Free;
    end;
    SaveDialog1.InitialDir := ExtractFilePath(SaveDialog1.FileName);
  end;
  StatusBar1.SimpleText := '就绪';
end;

//------------------------------------------------------------------------------
// ListView3

procedure TFormMain.ListView3Data(Sender: TObject; Item: TListItem);
begin
  if (Item.Index < 0) or (Item.Index >= FSglFile.FrameCount) then Exit;
  Item.Caption := IntToStr(Item.Index);
  if FSglFile.Frames[Item.Index] <> nil then
    with FSglFile.Frames[Item.Index]^ do
    begin
      Item.SubItems.Add(IntToStr(sfWidth));
      Item.SubItems.Add(IntToStr(sfHeight));
      Item.SubItems.Add(IntToStr(sfX));
      Item.SubItems.Add(IntToStr(sfY));
      Item.SubItems.Add(IntToStr(sfXBlocks));
      Item.SubItems.Add(IntToStr(sfYBlocks));
      Item.SubItems.Add(IntToHex(FSglFile.FrameOffsets[Item.Index], 8));
    end;
end;

procedure TFormMain.ListView3SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if (Item = nil) or not Selected then Exit;
  if FImageChanged then
  begin
    FImageChanged := False;
    ListView2SelectItem(nil, ListView2.Selected, True);
    Exit;
  end;

  Image1.Picture.Bitmap.Handle := 0;
  if FSglFile = nil then Exit;
  ScrollBox1.HorzScrollBar.Position := 0;
  ScrollBox1.VertScrollBar.Position := 0;
  Image1.Left := 0;
  Image1.Top := 0;
  if FSglFile.Frames[Item.Index] <> nil then
    with FSglFile.Frames[Item.Index]^ do
    begin
      Image1.Width := sfWidth;
      Image1.Height := sfHeight;
      Image1.Picture.Bitmap.Canvas.Brush.Color := FBGColor;
      Image1.Picture.Bitmap.PixelFormat := pf16Bit;
      Image1.Picture.Bitmap.Width := sfWidth;
      Image1.Picture.Bitmap.Height := sfHeight;
      if sfHeight > 0 then
      begin
        FSglFile.DecodeFrame16(Item.Index, Image1.Picture.Bitmap.ScanLine[0], -((sfWidth * 2 + 3) and $FFFFFFFC), FChooseColor);
        Image1.Invalidate;
      end;
    end;
end;

//------------------------------------------------------------------------------
// PopupMenu4

procedure TFormMain.PopupMenu4Popup(Sender: TObject);
begin
  miDeleteCImage.Enabled := ListView4.SelCount <> 0;
  miDeleteAllCImage.Enabled := ListView4.Items.Count <> 0;
  miSaveCImageAsBMP.Enabled := ListView4.SelCount <> 0;
  miSaveCImage.Enabled := ListView4.SelCount <> 0;
  miSaveCImageAsTGA.Enabled := ListView4.SelCount <> 0;
  miColoration.Enabled := ListView4.SelCount <> 0;
end;

procedure TFormMain.AddCImage(const ATitle: string);
var
  MyImage: PMyImage;
begin
  New(MyImage);
  FMyImageList.Add(MyImage);
  MyImage.miTitle := ATitle;
  MyImage.miCount := 0;
  MyImage.miColor := clWhite;
  
  Inc(FAddCount);
  ListView4.Items.Count := 0;
  ListView4.Items.Count := FMyImageList.Count;
  if ListView4.Items.Count <> 0 then
  begin
    ListView4.Items.Item[ListView4.Items.Count - 1].Selected := True;
    ListView4.Items.Item[ListView4.Items.Count - 1].Focused := True;
  end;
  ListView4.Repaint;
end;

procedure TFormMain.miAddCImageClick(Sender: TObject);
var
  Title: string;
begin
  Title := '图层' + IntToStr(FAddCount);
  if InputQuery('新建图层', '输入新建图层的标题（随意的）：', Title) then
  begin
    AddCImage(Title);

  end;
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.miDeleteCImageClick(Sender: TObject);
var
  I: Integer;
  MyImage: PMyImage;
begin
  for I := FMyImageList.Count - 1 downto 0 do
    if ListView4.Items.Item[I].Selected then
    begin
      MyImage := PMyImage(FMyImageList[I]);
      Finalize(MyImage^);
      Dispose(MyImage);
      FMyImageList.Delete(I);
    end;
  FMyImage := nil;
  ListView4.Items.Count := 0;
  ListView5.Items.Count := 0;
  ListView4.Items.Count := FMyImageList.Count;
  if ListView4.Items.Count <> 0 then
  begin
    ListView4.Items.Item[0].Selected := True;
    ListView4.Items.Item[0].Focused := True;
  end;
  ListView4.Repaint;
  ListView5.Repaint;
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.miDeleteAllCImageClick(Sender: TObject);
var
  I: Integer;
  MyImage: PMyImage;
begin
  for I := FMyImageList.Count - 1 downto 0 do
  begin
    MyImage := PMyImage(FMyImageList[I]);
    Finalize(MyImage^);
    Dispose(MyImage);
  end;
  FMyImageList.Clear;
  ListView4.Items.Count := 0;
  ListView5.Items.Count := 0;
  ListView4.Repaint;
  ListView5.Repaint;
  FMyImage := nil;
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.ConvertGraphicsToBMP(const FileName: string; Images: PMyImage);
var
  Bitmap: TBitmap;
  I: Integer;
  L: Integer;
  nLeft: Integer;
  nTop: Integer;
  nWidth: Integer;
  nHeight: Integer;
  S: string;
begin
  if (Images = nil) or (Images.miCount < 1) then Exit;

//--------------------------------------
//获取最小宽度和高度
  nLeft := Low(Integer);
  nTop := Low(Integer);
  nWidth := Low(Integer);
  nHeight := Low(Integer);
  for I := 0 to Images.miCount - 1 do
    with Images.miFrames[I] do
      if mfSglFile is TSglFile then
      begin
        mfSglFile.ImageIndex := mfSglImage;

        if mfSglFile.Frames[mfSglFrame] <> nil then
          with mfSglFile.Frames[mfSglFrame]^ do
          begin
            if nLeft < -sfX then
              nLeft := -sfX;
            if nTop < -sfY then
              nTop := -sfY;
            if nWidth < sfWidth + sfX then
              nWidth := sfWidth + sfX;
            if nHeight < sfHeight + sfY then
              nHeight := sfHeight + sfY;
          end;
      end;
  Inc(nWidth, nLeft);
  Inc(nHeight, nTop);
  if (nWidth = 0) or (nHeight = 0) then Exit;
//--------------------------------------
//初始化位图
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf16Bit;
    Bitmap.Canvas.Brush.Color := FBGColor;
    Bitmap.Width := nWidth;
    Bitmap.Height := nHeight;
  //图像解码
    L := Length(IntToStr(Images.miCount));
    for I := 0 to Images.miCount - 1 do
      with Images.miFrames[I] do
        if mfSglFile is TSglFile then
        begin
          S := Format('%s_%.*d.bmp', [FileName, L, I]);
          StatusBar1.SimpleText := '保存位图：' + S;
          Bitmap.Canvas.FillRect(Rect(0, 0, nWidth, nHeight));
          mfSglFile.ImageIndex := mfSglImage;
          if mfSglFile.Frames[mfSglFrame] <> nil then
            with mfSglFile.Frames[mfSglFrame]^ do
              mfSglFile.DecodeFrame16(mfSglFrame, PByte(Integer(Bitmap.ScanLine[nTop + sfY]) +
                (nLeft + sfX) * 2), -((nWidth * 2 + 3) and $FFFFFFFC), Images.miColor);
          Bitmap.SaveToFile(S);
          Application.ProcessMessages;
        end;
  finally
    Bitmap.Free;
  end;
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.ConvertGraphicsToTga(const FileName: string; Images: PMyImage);
var
  I: Integer;
  L: Integer;
  nLeft: Integer;
  nTop: Integer;
  nWidth: Integer;
  nHeight: Integer;
  S: string;
  Data: PDWord;
  Stream: TFileStream;
begin
  if (Images = nil) or (Images.miCount < 1) then Exit;

//--------------------------------------
//获取最小宽度和高度
  nLeft := Low(Integer);
  nTop := Low(Integer);
  nWidth := Low(Integer);
  nHeight := Low(Integer);
  for I := 0 to Images.miCount - 1 do
    with Images.miFrames[I] do
      if mfSglFile is TSglFile then
      begin
        mfSglFile.ImageIndex := mfSglImage;

        if mfSglFile.Frames[mfSglFrame] <> nil then
          with mfSglFile.Frames[mfSglFrame]^ do
          begin
            if nLeft < -sfX then
              nLeft := -sfX;
            if nTop < -sfY then
              nTop := -sfY;
            if nWidth < sfWidth + sfX then
              nWidth := sfWidth + sfX;
            if nHeight < sfHeight + sfY then
              nHeight := sfHeight + sfY;
          end;
      end;
  Inc(nWidth, nLeft);
  Inc(nHeight, nTop);
  if (nWidth = 0) or (nHeight = 0) then Exit;
//--------------------------------------
  GetMem(Data, nHeight * nWidth * 4);
  try
  //图像解码
    L := Length(IntToStr(Images.miCount));
    for I := 0 to Images.miCount - 1 do
      with Images.miFrames[I] do
        if mfSglFile is TSglFile then
        begin
          S := Format('%s_%.*d.tga', [FileName, L, I]);
          StatusBar1.SimpleText := '保存TGA图形：' + S;
          ZeroMemory(Data, nHeight * nWidth * 4);
          mfSglFile.ImageIndex := mfSglImage;
          if mfSglFile.Frames[mfSglFrame] <> nil then
            with mfSglFile.Frames[mfSglFrame]^ do
              mfSglFile.DecodeFrame32(mfSglFrame, PByte(Integer(Data) + (nTop + sfY) * nWidth * 4 + (nLeft + sfX) * 4), nWidth * 4);

          Stream := TFileStream.Create(S, fmCreate);
          try
            S := Format('"%s" I:%d F:%d X:%d Y:%d W:%d H:%d ', ['', 0, I, nLeft, nTop, nWidth, nHeight]);
            TargaBuild32(Stream, Data, nWidth, nHeight, S, True);
          finally
            Stream.Free;
          end;
          Application.ProcessMessages;
        end;
  finally
    FreeMem(Data);
  end;
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.miSaveCImageAsBMPClick(Sender: TObject);
var
  I: Integer;
  Images: PMyImage;
begin
  SaveDialog1.Filter := '位图(*.bmp)|*.bmp|所有文件(*.*)|*.*';
  for I := 0 to FMyImageList.Count - 1 do
    if ListView4.Items.Item[I].Selected then
    begin
      Images := PMyImage(FMyImageList[I]);
      if Images.miCount > 0 then
      begin
        SaveDialog1.FileName := Images.miTitle;
        if SaveDialog1.Execute then
          ConvertGraphicsToBMP(SaveDialog1.FileName, Images);
      end;
    end;
  SaveDialog1.InitialDir := ExtractFilePath(SaveDialog1.FileName);
end;

procedure TFormMain.miColorationClick(Sender: TObject);
var
  I: Integer;
begin
  case ListView4.SelCount of
  0: Exit;
  1:
    begin
      ColorDialog1.Color := PMyImage(FMyImageList[ListView4.Selected.Index])^.miColor;
      if ColorDialog1.Execute then
        PMyImage(FMyImageList[ListView4.Selected.Index])^.miColor := ColorDialog1.Color;
    end;
  else
    ColorDialog1.Color := clWhite;
    if ColorDialog1.Execute then
      for I := 0 to FMyImageList.Count - 1 do
        if ListView4.Items.Item[I].Selected then
          PMyImage(FMyImageList[I])^.miColor := ColorDialog1.Color;
  end;
  
  ListView5SelectItem(nil, ListView3.Selected, True);
end;

procedure TFormMain.miSaveCImageClick(Sender: TObject);
var
  Images: PMyImage;
  Bitmap: TBitmap;
  I: Integer;
  J: Integer;
  L: Integer;
  nLeft: Integer;
  nTop: Integer;
  nWidth: Integer;
  nHeight: Integer;
  nFrames: Integer;
  S: string;
begin
  if ListView4.SelCount = 0 then Exit;

  S := '';
//--------------------------------------
//获取最小宽度和高度
  nFrames := 0;
  nLeft := Low(Integer);
  nTop := Low(Integer);
  nWidth := Low(Integer);
  nHeight := Low(Integer);
  for J := 0 to FMyImageList.Count - 1 do
    if ListView4.Items.Item[J].Selected then
    begin
      Images := PMyImage(FMyImageList[J]);
      if S <> '' then S := Images.miTitle;
      if nFrames < Images.miCount then
        nFrames := Images.miCount;
      for I := 0 to Images.miCount - 1 do
        with Images.miFrames[I] do
          if mfSglFile is TSglFile then
          begin
            mfSglFile.ImageIndex := mfSglImage;

            if mfSglFile.Frames[mfSglFrame] <> nil then
              with mfSglFile.Frames[mfSglFrame]^ do
              begin
                if nLeft < -sfX then
                  nLeft := -sfX;
                if nTop < -sfY then
                  nTop := -sfY;
                if nWidth < sfWidth + sfX then
                  nWidth := sfWidth + sfX;
                if nHeight < sfHeight + sfY then
                  nHeight := sfHeight + sfY;
              end;
          end;
    end;
  Inc(nWidth, nLeft);
  Inc(nHeight, nTop);
  if (nWidth = 0) or (nHeight = 0) then Exit;
//--------------------------------------
  SaveDialog1.FileName := S;
  SaveDialog1.Filter := '位图(*.bmp)|*.bmp|所有文件(*.*)|*.*';
  if not SaveDialog1.Execute then Exit;
  SaveDialog1.InitialDir := ExtractFilePath(SaveDialog1.FileName);
//--------------------------------------
//初始化位图
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf16Bit;
    Bitmap.Canvas.Brush.Color := FBGColor;
    Bitmap.Width := nWidth;
    Bitmap.Height := nHeight;
  //图像解码
    L := Length(IntToStr(nFrames));
    for I := 0 to nFrames - 1 do
    begin
      S := Format('%s_%.*d.bmp', [SaveDialog1.FileName, L, I]);
      Bitmap.Canvas.FillRect(Rect(0, 0, nWidth, nHeight));
      for J := 0 to FMyImageList.Count - 1 do
        if ListView4.Items.Item[J].Selected then
        begin
          Images := PMyImage(FMyImageList[J]);
          if I < Images.miCount then
            with Images.miFrames[I] do
              if mfSglFile is TSglFile then
              begin
                mfSglFile.ImageIndex := mfSglImage;
                if mfSglFile.Frames[mfSglFrame] <> nil then
                  with mfSglFile.Frames[mfSglFrame]^ do
                    mfSglFile.DecodeFrame16(mfSglFrame, PByte(Integer(Bitmap.ScanLine[nTop + sfY]) +
                      (nLeft + sfX) * 2), -((nWidth * 2 + 3) and $FFFFFFFC), Images.miColor);
              end;
        end;
      Bitmap.SaveToFile(S);
    end;
  finally
    Bitmap.Free;
  end;
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.miSaveCImageAsTGAClick(Sender: TObject);
var
  I: Integer;
  Images: PMyImage;
begin
  SaveDialog1.Filter := 'TGA 图形(*.tga)|*.tga|所有文件(*.*)|*.*';
  for I := 0 to FMyImageList.Count - 1 do
    if ListView4.Items.Item[I].Selected then
    begin
      Images := PMyImage(FMyImageList[I]);
      if Images.miCount > 0 then
      begin
        SaveDialog1.FileName := Images.miTitle;
        if SaveDialog1.Execute then
          ConvertGraphicsToTga(SaveDialog1.FileName, Images);
      end;
    end;
  SaveDialog1.InitialDir := ExtractFilePath(SaveDialog1.FileName);
end;

//------------------------------------------------------------------------------
// ListView4

procedure TFormMain.UpdateListView4;
var
  I: Integer;
  J: Integer;
  Images: PMyImage;
begin
  ListView5.Items.Count := 0;
  Image1.Picture.Bitmap.Handle := 0;
//--------------------------------------
//获取最小宽度和高度
  FCFrames := -1;
  FCX := Low(Integer);
  FCY := Low(Integer);
  FCWidth := Low(Integer);
  FCHeight := Low(Integer);
  for J := 0 to FMyImageList.Count - 1 do
    if ListView4.Items.Item[J].Selected then
    begin
      Images := PMyImage(FMyImageList[J]);
      if FCFrames < Images.miCount then
      begin
        FCFrames := Images.miCount;
        FMyImage := Images;
      end;
      for I := 0 to Images.miCount - 1 do
        with Images.miFrames[I] do
          if mfSglFile is TSglFile then
          begin
            mfSglFile.ImageIndex := mfSglImage;

            if mfSglFile.Frames[mfSglFrame] <> nil then
              with mfSglFile.Frames[mfSglFrame]^ do
              begin
                if FCX < -sfX then
                  FCX := -sfX;
                if FCY < -sfY then
                  FCY := -sfY;
                if FCWidth < sfWidth + sfX then
                  FCWidth := sfWidth + sfX;
                if FCHeight < sfHeight + sfY then
                  FCHeight := sfHeight + sfY;
              end;
          end;
    end;
  Inc(FCWidth, FCX);
  Inc(FCHeight, FCY);
//--------------------------------------
  ListView5.Items.Count := FMyImage.miCount;
  if ListView5.Items.Count <> 0 then
  begin
    ListView5.Items.Item[0].Selected := True;
    ListView5.Items.Item[0].Focused := True;
  end;
  ListView5.Repaint;
end;

procedure TFormMain.ListView4Data(Sender: TObject; Item: TListItem);
begin
  if (Item.Index < 0) or (Item.Index >= FMyImageList.Count) then Exit;
  with PMyImage(FMyImageList[Item.Index])^ do
  begin
    Item.Caption := miTitle;
    Item.SubItems.Add(IntToStr(miCount));
    Item.SubItems.Add(IntToStr(Item.Index));
  end;
end;

procedure TFormMain.ListView4DataStateChange(Sender: TObject; StartIndex,
  EndIndex: Integer; OldState, NewState: TItemStates);
begin
  UpdateListView4;
end;

procedure TFormMain.ListView4SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if (Item = nil) or not Selected then Exit;
  UpdateListView4;
end;

procedure TFormMain.ListView4Edited(Sender: TObject; Item: TListItem;
  var S: string);
begin
  if (Item.Index < 0) or (Item.Index >= FMyImageList.Count) then Exit;

  PMyImage(FMyImageList[Item.Index])^.miTitle := S;

end;

procedure TFormMain.ListView4MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Item: TListItem;
begin
  if Button = mbLeft then
  begin
    Item := ListView4.GetItemAt(X, Y);
    if (Item <> nil) then
      if PtInRect(Item.DisplayRect(drSelectBounds), Point(X, Y)) then
      begin
        FMouseDown := True;
        FMouseDownIndex := Item.Index;
        SetCaptureControl(ListView4);
      end;
  end;

end;

procedure TFormMain.ListView4MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  I: Integer;
  J: Integer;
  K: Integer;
  nIndex: Integer;
  R: TRect;
  Item: TListItem;
begin
  if FMouseDown then
  begin
    //自动滚动
    I := ListView4.TopItem.Index + ListView4.VisibleRowCount;
    if (ListView4.TopItem.Index <> 0) or (I < ListView4.Items.Count) then
    begin
      R := ListView4.TopItem.DisplayRect(drBounds);
      if Y < R.Top then
      begin
        ListView4.Scroll(0, R.Top - R.Bottom);
      end
      else
      begin
        R := ListView4.Items.Item[I].DisplayRect(drBounds);
        if Y > R.Bottom then
        begin
          ListView4.Scroll(0, R.Bottom - R.Top);
        end;
      end;
    end;

    //移动项目
    Item := ListView4.GetItemAt(X, Y);
    if (Item <> nil) and (Item.Index <> FMouseDownIndex) then
    begin
      nIndex := Item.Index;
      J := nIndex - FMouseDownIndex;
      if J > 0 then
      begin
        for I := ListView4.Items.Count - 1 downto 0 do
          if ListView4.Items.Item[I].Selected then
          begin
            K := I + J;
            if (K < 0) or (K >= ListView4.Items.Count) then Exit;
            FMyImageList.Move(I, K);
            ListView4.Items.Item[I].Selected := False;
            ListView4.Items.Item[K].Selected := True;
            ListView4.Items.Item[K].Focused := ListView4.Items.Item[I].Focused;
            ListView4.UpdateItems(I, K);
          end;
      end
      else
        for I := 0 to ListView4.Items.Count - 1 do
          if ListView4.Items.Item[I].Selected then
          begin
            K := I + J;
            if (K < 0) or (K >= ListView4.Items.Count) then Exit;
            FMyImageList.Move(I, K);
            ListView4.Items.Item[I].Selected := False;
            ListView4.Items.Item[K].Selected := True;
            ListView4.Items.Item[K].Focused := ListView4.Items.Item[I].Focused;
            ListView4.UpdateItems(I, K);
          end;
      FMouseDownIndex := nIndex;
    end;
  end;
end;

procedure TFormMain.ListView4MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if FMouseDown then
  begin
    FMouseDown := False;
    SetCaptureControl(nil);
  end;
end;

//------------------------------------------------------------------------------
// PopupMenu5

procedure TFormMain.PopupMenu5Popup(Sender: TObject);
begin
  miDeleteImage.Enabled := (FMyImage <> nil) and (FSglFile <> nil);
  miDeleteFrame.Enabled := ListView5.SelCount <> 0;
  miDeleteAllFrame.Enabled := ListView5.Items.Count <> 0;
end;

procedure TFormMain.miDeleteFrameClick(Sender: TObject);
var
  I: Integer;
begin
  if FMyImage = nil then Exit;
  for I := FMyImage.miCount - 1 downto 0 do
    if ListView5.Items.Item[I].Selected then
    begin
      Dec(FMyImage.miCount);
      if I < FMyImage.miCount then
        Move(FMyImage.miFrames[I + 1], FMyImage.miFrames[I],
          (FMyImage.miCount - I) * SizeOf(TMyFrame));
    end;

  SetLength(FMyImage.miFrames, FMyImage.miCount);
  ListView5.Items.Count := 0;
  ListView5.Items.Count := FMyImage.miCount;
  if ListView5.Items.Count <> 0 then
  begin
    ListView5.Items.Item[0].Selected := True;
    ListView5.Items.Item[0].Focused := True;
  end;
  ListView5.Repaint;
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.miDeleteAllFrameClick(Sender: TObject);
begin
  if FMyImage = nil then Exit;
  SetLength(FMyImage.miFrames, 0);
  FMyImage.miCount := 0;
  ListView5.Items.Count := 0;
  ListView5.Repaint;
  StatusBar1.SimpleText := '就绪';
end;

//------------------------------------------------------------------------------
// ListView5

procedure TFormMain.ListView5Data(Sender: TObject; Item: TListItem);
begin
  if FMyImage = nil then Exit;
  if (Item.Index < 0) or (Item.Index >= FMyImage.miCount) then Exit;
  Item.Caption := IntToStr(Item.Index);

  if ListView4.SelCount = 1 then
  begin
    with FMyImage.miFrames[Item.Index] do
      if mfSglFile is TSglFile then
      begin
        mfSglFile.ImageIndex := mfSglImage;

        if mfSglFile.Frames[mfSglFrame] <> nil then
          with mfSglFile.Frames[mfSglFrame]^ do
          begin
            Item.SubItems.Add(IntToStr(sfWidth));
            Item.SubItems.Add(IntToStr(sfHeight));
            Item.SubItems.Add(IntToStr(sfX));
            Item.SubItems.Add(IntToStr(sfY));
            Item.SubItems.Add(IntToStr(sfXBlocks));
            Item.SubItems.Add(IntToStr(sfYBlocks));
            Item.SubItems.Add(IntToHex(mfSglFile.FrameOffsets[mfSglFrame], 8));

            Item.SubItems.Add(mfSglFile.FileName);
            Item.SubItems.Add(IntToStr(mfSglImage));
            Item.SubItems.Add(IntToStr(mfSglFrame));
          end;
      end;
  end
  else
  begin
    Item.SubItems.Add(IntToStr(FCWidth));
    Item.SubItems.Add(IntToStr(FCHeight));
    Item.SubItems.Add(IntToStr(FCX));
    Item.SubItems.Add(IntToStr(FCY));
    Exit;
  end;

end;

procedure TFormMain.ListView5SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
var
  I: Integer;
  Images: PMyImage;
begin
  if (Item = nil) or not Selected then Exit;
  //Image1.Picture.Bitmap.Handle := 0;
  if FMyImage = nil then Exit;
  ScrollBox1.HorzScrollBar.Position := 0;
  ScrollBox1.VertScrollBar.Position := 0;
  Image1.Left := 0;
  Image1.Top := 0;

//--------------------------------------
//初始化位图
  Image1.Width := FCWidth;
  Image1.Height := FCHeight;
  Image1.Picture.Bitmap.PixelFormat := pf16Bit;
  Image1.Picture.Bitmap.Canvas.Brush.Color := FBGColor;
  Image1.Picture.Bitmap.Width := FCWidth;
  Image1.Picture.Bitmap.Height := FCHeight;
  Image1.Picture.Bitmap.Canvas.FillRect(Rect(0, 0, FCWidth, FCHeight));
//图像解码
  for I := 0 to FMyImageList.Count - 1 do
    if ListView4.Items.Item[I].Selected then
    begin
      Images := PMyImage(FMyImageList[I]);
      if Item.Index < Images.miCount then
        with Images.miFrames[Item.Index] do
          if mfSglFile is TSglFile then
          begin
            mfSglFile.ImageIndex := mfSglImage;
            if mfSglFile.Frames[mfSglFrame] <> nil then
              with mfSglFile.Frames[mfSglFrame]^ do
                mfSglFile.DecodeFrame16(mfSglFrame, PByte(Integer(Image1.Picture.Bitmap.ScanLine[FCY + sfY]) +
                  (FCX + sfX) * 2), -((FCWidth * 2 + 3) and $FFFFFFFC), Images.miColor);
          end;
    end;
  Image1.Invalidate;
end;

//------------------------------------------------------------------------------
// PopupMenu6

procedure TFormMain.miCopyImageClick(Sender: TObject);
var
  Format: Word;
  Data: THandle;
  Palette: HPALETTE;
begin
  Palette := 0;
  Image1.Picture.Bitmap.SaveToClipboardFormat(Format, Data, Palette);
  Clipboard.SetAsHandle(Format, Data);
  if Palette <> 0 then Clipboard.SetAsHandle(CF_PALETTE, Palette);
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.miBGColorClick(Sender: TObject);
begin
  ColorDialog1.Color := FBGColor;
  if ColorDialog1.Execute then
  begin
    FBGColor := ColorDialog1.Color;
    Image1.Picture.Bitmap.Canvas.Brush.Color := FBGColor;
    ListView3SelectItem(nil, ListView3.Selected, True);
  end;
  StatusBar1.SimpleText := '就绪';
end;

procedure TFormMain.miChooseColorClick(Sender: TObject);
begin
  ColorDialog1.Color := FChooseColor;
  if ColorDialog1.Execute then
  begin
    FChooseColor := ColorDialog1.Color;
    ListView3SelectItem(nil, ListView3.Selected, True);
  end;
  StatusBar1.SimpleText := '就绪';
end;

//------------------------------------------------------------------------------

procedure TFormMain.miDeleteImageClick(Sender: TObject);
var
  nStart: Integer;
  nEnd: Integer;
  I: Integer;
  J: Integer;
  Image: PSglImage;
begin
  if (FMyImage = nil) or (FSglFile = nil) then Exit;

  if InputQuery('添加帧 - ' + ExtractFileName(FSglFile.FFileName), '输入要添加的范围：', FAddRange) then
  begin
    try
      I := Pos('-', FAddRange);
      nStart := StrToInt(Trim(Copy(FAddRange, 1, I - 1)));
      nEnd := StrToInt(Trim(Copy(FAddRange, I + 1, MaxInt)));
      if (nStart < 0) or (nEnd >= FSglFile.ImageCount) then Exit;

      for J := nStart to nEnd do
      begin
        Image := FSglFile.Images[J];
        if Image <> nil then
        begin
          SetLength(FMyImage.miFrames, FMyImage.miCount + Image.siFrames);
          for I := 0 to Image.siFrames - 1 do
            with FMyImage.miFrames[FMyImage.miCount] do
            begin
              mfSglFile := FSglFile;
              mfSglImage := J;
              mfSglFrame := I;
              Inc(FMyImage.miCount);
            end;
        end
        else
        begin
          SetLength(FMyImage.miFrames, FMyImage.miCount + 1);
          with FMyImage.miFrames[FMyImage.miCount] do
          begin
            mfSglFile := FSglFile;
            mfSglImage := J;
            mfSglFrame := -1;
            Inc(FMyImage.miCount);
          end;
        end;
      end;
    except
    end;
  end;

  UpdateListView4;
  StatusBar1.SimpleText := '就绪';
end;

end.

