SHARE
TWEET

Untitled

a guest Feb 14th, 2018 23 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit SHP;
  2. {
  3.  Started: 2016/08/17
  4.  By: Stuart "Stucuk" Carey
  5. }
  6.  
  7. interface
  8.  
  9. uses Windows, Graphics, Classes;
  10.  
  11.  const
  12.   IMGAREA_X = 0;
  13.   IMGAREA_Y = 1;
  14.   IMGAREA_W = 2;
  15.   IMGAREA_H = 3;
  16.  
  17.  SHPSideCol : Array [0..7] of TRGBTriple = (
  18.  //{GOLD}   (rgbtBlue: 20;rgbtGreen:220;rgbtRed:230;),
  19.  {GOLD}   (rgbtBlue:120;rgbtGreen:214;rgbtRed:245;),
  20.  {RED}    (rgbtBlue:  0;rgbtGreen:  0;rgbtRed:255;),
  21.  {Blue}   (rgbtBlue:233;rgbtGreen: 56;rgbtRed: 12;),
  22.  {Green}  (rgbtBlue:  0;rgbtGreen:200;rgbtRed:  0;),
  23.  {Orange} (rgbtBlue:  0;rgbtGreen:128;rgbtRed:255;),
  24.  {SkyBlue}(rgbtBlue:240;rgbtGreen:202;rgbtRed:166;),
  25.  {Pink}   (rgbtBlue:255;rgbtGreen:  0;rgbtRed:255;),
  26.  {Purple} (rgbtBlue:128;rgbtGreen:  0;rgbtRed:128;)
  27.  );
  28.  
  29.  type
  30.  TImgArea = Array [0..3] of Word;
  31.  
  32.  TSHP_Palette = Array [0..255] of TRGBTriple;
  33.  PSHP_Palette = ^TSHP_Palette;
  34.  
  35.  TSHP_Frame = Packed Record
  36.   UsedArea : TImgArea;   // X,Y,W,H
  37.   PalData  : PByte;      // Holds Image as Palette colours
  38.   RGBData  : PRGBTriple; // Holds Image as RGB colours
  39.   AData    : PByte;      // Holds Image Alpha
  40.   NeedUpd  : Boolean;    // When true RGBData holds an old image
  41.   RadarCol : TRGBQuad;
  42.  end;
  43.  PSHP_Frame = ^TSHP_Frame;
  44.  
  45.  TSHP_Type    = (stAnimation, stBuilding, stIsoSnoBuilding, stIsoTemBuilding, stIsoUrbBuilding, stCameo, stUnit);
  46.  TSHP_PalType = (sptDefault, sptTem, sptSno, sptUrb, sptLun, sptDes, sptNewurb, sptInt, sptWin);
  47.  TSHP_Game    = (sgTD, sgRA1, sgTS, sgRA2);
  48.  
  49.  const
  50.   stIsoBuilding    = [stIsoSnoBuilding,stIsoTemBuilding,stIsoUrbBuilding];
  51.   stBuildings      = [stBuilding] + stIsoBuilding;
  52.   stBuildingorUnit = [stUnit]+stBuildings;
  53.  
  54.  const
  55.  SHP_Type_Str     : Array [0..Ord(stUnit)]  of AnsiString = ('Animation', 'Building', 'Building (IsoSnow)', 'Building (IsoTemperate)', 'Building (IsoUrban)', 'Cameo', 'Unit');
  56.  SHP_Pal_Type_Str : Array [0..Ord(sptWin)]  of AnsiString = ('Default','Temperate', 'Snow', 'Urban', 'Lunar', 'Desert', 'New Urban', 'Interior', 'Winter');
  57.  SHP_Game_Str     : Array [0..Ord(sgRA2)]   of AnsiString = ('Tiberian Dawn', 'Red Alert', 'Tiberian Sun', 'Red Alert 2');
  58.  SHP_GameF_Str    : Array [0..Ord(sgRA2)]   of AnsiString = ('TD', 'RA1', 'TS', 'RA2');
  59.  
  60.  COMPMODE_AUTO = 0;
  61.  COMPMODE_HALF = 1;
  62.  COMPMODE_ALL  = 2;
  63.  COMPMODE_NONE = 3;
  64.  
  65.  TS_FLAG_TRANSPARENT = $1;
  66.  TS_FLAG_COMPRESSION = $2;
  67.  
  68.  type
  69.  TSHP_Header = record
  70.   Zero, Width, Height, Count : Word;
  71.  end;
  72.  
  73.  TSHP_Header_Image = record
  74.   X, Y, W, H  : Word;
  75.   Flags       : Word;
  76.   Unknown     : Word; // Part of Flags? Something else?
  77.   RadarColor  : TRGBTriple;
  78.   Unknown1    : Byte; // Part of Radar Color? Seperate?
  79.   Unknown2,           // ????
  80.   Offset      : Cardinal;
  81.  end;
  82.  
  83.  PSHP_Header_Image = ^TSHP_Header_Image;
  84.  
  85.  TThreeByte = Array [0..2] of Byte;
  86.  
  87. // SHP_RA_File.Pas
  88.  TSHP_Header_TD = record
  89.   Count, X,
  90.   Y,Width,
  91.   Height,
  92.   MaxFrameSize,
  93.   Flags         : Word;
  94.  end;
  95.  
  96.  TSHP_Offset_TD = packed record
  97.   Offset           : TThreeByte;
  98.   Compression      : Byte;
  99.   ReOffset         : TThreeByte;
  100.   CompressionExtra : Byte;        // ?????
  101.  end;
  102.  PSHP_Offset_TD = ^TSHP_Offset_TD;
  103.  // SHP_RA_File.Pas END
  104.  
  105.  TPalExt = Record
  106.   EXT     : AnsiString;
  107.   PalType : TSHP_PalType;
  108.  end;
  109.  
  110.  const
  111.  Pal_EXTS : Array [0..Ord(sptWin)] of TPalExt = ((EXT:'.shp';PalType:sptDefault),(EXT:'.tem';PalType:sptTem),
  112.                                                  (EXT:'.sno';PalType:sptSno),(EXT:'.urb';PalType:sptUrb),
  113.                                                  (EXT:'.lun';PalType:sptLun),(EXT:'.des';PalType:sptDes),
  114.                                                  (EXT:'.ubn';PalType:sptNewurb),(EXT:'.int';PalType:sptInt),
  115.                                                  (EXT:'.win';PalType:sptWin));
  116.  type
  117.  TSHP_Extra_Header = Packed Record
  118.   Ver  : Word;
  119.   ID   : Array [0..5] of Char; // #0EXTRA
  120.  end;
  121.  
  122.  //SHPToolz Extra Data (Saved to the end of SHP's)
  123.  TSHP_Extra = Packed Record
  124.   Palette : TSHP_Palette;
  125.   Game    : Byte;
  126.   _Type   : Byte;
  127.  end;
  128.  
  129.  TSHP_FileType = (sftNone,sftTD,sftTS);
  130.  
  131.  TSHP = Class(TObject)
  132.  protected
  133.   FFilename      : AnsiString;
  134.   FW,FH          : Integer;
  135.   FFrames        : Array of TSHP_Frame;
  136.   FPalette       : TSHP_Palette;
  137.   FPaletteISO    : PSHP_Palette;
  138.   FTransCol      : TRGBTriple;
  139.   FSHPFileType   : TSHP_FileType;
  140.   FGame          : TSHP_Game;
  141.   FType          : TSHP_Type;
  142.   FPalType       : TSHP_PalType;
  143.   FSHPExtra      : Boolean;
  144.   FSaveExtra     : Boolean;
  145.   FOneFrameLoad  : Boolean;    // When enabled it will only load 1 frame. Useful for previewing a file.
  146.   FSideCol       : TRGBTriple;
  147.   FUseSideCol    : Boolean;    // When enabled remappable colours will be generated based on FSideCol
  148.   FKeepHeaders   : Boolean;    // Hangs onto headers instead of freeing them
  149.   FStoredHeaders : Array [0..1] of Pointer;
  150.   FIgnoreFrames  : Boolean;    // Ignores Frame Data when loading. For debugging only.
  151.   FAutoPalette   : AnsiString; // Auto Selected Palette
  152.   FTransparentShadows : Boolean;
  153.   FTD_LoopFrame  : Integer;
  154.   FAmbientLight  : Smallint;
  155.   FForceFlags      : Word;       //Force Flags on Save!
  156.   FCompressionMode : Byte;       //Compression mode to use on Save!
  157.   FSaved           : Boolean;    // TSHP doesn't care about this but an editor would.
  158.   FWasLoaded       : Boolean;    // TSHP doesn't care about this but an editor would. Its only true if its loaded or saved
  159.   procedure Decode3 (Input : TStream; Frame : Integer);
  160.   procedure Decode1 (Input : TStream; Frame : Integer);
  161.   procedure TDRA1Decode(Input : TStream; DecodeFrame,Frame : Integer);
  162.   function  GetFrame(Index : Integer)    : PSHP_Frame;
  163.   function  GetRGBFrame(Index : Integer) : PRGBTriple; virtual;
  164.   function  GetAlphaFrame(Index : Integer) : PByte;
  165.   procedure EmptyFrameRGBA(Index : Integer; Buffer : Pointer);
  166.   procedure EmptyFrameRGB(Index : Integer);
  167.   procedure BuildFrameRGB(Index : Integer);
  168.   function  GetCount() : Integer;
  169.   procedure SetTransCol(Value : TRGBTriple);
  170.   procedure MarkNeedUpd;
  171.  
  172.   procedure ReadExtra(Stream : TStream);
  173.   procedure WriteExtra(Stream : TStream);
  174.  
  175.   function LoadTSSHPFromStream(Stream : TStream) : Boolean;
  176.   function LoadTDRASHPFromStream(Stream : TStream) : Boolean;
  177.  
  178.   procedure GetUsedAreaFrame(Buffer : Pointer; Frame : Integer);
  179.   function GetFrameAverageColour(Frame : Integer) : TRGBTriple;
  180.   procedure SaveTSRA2SHPToStream(Stream : TStream);
  181. //  procedure SaveTDRASHPToStream(Stream : TStream);
  182.  
  183.   function GetRadarCol(Index : Integer) : TColor;
  184.   procedure SetRadarCol(Index : Integer; Value : TColor);
  185.  
  186.   function GetPalette(Index : Integer) : TSHP_Palette;
  187.  
  188.   procedure SetSideCol(Value : TRGBTriple);
  189.   procedure SetUseSideCol(Value : Boolean);
  190.   procedure Clear; virtual;
  191.   procedure FindSHPType(Count : Integer);
  192.   function GetIsTransparent : Boolean;
  193.   procedure SetTransparentShadows(Value : Boolean);
  194.   function ScanFrameForColor(Color : Byte; Frame : Integer) : Boolean;
  195.   procedure IsRA2NotTSUnitCheck;
  196.   function GetISOPalette : TSHP_Palette;
  197.   procedure SetType(Value : TSHP_Type);
  198.   procedure SetAmbientLight(Value : SmallInt);
  199.   procedure GetUsedPaletteColoursForFrame(Frame : Integer; Result : PByte);
  200.  
  201.   procedure SetFrameAmount(Value : Integer); virtual;
  202.  public
  203.   constructor Create;
  204.   destructor Destroy; override;
  205.  
  206.   procedure LoadFromFile(Filename : AnsiString);
  207.   procedure SaveToFile(Filename : AnsiString);
  208.  
  209.   procedure LoadFromStream(Stream : TStream);
  210.   procedure SaveToStream(Stream : TStream);
  211.  
  212.   procedure SetPalette(Palette : TSHP_Palette);
  213.   procedure SetPaletteRGBQ(RGBQ : array of TRGBQuad);
  214.   procedure LoadPalette(Filename : AnsiString);
  215.   procedure LoadPaletteFromDir(Directory : AnsiString);
  216.  
  217.   procedure FreeFrameMem(Index : Integer);
  218.   procedure FreeDebugHeaders;
  219.  
  220.   procedure AddFrames(Amount,Width,Height : Integer);
  221.  
  222.   procedure DrawFrameToBMP(Index : Integer; var BMP : TBitmap); //Helper
  223.   procedure DrawFrameToBMP8(Index : Integer; var BMP : TBitmap; const X,Y : Integer); //Helper
  224.  
  225.   function ShouldDrawShadow : Boolean; //Helper
  226.   function BuildFrameRGBA(Index : Integer) : PRGBQuad; // Helper for getting OpenGL Texture like buffer - NOTE: NOT TESTED!!!
  227.   function GetFramePixel(Frame, X, Y : Integer) : Byte;
  228.  
  229.   procedure UpdateUsedArea(Frame : Integer);
  230.  
  231.   function GetUsedPaletteColours(Frame : Integer) : PByte; // If Frame is -1 it will return colours for all frames. Result is always 256 bytes (Boolean value).
  232.  
  233.   property Frame[Index : Integer]         : PSHP_Frame    read GetFrame;
  234.   property RGBFrame[Index : Integer]      : PRGBTriple    read GetRGBFrame;
  235.   property AlphaFrame[Index : Integer]    : PByte         read GetAlphaFrame;
  236.   property FrameRadarCol[Index : Integer] : TColor        read GetRadarCol         write SetRadarCol;
  237.  
  238.   property Width                          : Integer       read FW;
  239.   property Height                         : Integer       read FH;
  240.   property Count                          : Integer       read GetCount;
  241.  
  242.   property TransparentColour              : TRGBTriple    read FTransCol           write SetTransCol;
  243.   property SHPFileType                    : TSHP_FileType read FSHPFileType;
  244.  
  245.   property Palette[Index : Integer]       : TSHP_Palette  read GetPalette;  //Returns Palette with 0 replaced with FTransCol
  246.   property Palette_True                   : TSHP_Palette  read FPalette;    //Returns True Palette
  247.  
  248.   property Filename                       : AnsiString    read FFilename           write FFilename;
  249.  
  250.   property SHPGame                        : TSHP_Game     read FGame               write FGame;
  251.   property SHPType                        : TSHP_Type     read FType               write SetType;
  252.   property SHPPalType                     : TSHP_PalType  read FPalType            write FPalType;
  253.   property SHPExtra                       : Boolean       read FSHPExtra           write FSHPExtra;
  254.  
  255.   property SideColor                      : TRGBTriple    read FSideCol            write SetSideCol;
  256.   property UseSideColour                  : Boolean       read FUseSideCol         write SetUseSideCol;
  257.  
  258.   property KeepHeaders                    : Boolean       read FKeepHeaders        write FKeepHeaders; // Store Headers
  259.   property Debug_Header0                  : Pointer       read FStoredHeaders[0];               // Main Header
  260.   property Debug_Header1                  : Pointer       read FStoredHeaders[1];               // Frame Header
  261.  
  262.   property IgnoreFrames                   : Boolean       read FIgnoreFrames       write FIgnoreFrames; // Don't load Frame Data (Debug)
  263.  
  264.   property OneFrameLoad                   : Boolean       read FOneFrameLoad       write FOneFrameLoad; // Used for Previewing first Frame
  265.  
  266.   property AutoPalette                    : AnsiString    read FAutoPalette        write FAutoPalette; // Auto Selected Palette
  267.   property IsTransparent                  : Boolean       read GetIsTransparent;                 // Tries to work out based on game/type
  268.  
  269.   property TransparentShadows             : Boolean       read FTransparentShadows write SetTransparentShadows; //Alpha is needed for this to render right
  270.  
  271.   property AmbientLight                   : Smallint      read FAmbientLight       write SetAmbientLight;
  272.  
  273.   property ForceFlags                     : Word          read FForceFlags         write FForceFlags;
  274.   property CompressionMode                : Byte          read FCompressionMode    write FCompressionMode;
  275.  
  276.   property Saved                          : Boolean       read FSaved              write FSaved;
  277.   property WasLoaded                      : Boolean       read FWasLoaded          write FWasLoaded;
  278.  end;
  279.  
  280.  //Helpers
  281.  function SetRGBTriple(R,G,B : Byte) : TRGBTriple;
  282.  function MakeCheckerTileBMP : TBitmap; // Helper for making photoshop style background
  283.  function AddTrailer(Input : AnsiString) : AnsiString;
  284.  function ThreeByteToCardinal(V : TThreeByte) : Cardinal;
  285.  function IsSHPExt(EXT : AnsiString) : Boolean;
  286.  function TripleToQuad(RGB : TRGBTriple) : TRGBQuad;
  287.  function QuadToTriple(RGBQ : TRGBQuad) : TRGBTriple;
  288.  function IsValidSHP(Filename : AnsiString) : Boolean;
  289.  function IsTDSHP(Filename : AnsiString) : Boolean; overload;
  290.  function IsTDSHP(Stream : TStream) : Boolean;      overload;
  291.  function GetSHPFileType(Stream : TStream) : TSHP_FileType;      overload;
  292.  function GetSHPFileType(Filename : AnsiString) : TSHP_FileType; overload;
  293.  function SetArea(X,Y,W,H : Word) : TImgArea;
  294.  //
  295.  
  296.  var
  297.  SHPPalettes     : Array [sgTD..sgRA2,stAnimation..stUnit] of AnsiString;
  298.  SHPPalettesOver : Array [sgTD..sgRA2,sptDefault..sptWin]   of AnsiString;
  299.  SHP_Palette_Directory : AnsiString = '';
  300.  
  301. implementation
  302.  
  303. uses SysUtils, Math;
  304.  
  305. function TripleToQuad(RGB : TRGBTriple) : TRGBQuad;
  306. begin
  307.  Result.rgbRed      := RGB.rgbtRed;
  308.  Result.rgbGreen    := RGB.rgbtGreen;
  309.  Result.rgbBlue     := RGB.rgbtBlue;
  310.  Result.rgbReserved := 255;
  311. end;
  312.  
  313. function QuadToTriple(RGBQ : TRGBQuad) : TRGBTriple;
  314. begin
  315.  Result.rgbtRed   := RGBQ.rgbRed;
  316.  Result.rgbtGreen := RGBQ.rgbGreen;
  317.  Result.rgbtBlue  := RGBQ.rgbBlue;
  318. end;
  319.  
  320. function SetRGBTriple(R,G,B : Byte) : TRGBTriple;
  321. begin
  322.  Result.rgbtRed   := R;
  323.  Result.rgbtGreen := G;
  324.  Result.rgbtBlue  := B;
  325. end;
  326.  
  327. function MakeCheckerTileBMP : TBitmap;
  328. var
  329.  Y : Integer;
  330.  S : Pointer;
  331. begin
  332.  Result := TBitmap.Create;
  333.  Result.Width  := 16;
  334.  Result.Height := 16;
  335.  Result.PixelFormat := pf24bit;
  336.  
  337.  for Y := 0 to 7 do
  338.  begin
  339.   S := Result.ScanLine[Y];
  340.   FillChar(S^,8*3,200);
  341.   Inc(Cardinal(S),8*3);
  342.   FillChar(S^,8*3,250);
  343.  end;
  344.  
  345.  for Y := 8 to 15 do
  346.  begin
  347.   S := Result.ScanLine[Y];
  348.   FillChar(S^,8*3,250);
  349.   Inc(Cardinal(S),8*3);
  350.   FillChar(S^,8*3,200);
  351.  end;
  352. end;
  353.  
  354. function AddTrailer(Input : AnsiString) : AnsiString;
  355. begin
  356.  Result := Input;
  357.  if (Result = '') or (Result[Length(Result)] = '\') then
  358.  Exit;
  359.  
  360.  if Result[Length(Result)] = '/' then
  361.  Result[Length(Result)] := '\'
  362.  else
  363.  Result := Result + '\';
  364. end;
  365.  
  366. function HasFlag(Flag,Value : Word) : Boolean;
  367. begin
  368.  Result := (Flag and Value) > 0;
  369. end;
  370.  
  371. function IsSHPExt(EXT : AnsiString) : Boolean;
  372. var
  373.  X : Integer;
  374. begin
  375.  EXT := Lowercase(EXT);
  376.  for X := 0 to High(Pal_EXTS) do
  377.  if Pal_EXTS[X].EXT = EXT then
  378.  begin
  379.   Result := True;
  380.   Exit;
  381.  end;
  382.  Result := False;
  383. end;
  384.  
  385. function ThreeByteToCardinal(V : TThreeByte) : Cardinal;
  386. begin
  387.  Result := V[0] + V[1] shl 8 + V[2] shl 16;
  388. end;
  389.  
  390. function IsTDSHP(Filename : AnsiString) : Boolean;
  391. var
  392.  Stream  : TStream;
  393. begin
  394.  Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
  395.  Result := IsTDSHP(Stream);
  396.  Stream.Free;
  397. end;
  398.  
  399. function IsTDSHP(Stream : TStream) : Boolean;
  400. var
  401.  Header : TSHP_Header_TD;
  402.  Offset : Array [0..1] of TSHP_Offset_TD;
  403. begin
  404.  Result := False;
  405.  Stream.Position := 0;
  406.  Stream.Read(Header,SizeOf(TSHP_Header_TD));
  407.  
  408.  if (Header.Width = 0) or (Header.Height = 0) or (Header.Count = 0) then Exit;
  409.  
  410.  if Stream.Size-Stream.Position < (Header.Count+2)*SizeOf(TSHP_Offset_TD) then Exit;
  411.  
  412.  Stream.Seek(Header.Count*SizeOf(TSHP_Offset_TD),soFromCurrent);
  413.  Stream.Read(Offset[0],SizeOf(TSHP_Offset_TD)*2);
  414.  
  415.  if (ThreeByteToCardinal(Offset[0].Offset) <> Stream.Size) and (ThreeByteToCardinal(Offset[1].Offset) <> Stream.Size) then Exit;
  416.  
  417.  Result := True;
  418. end;
  419.  
  420. function IsTSSHP(Stream : TStream) : Boolean;
  421. var
  422.  Header : TSHP_Header;
  423. begin
  424.  Result := False;
  425.  Stream.Position := 0;
  426.  Stream.Read(Header,SizeOf(TSHP_Header));
  427.  
  428.  if ((Header.Zero > 0) or (Header.Width = 0) or (Header.Height = 0) or (Header.Count = 0)) and not ((Header.Zero = 0) and (Header.Count = 1)) then
  429.   Exit;
  430.  
  431.  if Stream.Size-Stream.Position < (Header.Count)*SizeOf(TSHP_Header_Image) then Exit;
  432.  
  433.  Result := True;
  434. end;
  435.  
  436. function IsValidSHP(Filename : AnsiString) : Boolean;
  437. var
  438.  Stream  : TStream;
  439. begin
  440.  Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
  441.  Result := IsTDSHP(Stream) or IsTSSHP(Stream);
  442.  Stream.Free;
  443. end;
  444.  
  445. function GetSHPFileType(Stream : TStream) : TSHP_FileType;
  446. begin
  447.  if IsTDSHP(Stream) then
  448.   Result := sftTD
  449.  else
  450.  if IsTSSHP(Stream) then
  451.   Result := sftTS
  452.  else
  453.   Result := sftNone;
  454. end;
  455.  
  456. function GetSHPFileType(Filename : AnsiString) : TSHP_FileType;
  457. var
  458.  Stream  : TStream;
  459. begin
  460.  Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
  461.   Result := GetSHPFileType(Stream);
  462.  Stream.Free;
  463. end;
  464.  
  465. //////////////////////////////////////////////////////////////////////
  466.  
  467. constructor TSHP.Create;
  468. var
  469.  X : Integer;
  470.  C : Byte;
  471. begin
  472.  Inherited;
  473.  SetFrameAmount(0);
  474.  
  475.  // Make Black and White Palette as fallback!
  476.  for X := 0 to 254 do
  477.  begin
  478.   C := Trunc(X/254*255);
  479.   FPalette[X+1] := SetRGBTriple(C,C,C);
  480.  end;
  481.  
  482.  FTransCol     := SetRGBTriple(1,2,255);
  483.  FPalette[0]   := FTransCol;
  484.  FSaveExtra    := False;//True;
  485.  FOneFrameLoad := False;
  486.  FSideCol      := SetRGBTriple(255,0,0);
  487.  FUseSideCol   := False;
  488.  
  489.  FKeepHeaders  := False;
  490.  ZeroMemory(@FStoredHeaders,SizeOf(Pointer)*2);
  491.  FIgnoreFrames := False;
  492.  TransparentShadows := False;
  493.  
  494.  FFilename        := 'unknown.shp';
  495.  FAutoPalette     := '';
  496.  
  497.  FPalType         := sptDefault;
  498.  FPaletteISO      := Nil;
  499.  
  500.  FAmbientLight    := 0;
  501.  FForceFlags      := 0;
  502.  FCompressionMode := 0;
  503.  FSaved           := False;
  504.  FWasLoaded       := False;
  505. end;
  506.  
  507. procedure TSHP.FreeDebugHeaders;
  508. begin
  509.  if Assigned(FStoredHeaders[0]) then
  510.  begin
  511.   FreeMem(FStoredHeaders[0]);
  512.   FStoredHeaders[0] := Nil;
  513.  end;
  514.  if Assigned(FStoredHeaders[1]) then
  515.  begin
  516.   FreeMem(FStoredHeaders[1]);
  517.   FStoredHeaders[1] := Nil;
  518.  end;
  519. end;
  520.  
  521. procedure TSHP.Clear;
  522. var
  523.  X : Integer;
  524. begin
  525.  for X := 0 to High(FFrames) do
  526.  begin
  527.   FreeMem(FFrames[X].PalData);
  528.   FreeMem(FFrames[X].RGBData);
  529.   FreeMem(FFrames[X].AData);
  530.  end;
  531.  
  532.  SetFrameAmount(0);
  533.  
  534.  if Assigned(FPaletteISO) then
  535.  begin
  536.   FreeMem(FPaletteISO);
  537.   FPaletteISO := Nil;
  538.  end;
  539.  
  540.  FreeDebugHeaders;
  541. end;
  542.  
  543. destructor TSHP.Destroy;
  544. begin
  545.  Inherited;
  546.  
  547.  Clear;
  548. end;
  549.  
  550. procedure TSHP.SetTransCol(Value : TRGBTriple);
  551. begin
  552.  FTransCol   := Value;
  553.  
  554.  MarkNeedUpd;
  555. end;
  556.  
  557. function GetPalType(EXT : AnsiString) : TSHP_PalType;
  558. var
  559.  X : Integer;
  560. begin
  561.  for X := 0 to Ord(sptWin) do
  562.  if EXT = Pal_EXTS[X].EXT then
  563.  begin
  564.   Result := Pal_EXTS[X].PalType;
  565.   Exit;
  566.  end;
  567.  
  568.  Result := sptDefault;
  569. end;
  570.  
  571. procedure TSHP.LoadFromFile(Filename : AnsiString);
  572. var
  573.  Stream : TStream;
  574. begin
  575.  Clear;
  576.  
  577.  FPalType := GetPalType(ExtractFileExt(Filename));
  578.  
  579.  Stream := TFileStream.Create(Filename,fmOpenRead or fmShareDenyWrite);
  580.   FFilename := Filename;
  581.   LoadFromStream(Stream);
  582.  Stream.Free;
  583. end;
  584.  
  585. procedure TSHP.SaveToFile(Filename : AnsiString);
  586. var
  587.  Stream : TStream;
  588. begin
  589.  FFilename := Filename;
  590.  
  591.  Stream := TFileStream.Create(Filename,fmCreate);
  592.   SaveToStream(Stream);
  593.  Stream.Free;
  594. end;
  595.  
  596. function SetArea(X,Y,W,H : Word) : TImgArea;
  597. begin
  598.  Result[0] := X;
  599.  Result[1] := Y;
  600.  Result[2] := W;
  601.  Result[3] := H;
  602. end;
  603.  
  604. function TSHP.GetFrame(Index : Integer) : PSHP_Frame;
  605. begin
  606.  Result := @FFrames[Index];
  607. end;
  608.  
  609. function TSHP.GetRadarCol(Index : Integer) : TColor;
  610. begin
  611.  Result := TColor(RGB(FFrames[Index].RadarCol.rgbRed,FFrames[Index].RadarCol.rgbGreen,FFrames[Index].RadarCol.rgbBlue));
  612. end;
  613.  
  614. procedure TSHP.SetRadarCol(Index : Integer; Value : TColor);
  615. begin
  616.  FFrames[Index].RadarCol.rgbRed   := GetRValue(Value);
  617.  FFrames[Index].RadarCol.rgbGreen := GetRValue(Value);
  618.  FFrames[Index].RadarCol.rgbBlue  := GetRValue(Value);
  619.  FFrames[Index].RadarCol.rgbReserved := 0;
  620. end;
  621.  
  622. function TSHP.GetRGBFrame(Index : Integer) : PRGBTriple;
  623. begin
  624.  BuildFrameRGB(Index);
  625.  
  626.  Result := FFrames[Index].RGBData;
  627. end;
  628.  
  629. function TSHP.GetAlphaFrame(Index : Integer) : PByte;
  630. begin
  631.  BuildFrameRGB(Index);
  632.  
  633.  Result := FFrames[Index].AData;
  634. end;
  635.  
  636. procedure TSHP.FreeFrameMem(Index : Integer);
  637. begin
  638.  if (Index < 0) or (Index > High(FFrames)) then Exit;
  639.  
  640.  if Assigned(FFrames[Index].AData) then
  641.  begin
  642.   FreeMem(FFrames[Index].AData);
  643.   FFrames[Index].AData := Nil;
  644.  end;
  645.  if Assigned(FFrames[Index].RGBData) then
  646.  begin
  647.   FreeMem(FFrames[Index].RGBData);
  648.   FFrames[Index].RGBData := Nil;
  649.  end;
  650. end;
  651.  
  652. function MakeBlankLineRaw(Input : Pointer; L,Size : Integer) : Pointer;
  653. var
  654.  X : Integer;
  655.  T : Pointer;
  656. begin
  657.  GetMem(Result,L*Size);
  658.  T := Result;
  659.  for X := 0 to L-1 do
  660.  begin
  661.   CopyMemory(T,Input,Size);
  662.   Inc(Cardinal(T),Size);
  663.  end;
  664. end;
  665.  
  666. function MakeBlankLine(Color : TRGBTriple; L : Integer) : PRGBTriple;
  667. begin
  668.  Result := MakeBlankLineRaw(@Color,L,3);
  669. end;
  670.  
  671. procedure EmptyFrameBuffer(Buffer,Line : Pointer; W,H,Size : Integer);
  672. var
  673.  T : Pointer;
  674.  Y : Integer;
  675. begin
  676.  T := Buffer;
  677.  for Y := 0 to H-1 do
  678.  begin
  679.   CopyMemory(T,Line,W*Size);
  680.   Inc(Cardinal(T),W*Size);
  681.  end;
  682. end;
  683.  
  684. procedure TSHP.EmptyFrameRGB(Index : Integer);
  685. var
  686.  Blank : PRGBTriple;
  687. begin
  688.  if not Assigned(FFrames[Index].AData) then
  689.  GetMem(FFrames[Index].AData,FW*FH);
  690.  ZeroMemory(FFrames[Index].AData,FW*FH);
  691.  
  692.  FFrames[Index].NeedUpd := False;
  693.  
  694.  Blank := MakeBlankLine(FTransCol,FW);
  695.   EmptyFrameBuffer(FFrames[Index].RGBData,Blank,FW,FH,3);
  696.  FreeMem(Blank);
  697. end;
  698.  
  699. function MakeBlankLineRGBA(Color : TRGBTriple; L : Integer) : PRGBQuad;
  700. var
  701.  C : TRGBQuad;
  702. begin
  703.  C.rgbRed      := Color.rgbtRed;
  704.  C.rgbGreen    := Color.rgbtGreen;
  705.  C.rgbBlue     := Color.rgbtBlue;
  706.  C.rgbReserved := 0;
  707.  
  708.  Result := MakeBlankLineRaw(@C,L,4);
  709. end;
  710.  
  711. procedure TSHP.EmptyFrameRGBA(Index : Integer; Buffer : Pointer);
  712. var
  713.  Blank : PRGBQuad;
  714. begin
  715.  Blank := MakeBlankLineRGBA(FTransCol,FW);
  716.   EmptyFrameBuffer(Buffer,Blank,FW,FH,4);
  717.  FreeMem(Blank);
  718. end;
  719.  
  720. function LS(Data : Pointer; Y : Integer; Area : TImgArea; W : Integer; Bytes : Byte = 1) : Pointer;
  721. begin
  722.  Result := Pointer(Cardinal(Data) + ((Y+Area[IMGAREA_Y])*W+Area[IMGAREA_X])*Bytes);
  723. end;
  724.  
  725. function RGBLineStart(Data : Pointer; Y : Integer; Area : TImgArea; W : Integer) : Pointer;
  726. begin
  727.  Result := LS(Data,Y,Area,W,3);
  728. end;
  729.  
  730. function RGBALineStart(Data : Pointer; Y : Integer; Area : TImgArea; W : Integer) : Pointer;
  731. begin
  732.  Result := LS(Data,Y,Area,W,4);
  733. end;
  734.  
  735. function PALLineStart(Data : Pointer; Y : Integer; Area : TImgArea; W : Integer) : Pointer;
  736. begin
  737.  Result := LS(Data,Y,Area,W,1);
  738. end;
  739.  
  740. procedure TSHP.BuildFrameRGB(Index : Integer);
  741. const
  742.  ShadowPal : Array [sgTD..sgRA2] of Byte = (4,4,0,0);
  743.  ShadowCol : TRGBTriple = (rgbtBlue : 0; rgbtGreen : 0; rgbtRed : 0;);
  744. var
  745.  RGB : PRGBTriple;
  746.  PAL : PByte;
  747.  AD  : PByte;
  748.  X,Y : Integer;
  749.  SP : Byte;
  750.  TempPal : TSHP_Palette;
  751.  isShadowFrame : Boolean;
  752. begin
  753.  if (not FFrames[Index].NeedUpd and Assigned(FFrames[Index].RGBData)) then
  754.  Exit;
  755.  
  756.  if (FW = 0) or (FH = 0) then Exit;
  757.  
  758.  if not Assigned(FFrames[Index].RGBData) then
  759.  GetMem(FFrames[Index].RGBData,FW*FH*3);
  760.  
  761.  EmptyFrameRGB(Index);
  762.  
  763.  isShadowFrame := (FGame in [sgTS,sgRA2]) and (FType in stBuildingOrUnit) and (Index > 0) and (Index >= Count div 2);
  764.  
  765.  SP := 0;
  766.  
  767.  if FTransparentShadows then
  768.  if (FGame in [sgTD,sgRA1]) or (isShadowFrame) then
  769.    SP := ShadowPal[FGame];
  770.  
  771.  TempPal := Palette[Index]; //Palette rather than FPalette as we want FTransCol to be Palette[0]
  772.  
  773.  for Y := 0 to FFrames[Index].UsedArea[IMGAREA_H]-1 do
  774.  begin
  775.   RGB := RGBLineStart(FFrames[Index].RGBData,Y,FFrames[Index].UsedArea,FW);
  776.   PAL := PALLineStart(FFrames[Index].PalData,Y,FFrames[Index].UsedArea,FW);
  777.   AD  := PALLineStart(FFrames[Index].AData,Y,FFrames[Index].UsedArea,FW);
  778.   for X := 0 to FFrames[Index].UsedArea[IMGAREA_W]-1 do
  779.   begin
  780.    RGB^ := TempPal[PAL^];
  781.    if isShadowFrame then
  782.    begin
  783.     if (PAL^ > 0) then
  784.     if FTransparentShadows then
  785.     begin
  786.      RGB^ := ShadowCol;
  787.      AD^  := 127;
  788.     end
  789.     else
  790.     AD^  := 255;
  791.    end
  792.    else
  793.    begin
  794.     if (PAL^ > 0) then
  795.     begin
  796.      if (SP > 0) and (PAL^ = SP) then// ((PAL^ in [1,4,12]{SP}){ or (PAL^ = 1)}) then
  797.      begin
  798.       RGB^ := ShadowCol;
  799.       AD^  := 127;//+(PAL^*6);
  800.      end
  801.      else
  802.      AD^ := 255;
  803.     end
  804.     else
  805.     if not IsTransparent then
  806.      AD^ := 255;
  807.    end;
  808.  
  809.    Inc(Cardinal(RGB),3);
  810.    Inc(Cardinal(PAL),1);
  811.    Inc(Cardinal(AD),1);
  812.   end;
  813.  end;
  814. end;
  815.  
  816. function TSHP.BuildFrameRGBA(Index : Integer) : PRGBQuad; //NOT TESTED!!! Needs to be updated to match RGB version!
  817. const
  818.  ShadowPal : Array [sgTD..sgRA2] of Byte = (4,4,1,12);
  819.  ShadowCol : TRGBTriple = (rgbtBlue : 0; rgbtGreen : 0; rgbtRed : 0;);
  820. var
  821.  RGBA : Pointer;
  822.  PAL  : PByte;
  823.  X,Y  : Integer;
  824.  SP   : Byte;
  825.  Sha  : Boolean;
  826.  TempPal : TSHP_Palette;
  827. begin
  828.  Result := Nil;
  829.  if (FW = 0) or (FH = 0) then Exit;
  830.  
  831.  GetMem(Result,FW*FH*4);
  832.  
  833.  EmptyFrameRGBA(Index,Result);
  834.  
  835.  SP := 0;
  836.  
  837.  if FTransparentShadows then
  838.  if (FType in stBuildingorUnit) then// if (FGame in [sgRA1,sgTS,sgRA2]) then
  839.  begin
  840.   if (FType = stUnit) or (FGame in [sgTD,sgRA1]) then
  841.    SP := ShadowPal[FGame]
  842.   else
  843.    SP := 1;
  844.  end;
  845.  
  846.  Sha     := False;
  847.  TempPal := Palette[Index]; //Palette rather than FPalette as we want FTransCol to be Palette[0]
  848.  
  849.  for Y := 0 to FFrames[Index].UsedArea[IMGAREA_H]-1 do
  850.  begin
  851.   RGBA := RGBALineStart(Result,Y,FFrames[Index].UsedArea,FW);
  852.   PAL  := PALLineStart(FFrames[Index].PalData,Y,FFrames[Index].UsedArea,FW);
  853.   for X := 0 to FFrames[Index].UsedArea[IMGAREA_W]-1 do
  854.   begin
  855.    if (PAL^ > 0) then
  856.    begin
  857.     if (SP > 0) and ((PAL^ = SP) or (PAL^ = 1)) then
  858.     begin
  859.      PByte(RGBA)^ := 127;
  860.      Sha := True;
  861.     end
  862.     else
  863.      PByte(RGBA)^ := 255;
  864.    end
  865.    else
  866.    if not IsTransparent then
  867.     PByte(RGBA)^ := 255;
  868.  
  869.    Inc(Cardinal(RGBA),1);
  870.    if Sha then
  871.    begin
  872.     PRGBTriple(RGBA)^ := ShadowCol;
  873.     Sha := False;
  874.    end
  875.    else
  876.     PRGBTriple(RGBA)^ := TempPal[PAL^];
  877.  
  878.    Inc(Cardinal(RGBA),3);
  879.    Inc(Cardinal(PAL),1);
  880.   end;
  881.  end;
  882. end;
  883.  
  884. //Based on Decode3 from SHP_File.Pas
  885. procedure TSHP.Decode3(Input : TStream; Frame : Integer);
  886. var
  887.  Output : Pointer;
  888.  Count  : Word;
  889.  V      : Byte;
  890.  Y      : Integer;
  891. begin
  892.  try
  893.   for Y := 0 to FFrames[Frame].UsedArea[IMGAREA_H]-1 do
  894.   begin
  895.    Output := PALLineStart(FFrames[Frame].PalData,Y,FFrames[Frame].UsedArea,FW);
  896.    Input.Read(Count,2);
  897.    Dec(Count,2);
  898.    while Count > 0 do
  899.    begin
  900.     Dec(Count);
  901.     Input.Read(V,1);
  902.     if V <> 0 then
  903.     begin
  904.      Byte(Output^) := V;
  905.      Inc(Cardinal(Output),1);
  906.     end
  907.     else
  908.     begin
  909.      Dec(Count);
  910.      Input.Read(V,1);
  911.      Inc(Cardinal(Output),V);
  912.     end;
  913.    end;
  914.   end;
  915.  except
  916.  end;
  917. end;
  918.  
  919. procedure TSHP.Decode1(Input : TStream; Frame : Integer);
  920. var
  921.  Y : Integer;
  922. begin
  923.  try
  924.   for Y := 0 to FFrames[Frame].UsedArea[IMGAREA_H]-1 do
  925.    Input.Read(PALLineStart(FFrames[Frame].PalData,Y,FFrames[Frame].UsedArea,FW)^,FFrames[Frame].UsedArea[IMGAREA_W]);
  926.  except
  927.  
  928.  end;
  929. end;
  930.  
  931. const
  932.  EXTRA_VER = 0;
  933.  
  934. procedure TSHP.ReadExtra(Stream : TStream);
  935. var
  936.  Header : TSHP_Extra_Header;
  937.  Extra  : TSHP_Extra;
  938. begin
  939.  Stream.Seek(-SizeOf(TSHP_Extra_Header),soFromEnd);
  940.  Stream.Read(Header,SizeOf(TSHP_Extra_Header));
  941.  if not ((Header.ID[0] = #0) and (Header.ID[1] = 'E') and (Header.ID[2] = 'X') and (Header.ID[3] = 'T') and (Header.ID[4] = 'R') and (Header.ID[5] = 'A')) then Exit;
  942.  
  943.  //Note: Previous version headers should NEVER change, Versions should add extra headers.
  944.  //      Thus always forwards compatible (Opening with older app).
  945.  
  946.  Stream.Seek(-(SizeOf(TSHP_Extra_Header)+SizeOf(TSHP_Extra)),soFromEnd);
  947.  Stream.Read(Extra,SizeOf(TSHP_Extra));
  948.  
  949.  FGame    := TSHP_Game(Extra.Game);
  950.  FType    := TSHP_Type(Extra._Type);
  951.  SetPalette(Extra.Palette);
  952.  FSHPExtra := True;
  953. end;
  954.  
  955. procedure TSHP.WriteExtra(Stream : TStream);
  956. var
  957.  Header : TSHP_Extra_Header;
  958.  Extra  : TSHP_Extra;
  959. begin
  960.  if not FSaveExtra then Exit;
  961.  
  962.  Stream.Seek(0,soFromEnd);
  963.  
  964.  Extra.Game    := Ord(FGame);
  965.  Extra._Type   := Ord(FType);
  966.  Extra.Palette := FPalette;
  967.  
  968.  Stream.Write(Extra,SizeOf(TSHP_Extra));
  969.  
  970.  Header.ID[0] := #0;
  971.  Header.ID[1] := 'E';
  972.  Header.ID[2] := 'X';
  973.  Header.ID[3] := 'T';
  974.  Header.ID[4] := 'R';
  975.  Header.ID[5] := 'A';
  976.  Header.Ver   := EXTRA_VER;
  977.  
  978.  Stream.Write(Header,SizeOf(TSHP_Extra_Header));
  979.  FSHPExtra := True;
  980. end;
  981.  
  982. function TSHP.LoadTSSHPFromStream(Stream : TStream) : Boolean;
  983. var
  984.  Header        : TSHP_Header;
  985.  Image_Header,
  986.  Image_Headers : PSHP_Header_Image;
  987.  X             : Integer;
  988.  Mem           : TMemoryStream;
  989.  MemStart      : Int64;
  990.  C             : Integer;
  991. begin
  992.  Stream.Read(Header,SizeOf(TSHP_Header));
  993.  if (Header.Zero <> 0) or (Header.Width = 0) or (Header.Height = 0) or (Header.Count = 0) then
  994.  begin
  995.   if (Header.Zero = 0) and (Header.Count = 1) then //Special Case for TS's Null.shp
  996.   begin
  997.    Result := True;
  998.    FW     := 0;
  999.    FH     := 0;
  1000.    SetFrameAmount(1);
  1001.   end
  1002.   else
  1003.    Result := False;
  1004.   Exit;
  1005.  end;
  1006.  
  1007.  FGame := sgTS;
  1008.  
  1009.  FW := Header.Width;
  1010.  FH := Header.Height;
  1011.  
  1012.  C := Header.Count;
  1013.  
  1014.  if FOneFrameLoad then
  1015.  begin
  1016.   FindSHPType(Header.Count);
  1017.   if ((FType = stAnimation) and (Header.Count mod 2 = 0)) or ((FType in stBuildingOrUnit) and (FGame in [sgTS,sgRA2])) then // Load 2 Frames if we are an Animation so far so we can check for shadows
  1018.    Header.Count := 2
  1019.   else
  1020.   begin
  1021.    Header.Count := 1;
  1022.    C            := Header.Count;
  1023.   end;
  1024.  end;
  1025.  
  1026.  SetFrameAmount(Header.Count);
  1027.  GetMem(Image_Headers,SizeOf(TSHP_Header_Image)*C);
  1028.  Stream.Read(Image_Headers^,SizeOf(TSHP_Header_Image)*C);
  1029.  
  1030.  MemStart := Stream.Position;
  1031.  //Load the rest of the file in a MemoryStream to reduce overheads
  1032.  Mem := TMemoryStream.Create;
  1033.  Mem.CopyFrom(Stream,Stream.Size-Stream.Position);
  1034.  Mem.Position := 0;
  1035.  
  1036.  if not FOneFrameLoad then
  1037.  if Image_Headers^.Offset <> MemStart then
  1038.  asm nop end;
  1039.  
  1040.  Image_Header := Image_Headers;
  1041.  for X := 0 to Header.Count-1 do
  1042.  begin
  1043.   if FOneFrameLoad and (C <> Header.Count) and (X = 1) then
  1044.   begin
  1045.    Image_Header := Image_Headers;
  1046.    Inc(Cardinal(Image_Header),SizeOf(TSHP_Header_Image)*(C div 2)); // Load the first shadow frame (Assuming it is one)
  1047.   end;
  1048.  
  1049.   FFrames[X].PalData  := Nil;
  1050.   FFrames[X].RGBData  := Nil;
  1051.   FFrames[X].AData    := Nil;
  1052.   FFrames[X].NeedUpd  := True;
  1053.   FFrames[X].UsedArea := SetArea(0,0,0,0);
  1054.  
  1055.   if Image_Header^.offset <> 0 then
  1056.   begin
  1057.    FFrames[X].UsedArea := SetArea(Image_Header^.X,Image_Header^.Y,Image_Header^.W,Image_Header^.H);
  1058.    FFrames[X].RadarCol.rgbRed      := Image_Header^.RadarColor.rgbtRed;
  1059.    FFrames[X].RadarCol.rgbGreen    := Image_Header^.RadarColor.rgbtGreen;
  1060.    FFrames[X].RadarCol.rgbBlue     := Image_Header^.RadarColor.rgbtBlue;
  1061.    FFrames[X].RadarCol.rgbReserved := Image_Header^.Unknown1;
  1062.    GetMem(FFrames[X].PalData,FW*FH);
  1063.    ZeroMemory(FFrames[X].PalData,FW*FH);
  1064.  
  1065.  
  1066.    Mem.Seek(Image_Header^.offset-MemStart,soFromBeginning);
  1067.    if not FIgnoreFrames then
  1068.    if (Image_Header^.Flags and TS_FLAG_COMPRESSION) > 0 then
  1069.    Decode3(Mem,X)
  1070.    else
  1071.    Decode1(Mem,X);
  1072.   end;
  1073.  
  1074.   Inc(Cardinal(Image_Header),SizeOf(TSHP_Header_Image));
  1075.  end;
  1076.  
  1077.  if FKeepHeaders then
  1078.  begin
  1079.   GetMem(FStoredHeaders[0],SizeOf(TSHP_Header));
  1080.   CopyMemory(FStoredHeaders[0],@Header,SizeOf(TSHP_Header));
  1081.   FStoredHeaders[1] := Image_Headers;
  1082.  end
  1083.  else
  1084.  FreeMem(Image_Headers);
  1085.  
  1086.  ReadExtra(Stream);
  1087.  
  1088.  Mem.Free;
  1089.  Result := True;
  1090. end;
  1091.  
  1092. // read_w from SHP_RA_Code.Pas
  1093. function read_w(var Source: PByte): word;
  1094. begin
  1095.    Result := word(PWord(Source)^);
  1096.    Inc(Source, 2);
  1097. end;
  1098.  
  1099. var
  1100.  DecodeError : Boolean = False;
  1101.  
  1102. // decode80d from SHP_RA_Code.Pas
  1103. function decode80d(const image_in: PByte; var image_out: PByte; const maxsize : Integer): integer;
  1104. var
  1105.    copyp, readp, writep: PByte;
  1106.    code, Counter: integer;
  1107.    Max : Integer;
  1108. begin
  1109.    Max := maxsize;
  1110.    readp  := image_in;
  1111.    writep := image_out;
  1112.    DecodeError := False;
  1113.    while (True) do
  1114.    begin
  1115.       if DecodeError then Break;
  1116.       code := readp^;
  1117.       Inc(readp);
  1118.       if ((not code) and $80) <> 0 then
  1119.       begin
  1120.          //bit 7 = 0
  1121.          //command 0 (0cccpppp p): copy
  1122.          Counter := (code shr 4) + 3;
  1123.          integer(copyp) := integer(writep) - (((code and $f) shl 8) + readp^);
  1124.          Inc(readp);
  1125.          while (Counter <> 0) do
  1126.          begin
  1127.             Dec(Counter);
  1128.             writep^ := copyp^;
  1129.             Inc(writep);
  1130.             Inc(copyp);
  1131.             Dec(max);
  1132.             if Max = 0 then
  1133.                   begin
  1134.                    DecodeError := True;
  1135.                    Break;
  1136.                   end;
  1137.          end;
  1138.       end
  1139.       else
  1140.       begin
  1141.          //bit 7 = 1
  1142.          Counter := code and $3f;
  1143.          if ((not code) and $40) <> 0 then
  1144.          begin
  1145.             //bit 6 = 0
  1146.             if (Counter = 0) then
  1147.                //end of image
  1148.                break;
  1149.             //command 1 (10cccccc): copy
  1150.             while (Counter <> 0) do
  1151.             begin
  1152.                Dec(Counter);
  1153.                writep^ := readp^;
  1154.                Inc(writep);
  1155.                Inc(readp);
  1156.                Dec(max);
  1157.                if Max = 0 then
  1158.                   begin
  1159.                    DecodeError := True;
  1160.                    Break;
  1161.                   end;
  1162.             end;
  1163.          end
  1164.          else
  1165.          begin
  1166.             //bit 6 = 1
  1167.             if (Counter < $3e) then
  1168.             begin
  1169.                //command 2 (11cccccc p p): copy
  1170.                Inc(Counter, 3);
  1171.                copyp := image_out;
  1172.                Inc(copyp, read_w(readp));
  1173.                while (Counter <> 0) do
  1174.                begin
  1175.                   Dec(Counter);
  1176.                   writep^ := copyp^;
  1177.                   Inc(writep);
  1178.                   Inc(copyp);
  1179.                   Dec(max);
  1180.                   if Max = 0 then
  1181.                   begin
  1182.                    DecodeError := True;
  1183.                    Break;
  1184.                   end;
  1185.                end;
  1186.             end
  1187.             else
  1188.             if (Counter = $3e) then
  1189.             begin
  1190.                //command 3 (11111110 c c v): fill
  1191.                Counter := read_w(readp);
  1192.                code    := readp^;
  1193.                Inc(readp);
  1194.                while (Counter <> 0) do
  1195.                begin
  1196.                   Dec(Counter);
  1197.                   writep^ := byte(code);
  1198.                   Inc(writep);
  1199.                   Dec(max);
  1200.                   if Max = 0 then
  1201.                   begin
  1202.                    DecodeError := True;
  1203.                    Break;
  1204.                   end;
  1205.                end;
  1206.             end
  1207.             else
  1208.             begin
  1209.                //command 4 (copy 11111111 c c p p): copy
  1210.                Counter := read_w(readp);
  1211.                copyp   := image_out;
  1212.                Inc(copyp, read_w(readp));
  1213.                while (Counter <> 0) do
  1214.                begin
  1215.                   try
  1216.                   Dec(Counter);
  1217.                   writep^ := copyp^;
  1218.                   Inc(writep);
  1219.                   Inc(copyp);
  1220.                   Dec(max);
  1221.                   if Max = 0 then
  1222.                   begin
  1223.                    DecodeError := True;
  1224.                    Break;
  1225.                   end;
  1226.                   except
  1227.                    DecodeError := True;
  1228.                    Break;
  1229.                   end;
  1230.                end;
  1231.             end;
  1232.          end;
  1233.       end;
  1234.    end;
  1235.    //  assert(cb_in == readp - image_in);
  1236.    Result := integer(writep) - integer(image_out);
  1237. end;
  1238.  
  1239. // decode40Tri from SHP_RA_Code.Pas
  1240. function Decode40Tri(const Source: PByte; const XorDest: PByte; var Dest: PByte): integer;
  1241. var
  1242.    SP:      PByte;
  1243.    XP:      PByte;
  1244.    DP:      PByte;
  1245.    Counter: integer;
  1246.    Code:    integer;
  1247. begin
  1248.    SP := Source;
  1249.    XP := XorDest;
  1250.    DP := Dest;
  1251.    while True do
  1252.    begin
  1253.       Code := SP^;
  1254.       Inc(SP);
  1255.       if ((not Code) and $80) <> 0 then
  1256.       begin
  1257.          //bit 7 = 0
  1258.          if (Code = 0) then
  1259.          begin
  1260.             //command 0 (00000000 c v): fill
  1261.             Counter := SP^;
  1262.             Inc(SP);
  1263.             Code := SP^;
  1264.             Inc(SP);
  1265.             while (Counter > 0) do
  1266.             begin
  1267.                Dec(Counter);
  1268.                DP^ := XP^ xor Code;
  1269.                Inc(XP);
  1270.                Inc(DP);
  1271.             end;
  1272.          end
  1273.          else
  1274.          begin
  1275.             //command 1 (0ccccccc): copy
  1276.             Counter := Code;
  1277.             while (Counter > 0) do
  1278.             begin
  1279.                Dec(Counter);
  1280.                DP^ := XP^ xor SP^;
  1281.                Inc(XP);
  1282.                Inc(DP);
  1283.                Inc(SP);
  1284.             end;
  1285.          end;
  1286.  
  1287.       end
  1288.       else
  1289.       begin
  1290.          //bit 7 = 1
  1291.          Counter := Code and $7f;
  1292.          if (Counter = 0) then
  1293.          begin
  1294.             Counter := read_w(SP);
  1295.             Code    := Counter shr 8;
  1296.             if ((not code) and $80) <> 0 then
  1297.             begin
  1298.                //bit 7 = 0
  1299.                //command 2 (10000000 c 0ccccccc): skip
  1300.                if (Counter = 0) then
  1301.                begin
  1302.                   // end of image
  1303.                   Result := integer(DP) - integer(Dest);
  1304.                   exit;
  1305.                end;
  1306.                while Counter > 0 do
  1307.                begin
  1308.                   DP^ := XP^;
  1309.                   Inc(DP);
  1310.                   Inc(XP);
  1311.                   Dec(Counter);
  1312.                end;
  1313.             end
  1314.             else
  1315.             begin
  1316.                //bit 7 = 1
  1317.                Counter := Counter and $3fff;
  1318.                if ((not Code) and $40) <> 0 then
  1319.                begin
  1320.                   //bit 6 = 0
  1321.                   //command 3 (10000000 c 10cccccc): copy
  1322.                   while (Counter > 0) do
  1323.                   begin
  1324.                      Dec(Counter);
  1325.                      DP^ := XP^ xor SP^;
  1326.                      Inc(XP);
  1327.                      Inc(DP);
  1328.                      Inc(SP);
  1329.                   end;
  1330.                end
  1331.                else
  1332.                begin
  1333.                   //bit 6 = 1
  1334.                   //command 4 (10000000 c 11cccccc v): fill
  1335.                   Code := SP^;
  1336.                   Inc(SP);
  1337.                   while (Counter > 0) do
  1338.                   begin
  1339.                      Dec(Counter);
  1340.                      DP^ := XP^ xor Code;
  1341.                      Inc(XP);
  1342.                      Inc(DP);
  1343.                   end;
  1344.                end;
  1345.             end;
  1346.          end
  1347.          else
  1348.          begin
  1349.             //command 5 (1ccccccc): skip
  1350.             while Counter > 0 do
  1351.             begin
  1352.                DP^ := XP^;
  1353.                Inc(DP);
  1354.                Inc(XP);
  1355.                Dec(Counter);
  1356.             end;
  1357.          end;
  1358.       end;
  1359.    end;
  1360. end;
  1361.  
  1362. procedure TSHP.TDRA1Decode(Input : TStream; DecodeFrame,Frame : Integer);
  1363. var
  1364.  I : PByte;
  1365. begin
  1366.  GetMem(I,FW*FH);
  1367.  ZeroMemory(I,FW*FH);
  1368.  Input.Read(I^,FW*FH);
  1369.  
  1370.  if DecodeFrame = -1 then
  1371.  try
  1372.  if decode80d(I,FFrames[Frame].PalData,FW*FH) <> FW*FH then
  1373.  asm nop end;
  1374.  except
  1375.   asm nop end;
  1376.  end
  1377.  else
  1378.  decode40Tri(I,FFrames[DecodeFrame].PalData,FFrames[Frame].PalData);
  1379.  
  1380.  FreeMem(I);
  1381. end;
  1382.  
  1383. function FindOffset(Offset : Cardinal; Header : PSHP_Offset_TD; Frame : Integer) : Integer;
  1384. begin
  1385.  Result := Frame;
  1386.  Dec(Cardinal(Header),SizeOf(TSHP_Offset_TD));
  1387.  Dec(Result);
  1388.  if Result < 0 then Exit;
  1389.  
  1390.  While Result > -1 do
  1391.  begin
  1392.   if ThreeByteToCardinal(Header^.Offset) = Offset then
  1393.    Exit;
  1394.   Dec(Result);
  1395.   Dec(Cardinal(Header),SizeOf(TSHP_Offset_TD));
  1396.  end;
  1397. end;
  1398.  
  1399. function TSHP.LoadTDRASHPFromStream(Stream : TStream) : Boolean;
  1400. var
  1401.  Header      : TSHP_Header_TD;
  1402.  Offsets     : PSHP_Offset_TD;
  1403.  Offset      : PSHP_Offset_TD;
  1404.  ExtraOffset : TSHP_Offset_TD;
  1405.  Mem         : TMemoryStream;
  1406.  MemStart    : Int64;
  1407.  X,
  1408.  DecodeFrame : Integer;
  1409.  C           : Integer;
  1410.  T           : Cardinal;
  1411. begin
  1412.  Result := False;
  1413.  Stream.Read(Header,SizeOf(TSHP_Header_TD));
  1414.  if (Header.Count = 0) or (Header.Width = 0) or (Header.Height = 0) then
  1415.  begin
  1416.   Exit;
  1417.  end;
  1418.  
  1419.  FGame := sgTD;
  1420.  
  1421.  FW := Header.Width;
  1422.  FH := Header.Height;
  1423.  
  1424.  C := Header.Count;
  1425.  
  1426.  if FOneFrameLoad then
  1427.  begin
  1428.   FindSHPType(Header.Count);
  1429.   Header.Count := 1;
  1430.  end;
  1431.  
  1432.  SetFrameAmount(Header.Count);
  1433.  
  1434.  GetMem(Offsets,SizeOf(TSHP_Offset_TD)*Header.Count);
  1435.  Stream.Read(Offsets^,SizeOf(TSHP_Offset_TD)*Header.Count);
  1436.  
  1437.  T := ThreeByteToCardinal(Offsets^.Offset)-(SizeOf(TSHP_Offset_TD)*C+SizeOf(TSHP_Header_TD));
  1438.  if not (FOneFrameLoad) and (T = 16) then
  1439.  begin
  1440.   Stream.Read(ExtraOffset,SizeOf(TSHP_Offset_TD));
  1441.  
  1442.   Offset := Offsets;
  1443.   Inc(Cardinal(Offset),SizeOf(TSHP_Offset_TD)*Header.Count);
  1444.  
  1445.   if ThreeByteToCardinal(ExtraOffset.Offset) <> Stream.Size then
  1446.   asm nop end;
  1447.  
  1448.   FTD_LoopFrame := FindOffset(ThreeByteToCardinal(ExtraOffset.Offset),Offset,Header.Count);
  1449.   if FTD_LoopFrame = Header.Count then
  1450.   FTD_LoopFrame := -1;
  1451.  end
  1452.  else
  1453.  FTD_LoopFrame := -1;
  1454.  
  1455.  MemStart := Stream.Position;
  1456.  //Load the rest of the file in a MemoryStream to reduce overheads
  1457.  Mem := TMemoryStream.Create;
  1458.  Mem.CopyFrom(Stream,Stream.Size-Stream.Position);
  1459.  Mem.Position := 0;
  1460.  
  1461.  Offset := Offsets;
  1462.  
  1463.  for X := 0 to High(FFrames) do
  1464.  begin
  1465.   FFrames[X].PalData := Nil;
  1466.   FFrames[X].RGBData := Nil;
  1467.   FFrames[X].AData   := Nil;
  1468.   FFrames[X].NeedUpd := True;
  1469.  
  1470.    FFrames[X].UsedArea := SetArea(0,0,FW,FH);
  1471.    SetRadarCol(X,0);
  1472.    GetMem(FFrames[X].PalData,FW*FH);
  1473.    ZeroMemory(FFrames[X].PalData,FW*FH);
  1474.  
  1475.    if not FIgnoreFrames then
  1476.    begin
  1477.     case Offset^.Compression of //Work out the DecodeFrame!
  1478.      $80 : DecodeFrame := -1;
  1479.      $40 : DecodeFrame := FindOffset(ThreeByteToCardinal(Offset^.ReOffset),Offset,X);
  1480.      $20 : DecodeFrame := X-1;
  1481.      else
  1482.      begin
  1483.       FFrames[X].UsedArea := SetArea(0,0,0,0);
  1484.       DecodeFrame := -2; //Error ignore frame
  1485.       asm nop end; //Break Point
  1486.      end;
  1487.     end;
  1488.  
  1489.     if DecodeFrame > -2 then
  1490.     begin
  1491.      Mem.Seek(ThreeByteToCardinal(Offset^.Offset)-MemStart,soFromBeginning);
  1492.      TDRA1Decode(Mem,DecodeFrame,X);
  1493.      if DecodeError then
  1494.      begin
  1495.       {FFrames[X].PalData  := Nil;
  1496.       FFrames[X].UsedArea := SetArea(0,0,0,0); }
  1497.      end;
  1498.     end;
  1499.    end;
  1500.  
  1501.   Inc(Cardinal(Offset),SizeOf(TSHP_Offset_TD));
  1502.  end;
  1503.  
  1504.  ReadExtra(Mem);
  1505.  Mem.Free;
  1506.  
  1507.  if FKeepHeaders then
  1508.  begin
  1509.   GetMem(FStoredHeaders[0],SizeOf(TSHP_Header_TD));
  1510.   CopyMemory(FStoredHeaders[0],@Header,SizeOf(TSHP_Header_TD));
  1511.   FStoredHeaders[1] := Offsets;
  1512.  end
  1513.  else
  1514.   FreeMem(Offsets);
  1515.  
  1516.  Result := True;
  1517. end;
  1518.  
  1519. procedure TSHP.IsRA2NotTSUnitCheck;
  1520. begin
  1521.  if (FType = stUnit) and (FGame = sgTS) then
  1522.  if ScanFrameForColor(12,0) then
  1523.  FGame := sgRA2;
  1524.  
  1525.  if (FType = stAnimation) then
  1526.  if ScanFrameForColor(1,(High(FFrames)+1) div 2) then
  1527.  FType := stBuilding;//stBuildAnim;
  1528.  
  1529.  if (FGame = sgRA2) and (FType = stBuilding) and (Count = 8) then
  1530.  FType := stIsoSnoBuilding;
  1531. end;
  1532.  
  1533. procedure TSHP.LoadFromStream(Stream : TStream);
  1534. begin
  1535.  FType       := stUnit;
  1536.  FSHPExtra   := False;
  1537.  FreeDebugHeaders;
  1538.  
  1539.  FSHPFileType    := GetSHPFileType(Stream);
  1540.  Stream.Position := 0;
  1541.  
  1542.  case FSHPFileType of
  1543.   sftNone : Exit;
  1544.   sftTD   : LoadTDRASHPFromStream(Stream);
  1545.   sftTS   : LoadTSSHPFromStream(Stream);
  1546.  end;
  1547.  
  1548.  if not FSHPExtra then
  1549.  begin
  1550.   if not FOneFrameLoad then
  1551.   FindSHPType(Count);
  1552.   if FSHPFileType = sftTS then
  1553.   IsRA2NotTSUnitCheck;
  1554.  end;
  1555.  
  1556.  FSaved     := True;
  1557.  FWasLoaded := True;
  1558. end;
  1559.  
  1560. procedure TSHP.GetUsedAreaFrame(Buffer : Pointer; Frame : Integer);
  1561. var
  1562.  Y   : Integer;
  1563.  S,D : Pointer;
  1564. begin
  1565.  D := Buffer;
  1566.  for Y := 0 to FFrames[Frame].UsedArea[IMGAREA_H]-1 do
  1567.  begin
  1568.   S := PALLineStart(FFrames[Frame].PalData,Y,FFrames[Frame].UsedArea,FW);
  1569.   CopyMemory(D,S,FFrames[Frame].UsedArea[IMGAREA_W]);
  1570.   Inc(Cardinal(D),FFrames[Frame].UsedArea[IMGAREA_W]);
  1571.  end;
  1572. end;
  1573.  
  1574. function GetEncode3(Data : Pointer; var Size : Integer; const W,H : Integer) : Pointer;
  1575. var
  1576.  Y,X      : Integer;
  1577.  C        : Word;
  1578.  Temp,T,
  1579.  RS,Input : Pointer;
  1580. begin
  1581.  Input := Data;
  1582.  GetMem(Result,W*H+(H*10));
  1583.  RS := Result;
  1584.  GetMem(Temp,W*2);
  1585.  try
  1586.  for Y := 0 to H-1 do
  1587.  begin
  1588.   T  := Temp;
  1589.   C  := 0;
  1590.   for X := 0 to W-1 do
  1591.   begin
  1592.    if Byte(Input^) <> 0 then
  1593.    begin
  1594.     if (C > 0) then
  1595.     begin
  1596.      Byte(T^) := 0;
  1597.      Inc(Cardinal(T),1);
  1598.      Byte(T^) := C;
  1599.      Inc(Cardinal(T),1);
  1600.      C := 0;
  1601.     end;
  1602.  
  1603.     Byte(T^) := Byte(Input^);
  1604.     Inc(Cardinal(T),1);
  1605.    end
  1606.    else
  1607.    begin
  1608.     Inc(C);
  1609.     if C >= 255 then
  1610.     begin
  1611.      Byte(T^) := 0;
  1612.      Inc(Cardinal(T),1);
  1613.      Byte(T^) := C;
  1614.      Inc(Cardinal(T),1);
  1615.      C := 0;
  1616.     end;
  1617.    end;
  1618.  
  1619.    Inc(Cardinal(Input),1);
  1620.   end;
  1621.  
  1622.   if (C > 0) then
  1623.   begin
  1624.    Byte(T^) := 0;
  1625.    Inc(Cardinal(T),1);
  1626.    Byte(T^) := C;
  1627.    Inc(Cardinal(T),1);
  1628.   end;
  1629.  
  1630.   C          := (Cardinal(T)-Cardinal(Temp))+2;
  1631.   PWord(RS)^ := C;
  1632.   Inc(Cardinal(RS),2);
  1633.   if C <= 2 then Continue;
  1634.  
  1635.   CopyMemory(RS,Temp,C-2);
  1636.   Inc(Cardinal(RS),C-2);
  1637.  end;
  1638.  
  1639.  Size := Cardinal(RS)-Cardinal(Result);
  1640.  except
  1641.   Size := 99999999;
  1642.   FreeMem(Result);
  1643.   Result := Nil;
  1644.  end;
  1645.  FreeMem(Temp);
  1646. end;
  1647.  
  1648. function TSHP.GetFrameAverageColour(Frame : Integer) : TRGBTriple;
  1649. var
  1650.  R,G,B   : Integer;
  1651.  C       : Integer;
  1652.  S       : PByte;
  1653.  Palette : TSHP_Palette;
  1654.  X,Y     : Integer;
  1655. begin
  1656.  R := 0;
  1657.  G := 0;
  1658.  B := 0;
  1659.  C := 0;
  1660.  
  1661.  Palette := FPalette;
  1662.  
  1663.  for Y := 0 to FFrames[Frame].UsedArea[IMGAREA_H]-1 do
  1664.  begin
  1665.   S := PALLineStart(FFrames[Frame].PalData,Y,FFrames[Frame].UsedArea,FW);
  1666.   for X := 0 to FFrames[Frame].UsedArea[IMGAREA_W]-1 do
  1667.   begin
  1668.    if S^ > 0 then
  1669.    begin
  1670.     Inc(R,Palette[S^].rgbtRed);
  1671.     Inc(G,Palette[S^].rgbtGreen);
  1672.     Inc(B,Palette[S^].rgbtBlue);
  1673.     Inc(C);
  1674.     if C >= 2550 then
  1675.     begin
  1676.      R := R div C;
  1677.      G := G div C;
  1678.      B := B div C;
  1679.      C := 0;
  1680.     end;
  1681.    end;
  1682.    Inc(Cardinal(S),1);
  1683.   end;
  1684.  end;
  1685.  
  1686.  if C > 0 then
  1687.  begin
  1688.   R := R div C;
  1689.   G := G div C;
  1690.   B := B div C;
  1691.  end;
  1692.  
  1693.  Result := SetRGBTriple(Min(Max(R,255),0),Min(Max(G,255),0),Min(Max(B,255),0));
  1694. end;
  1695.  
  1696. procedure TSHP.SaveTSRA2SHPToStream(Stream : TStream);
  1697. var
  1698.  Header       : TSHP_Header;
  1699.  Header_Imgs  : PSHP_Header_Image;
  1700.  Header_Img   : PSHP_Header_Image;
  1701.  ImgHeadStart : Int64;
  1702.  X,Size,
  1703.  LastSize     : Integer;
  1704.  FrameBuffs   : Array [0..1] of Pointer;
  1705.  Half         : Integer;
  1706. begin
  1707.  Header.Zero   := 0;
  1708.  Header.Width  := FW;
  1709.  Header.Height := FH;
  1710.  Header.Count  := High(FFrames)+1;
  1711.  
  1712.  Stream.Write(Header,SizeOf(TSHP_Header));
  1713.  ImgHeadStart := Stream.Position;
  1714.  GetMem(Header_Imgs,SizeOf(TSHP_Header_Image)*Header.Count);
  1715.  ZeroMemory(Header_Imgs,SizeOf(TSHP_Header_Image)*Header.Count);
  1716.  Stream.Write(Header_Imgs^,SizeOf(TSHP_Header_Image)*Header.Count);
  1717.  
  1718.  Half := Header.Count div 2;
  1719.  
  1720.  Header_Img := Header_Imgs;
  1721.  for X := 0 to Header.Count-1 do
  1722.  begin
  1723.   Header_Img^.X           := FFrames[X].UsedArea[IMGAREA_X];
  1724.   Header_Img^.Y           := FFrames[X].UsedArea[IMGAREA_Y];
  1725.   Header_Img^.W           := FFrames[X].UsedArea[IMGAREA_W];
  1726.   Header_Img^.H           := FFrames[X].UsedArea[IMGAREA_H];
  1727.   Header_Img^.Offset      := Stream.Position;
  1728.   Header_Img^.RadarColor  := GetFrameAverageColour(X);//SetRGBTriple(FFrames[X].RadarCol.rgbRed,FFrames[X].RadarCol.rgbGreen,FFrames[X].RadarCol.rgbBlue);
  1729.   Header_Img^.Unknown1    := 0;//FFrames[X].RadarCol.rgbReserved;
  1730.   Header_Img^.Flags       := FForceFlags;
  1731.  
  1732.   //Header_Img^.Unknown     := $CCCC; //TEST!
  1733.  
  1734.   if ScanFrameForColor(0,X) then
  1735.   Header_Img^.Flags := Header_Img^.Flags or TS_FLAG_TRANSPARENT;
  1736.  
  1737.   if (Header_Img^.W = 0) or (Header_Img^.H = 0) then
  1738.   begin
  1739.    Header_Img^.Offset := 0;
  1740.    Continue;
  1741.   end;
  1742.  
  1743.   LastSize := FFrames[X].UsedArea[IMGAREA_W]*FFrames[X].UsedArea[IMGAREA_H];
  1744.  
  1745.   ZeroMemory(@FrameBuffs[0],SizeOf(Pointer)*3);
  1746.  
  1747.   GetMem(FrameBuffs[0],LastSize);
  1748.   GetUsedAreaFrame(FrameBuffs[0],X);
  1749.  
  1750.   try
  1751.   if (CompressionMode in [COMPMODE_AUTO,COMPMODE_ALL] ) or ((CompressionMode = COMPMODE_HALF) and (X < Half)) then
  1752.   begin
  1753.    FrameBuffs[1] := GetEncode3(FrameBuffs[0],Size,FFrames[X].UsedArea[IMGAREA_W],FFrames[X].UsedArea[IMGAREA_H]);
  1754.    if (Size >= LastSize) and not (CompressionMode in [COMPMODE_ALL,COMPMODE_HALF])  then
  1755.    begin
  1756.     FreeMem(FrameBuffs[1]);
  1757.     FrameBuffs[1] := Nil;
  1758.    end
  1759.    else
  1760.    begin
  1761.     LastSize := Size;
  1762.     Header_Img^.Flags := Header_Img^.Flags or TS_FLAG_COMPRESSION;
  1763.    end;
  1764.   end;
  1765.  
  1766.   if HasFlag(Header_Img^.Flags,TS_FLAG_COMPRESSION) then
  1767.    Stream.Write(FrameBuffs[1]^,LastSize)
  1768.   else
  1769.    Stream.Write(FrameBuffs[0]^,LastSize);
  1770.  
  1771.   FreeMem(FrameBuffs[0]);
  1772.   if Assigned(FrameBuffs[1]) then
  1773.   FreeMem(FrameBuffs[1]);
  1774.   except
  1775.    asm nop end;
  1776.   end;
  1777.  
  1778.   Inc(Cardinal(Header_Img),SizeOf(TSHP_Header_Image));
  1779.  end;
  1780.  
  1781.  WriteExtra(Stream);
  1782.  
  1783.  Stream.Position := ImgHeadStart;
  1784.  Stream.Write(Header_Imgs^,SizeOf(TSHP_Header_Image)*Header.Count);
  1785. end;
  1786.  
  1787. procedure TSHP.SaveToStream(Stream : TStream);
  1788. begin
  1789.  Assert(not FOneFrameLoad,'Can not save a SHP with OneFrameLoad enabled....');
  1790.  
  1791.  if FSHPFileType = sftTS then
  1792.   SaveTSRA2SHPToStream(Stream)
  1793.  else
  1794.   ;
  1795.   //SaveTDRASHPToStream(Stream);
  1796.  
  1797.  FSaved     := True;
  1798.  FWasLoaded := True;
  1799. end;
  1800.  
  1801. procedure TSHP.SetPalette(Palette : TSHP_Palette);
  1802. begin
  1803.  CopyMemory(@FPalette[0],@Palette[0],SizeOf(TSHP_Palette));
  1804.  
  1805.  MarkNeedUpd;
  1806. end;
  1807.  
  1808. procedure TSHP.SetPaletteRGBQ(RGBQ : array of TRGBQuad);
  1809. var
  1810.  X : Integer;
  1811. begin
  1812.  SHPExtra := True; //Stops it from auto assigning a palette!
  1813.  
  1814.  for X := 0 to 255 do
  1815.  FPalette[X] := QuadToTriple(RGBQ[X]);
  1816.  
  1817.  MarkNeedUpd;
  1818. end;
  1819.  
  1820. procedure TSHP.MarkNeedUpd;
  1821. var
  1822.  X : Integer;
  1823. begin
  1824.  for X := 0 to High(FFrames) do
  1825.  FFrames[X].NeedUpd := True;
  1826. end;
  1827.  
  1828. function TSHP.GetCount() : Integer;
  1829. begin
  1830.  Result := High(FFrames)+1;
  1831. end;
  1832.  
  1833. procedure LoadAPalette(var Palette : TSHP_Palette; Filename : AnsiString);
  1834. var
  1835.  Stream : TStream;
  1836.  X      : Integer;
  1837.  T      : Byte;
  1838. begin
  1839.  Stream := TFileStream.Create(Filename,fmOpenRead or fmShareDenyWrite);
  1840.   Stream.Read(Palette[0],SizeOf(TSHP_Palette));
  1841.  Stream.Free;
  1842.  
  1843.  for X := 0 to 255 do
  1844.  begin
  1845.   T                    := Palette[X].rgbtBlue;
  1846.   Palette[X].rgbtBlue  := Palette[X].rgbtRed*4;
  1847.   Palette[X].rgbtGreen := Palette[X].rgbtGreen*4;
  1848.   Palette[X].rgbtRed   := T*4;
  1849.  end;
  1850. end;
  1851.  
  1852. procedure TSHP.LoadPalette(Filename : AnsiString);
  1853. begin
  1854.  LoadAPalette(FPalette,Filename);
  1855.  
  1856.  MarkNeedUpd;
  1857. end;
  1858.  
  1859. function TSHP.GetISOPalette : TSHP_Palette;
  1860. var
  1861.  Pal : AnsiString;
  1862. begin
  1863.  if not Assigned(FPaletteISO) then
  1864.  begin
  1865.   GetMem(FPaletteISO,SizeOf(TSHP_Palette));
  1866.  
  1867.   if FType = stIsoSnoBuilding then
  1868.   Pal := 'isosno'
  1869.   else
  1870.   if FType = stIsoTemBuilding then
  1871.   Pal := 'isotem'
  1872.   else
  1873.   Pal := 'isourb';
  1874.  
  1875.   LoadAPalette(FPaletteIso^,SHP_Palette_Directory + SHP_GameF_Str[Ord(FGame)] + '\'+Pal+'.pal');
  1876.  end;
  1877.  
  1878.  Result := FPaletteIso^;
  1879. end;
  1880.  
  1881. procedure TSHP.LoadPaletteFromDir(Directory : AnsiString);
  1882. var
  1883.  FN : AnsiString;
  1884. begin
  1885.  Directory := AddTrailer(Directory) + SHP_GameF_Str[Ord(FGame)] + '\';
  1886.  
  1887.  if (SHPPalettesOver[FGame,FPalType] <> '') then
  1888.  FN := SHPPalettesOver[FGame,FPalType]
  1889.  else
  1890.  if (SHPPalettes[FGame,FType] = '') then
  1891.  FN := SHPPalettes[FGame,stUnit]
  1892.  else
  1893.  FN := SHPPalettes[FGame,FType];
  1894.  
  1895.  FAutoPalette := '';
  1896.  
  1897.  if FileExists(Directory + FN + '.pal') then
  1898.  begin
  1899.   LoadPalette(Directory + FN + '.pal');
  1900.   FAutoPalette := SHP_GameF_Str[Ord(FGame)] + '\' + FN + '.pal';
  1901.  end
  1902.  else
  1903.  if FileExists(Directory + 'unittem.pal') then
  1904.   LoadPalette(Directory + 'unittem.pal');
  1905. end;
  1906.  
  1907. function Min3(A,B,C : Single) : Single;
  1908. begin
  1909.  Result := Min(Min(A,B),C);
  1910. end;
  1911.  
  1912. type
  1913.  THSLArray = Array [0..2] of Single;
  1914. const
  1915.  HSL_H = 0;
  1916.  HSL_S = 1;
  1917.  HSL_L = 2;
  1918.  
  1919. // RGBToHSL - http://www.easyrgb.com/index.php?X=MATH&H=18#text18
  1920. function RGBToHSL(RGB : TRGBTriple) : THSLArray;
  1921. var
  1922.  Rf,Gf,Bf,
  1923.  Minf,Maxf,
  1924.  del_max,
  1925.  dR,dG,dB  : Single;
  1926. begin
  1927.  Rf := ( RGB.rgbtRed / 255 );                    //RGB from 0 to 255
  1928.  Gf := ( RGB.rgbtGreen / 255 );
  1929.  Bf := ( RGB.rgbtBlue / 255 );
  1930.  
  1931.  Minf := min(min(Rf,Gf),Bf);    //Min. value of RGB
  1932.  Maxf := max(max(Rf,Gf),Bf);    //Max. value of RGB
  1933.  del_Max := Maxf - Minf;        //Delta RGB value
  1934.  
  1935.  Result[HSL_L] := (Maxf + Minf) / 2;
  1936.  
  1937.  if ( del_Max = 0 ) then                     //This is a gray, no chroma...
  1938.  begin
  1939.   Result[HSL_H] := 0;                                //HSL results from 0 to 1
  1940.   Result[HSL_S] := 0
  1941.  end
  1942.  else                                    //Chromatic data...
  1943.  begin
  1944.   if ( Result[HSL_L] < 0.5 ) then
  1945.    Result[HSL_S] := del_Max / (Maxf + Minf)
  1946.   else
  1947.    Result[HSL_S] := del_Max / ( 2 - Maxf - Minf );
  1948.  
  1949.   dR := ( ( ( Maxf - Rf ) / 6 ) + ( del_Max / 2 ) ) / del_Max;
  1950.   dG := ( ( ( Maxf - Gf ) / 6 ) + ( del_Max / 2 ) ) / del_Max;
  1951.   dB := ( ( ( Maxf - Bf ) / 6 ) + ( del_Max / 2 ) ) / del_Max;
  1952.  
  1953.   if ( Rf = Maxf ) then
  1954.    Result[HSL_H] := dB - dG
  1955.   else
  1956.   if ( Gf = Maxf ) then
  1957.    Result[HSL_H] := ( 1 / 3 ) + dR - dB
  1958.   else
  1959.   if ( Bf = Maxf ) then
  1960.    Result[HSL_H] := ( 2 / 3 ) + dG - dR;
  1961.  
  1962.   if ( Result[HSL_H] < 0 ) then
  1963.   Result[HSL_H] := Result[HSL_H] + 1;
  1964.   if ( Result[HSL_H] > 1 ) then
  1965.   Result[HSL_H] := Result[HSL_H] - 1;
  1966.  end;
  1967. end;
  1968.  
  1969. // HSLToRGB - http://www.easyrgb.com/index.php?X=MATH&H=18#text18
  1970. function HSLToRGB(HSL : THSLArray) : TRGBTriple;
  1971.  
  1972. function Hue_2_RGB( v1, v2, vH : Single ) : Single;             //Function Hue_2_RGB
  1973. begin
  1974.    if ( vH < 0 ) then
  1975.     vH := vH + 1;
  1976.    if ( vH > 1 ) then
  1977.     vH := vH - 1;
  1978.  
  1979.    if ( ( 6 * vH ) < 1 ) then
  1980.     Result := ( v1 + ( v2 - v1 ) * 6 * vH )
  1981.    else
  1982.    if ( ( 2 * vH ) < 1 ) then
  1983.     Result := v2
  1984.    else
  1985.    if ( ( 3 * vH ) < 2 ) then
  1986.     Result := ( v1 + ( v2 - v1 ) * ( ( 2 / 3 ) - vH ) * 6 )
  1987.    else
  1988.     Result := v1;
  1989. end;
  1990.  
  1991. var
  1992.  v1,v2 : Single;
  1993. begin
  1994.  if ( HSL[HSL_S] = 0 ) then                       //HSL from 0 to 1
  1995.  begin
  1996.   Result.rgbtRed   := Trunc(HSL[HSL_L] * 255);                      //RGB results from 0 to 255
  1997.   Result.rgbtGreen := Result.rgbtRed;
  1998.   Result.rgbtBlue  := Result.rgbtRed;
  1999.  end
  2000.  else
  2001.  begin
  2002.   if ( HSL[HSL_L] < 0.5 ) then
  2003.    v2 := HSL[HSL_L] * ( 1 + HSL[HSL_S] )
  2004.   else
  2005.    v2 := ( HSL[HSL_L] + HSL[HSL_S] ) - ( HSL[HSL_S] * HSL[HSL_L] );
  2006.  
  2007.   v1 := 2 * HSL[HSL_L] - v2;
  2008.  
  2009.   Result.rgbtRed   := Trunc(255 * Hue_2_RGB( v1, v2, HSL[HSL_H] + ( 1 / 3 ) ));
  2010.   Result.rgbtGreen := Trunc(255 * Hue_2_RGB( v1, v2, HSL[HSL_H] ));
  2011.   Result.rgbtBlue  := Trunc(255 * Hue_2_RGB( v1, v2, HSL[HSL_H] - ( 1 / 3 ) ));
  2012.  end;
  2013. end;
  2014.  
  2015. function TSHP.GetPalette(Index : Integer) : TSHP_Palette;
  2016. var
  2017.  X       : Integer;
  2018.  R,
  2019.  G,
  2020.  B       : Extended;
  2021.  SideOff : Byte;
  2022.  HSL     : THSLArray;
  2023. begin
  2024.  if (FType in stIsoBuilding) and (Index = 3) then
  2025.  begin
  2026.   Result := GetISOPalette;
  2027.   Exit;
  2028.  end;
  2029.  
  2030.  Result    := FPalette;
  2031.  Result[0] := FTransCol; //Override with the transparent colour we want
  2032.  if FUseSideCol then
  2033.  begin
  2034.   if FGame in [sgTD] then
  2035.   begin
  2036.    R := (FSideCol.rgbtRed/9);
  2037.    G := (FSideCol.rgbtGreen/9);
  2038.    B := (FSideCol.rgbtBlue/9);
  2039.  
  2040.    SideOff := 16*11;
  2041.  
  2042.    for X := 0 to 7 do
  2043.     Result[(7-X)+SideOff] := SetRGBTriple(Trunc(R*(X+1)),Trunc(G*(X+1)),Trunc(B*(X+1)));
  2044.  
  2045.    R := (FSideCol.rgbtRed/17);
  2046.    G := (FSideCol.rgbtGreen/17);
  2047.    B := (FSideCol.rgbtBlue/17);
  2048.  
  2049.    for X := 0 to 7 do
  2050.     Result[(7-X)+8+SideOff] := SetRGBTriple(Trunc(R*(X+5)),Trunc(G*(X+5)),Trunc(B*(X+5)));
  2051.   end
  2052.   else
  2053.   begin
  2054.    R := (FSideCol.rgbtRed/17);
  2055.    G := (FSideCol.rgbtGreen/17);
  2056.    B := (FSideCol.rgbtBlue/17);
  2057.  
  2058.    if FGame in [sgRA1] then
  2059.    SideOff := 16*5
  2060.    else
  2061.    SideOff := 16;
  2062.  
  2063.    for X := 0 to 15 do
  2064.    Result[(15-X)+SideOff] := SetRGBTriple(Trunc(R*(X+2)),Trunc(G*(X+2)),Trunc(B*(X+2)));
  2065.   end;
  2066.  end;
  2067.  
  2068.  if FAmbientLight <> 0 then
  2069.  begin
  2070.   for X := 1 to 255 do
  2071.   if not (X in [240..254]) then
  2072.   begin
  2073.    HSL := RGBToHSL(Result[X]);
  2074.    HSL[HSL_L] := Max(Min(HSL[HSL_L] + (FAmbientLight/255),1),0);
  2075.    Result[X] := HSLToRGB(HSL);
  2076.   end;
  2077.  end;
  2078. end;
  2079.  
  2080. procedure TSHP.SetSideCol(Value : TRGBTriple);
  2081. begin
  2082.  FSideCol := Value;
  2083.  if FUseSideCol then
  2084.  MarkNeedUpd;
  2085. end;
  2086.  
  2087. procedure TSHP.SetUseSideCol(Value : Boolean);
  2088. begin
  2089.  if FUseSideCol = Value then
  2090.  Exit;
  2091.  
  2092.  FUseSideCol := Value;
  2093.  MarkNeedUpd;
  2094. end;
  2095.  
  2096. procedure TSHP.DrawFrameToBMP(Index : Integer; var BMP : TBitmap);
  2097. var
  2098.  S,D : Pointer;
  2099.  Y   : Integer;
  2100. begin
  2101.  S := RGBFrame[Index];
  2102.  
  2103.  BMP.Width  := FW;
  2104.  BMP.Height := FH;
  2105.  
  2106.  if not Assigned(S) then Exit;
  2107.  
  2108.  for Y := 0 to FH-1 do
  2109.  begin
  2110.   D := BMP.ScanLine[Y];
  2111.   CopyMemory(D,S,FW*3);
  2112.   Inc(Cardinal(S),FW*3);
  2113.  end;
  2114. end;
  2115.  
  2116. procedure TSHP.DrawFrameToBMP8(Index : Integer; var BMP : TBitmap; const X,Y : Integer);
  2117. var
  2118.  S,D : Pointer;
  2119.  L   : Integer;
  2120. begin
  2121.  S := FFrames[Index].PalData;
  2122.  if not Assigned(S) then Exit;
  2123.  
  2124.  for L := 0 to FH-1 do
  2125.  begin
  2126.   D := BMP.ScanLine[L+Y];
  2127.   Inc(Cardinal(D),X);
  2128.  
  2129.   CopyMemory(D,S,FW);
  2130.   Inc(Cardinal(S),FW);
  2131.  end;
  2132. end;
  2133.  
  2134. //FindSHPType - SHP_Engine.Pas
  2135. procedure TSHP.FindSHPType(Count : Integer);
  2136. begin
  2137.    // Detect cameo:
  2138.    if Count in [1,2] then
  2139.    begin
  2140.     if (FH = 48) then
  2141.     begin
  2142.      if (FW = 60) and (Ord(FGame) >= Ord(sgTS)) then
  2143.      begin
  2144.       FType := stCameo;
  2145.       FGame := sgRA2;
  2146.       Exit;
  2147.      end
  2148.      else
  2149.      if (FW = 64) and not (FGame = sgRA1) then
  2150.      begin
  2151.       FType := stCameo;
  2152.       Exit;
  2153.      end;
  2154.     end;
  2155.    end;
  2156.  
  2157.    // Detect non RA2 buildings
  2158.    if ((FW mod 24) = 0) and ((FH mod 24) = 0) then
  2159.    begin
  2160.       if (FGame = sgTS) then
  2161.       begin
  2162.          if (Count in [2..6]) then
  2163.          begin
  2164.             FType := stBuilding; // If less than 7 but more than 1 assume building
  2165.             Exit;
  2166.          end
  2167.          else
  2168.          begin
  2169.             if ((Count mod 2) = 0) then
  2170.             begin
  2171.                FType := stBuilding;//stBuildAnim;
  2172.                Exit;
  2173.             end;
  2174.          end;
  2175.       end
  2176.       else if (FGame in [sgTD,sgRA1]) then
  2177.       begin
  2178.          if Length(ExtractFileName(FFilename)) <= 8 then   // RA1 building names are a maximum of XXXX.shp
  2179.          begin
  2180.             FType := stBuilding;
  2181.             exit;
  2182.          end
  2183.          else // Buildups are XXXXmake.shp
  2184.          begin
  2185.             FType := stBuilding;//stBuildAnim;
  2186.             exit;
  2187.          end;
  2188.       end;
  2189.    end;
  2190.  
  2191.    // Detect RA2 buildings.
  2192.    if (FGame in [sgTS,sgRA2]) then
  2193.    begin
  2194.       if (Count = 6) or (Count = 8) then
  2195.       begin
  2196.          FGame := sgRA2;
  2197.          FType := stBuilding;
  2198.          exit;
  2199.       end;
  2200.    end;
  2201.  
  2202.    // Detect random animations
  2203.    if (((Count < 100) and (Count > 3)) or ((Count mod 2) <> 0)) then
  2204.       FType := stAnimation; // If less than 100 but more than 3 assume animation
  2205.  
  2206.    // Detect units
  2207.    if ((Count mod 8) = 0) and (Count > 60) then
  2208.       FType := stUnit;
  2209. end;
  2210.  
  2211. function TSHP.GetIsTransparent : Boolean;
  2212. begin
  2213.  Result := True;//(FType <> stCameo) or (FGame in [sgRA2,sgTS]);
  2214. end;
  2215.  
  2216. procedure TSHP.SetTransparentShadows(Value : Boolean);
  2217. begin
  2218.  if FTransparentShadows = Value then Exit;
  2219.  
  2220.  FTransparentShadows := Value;
  2221.  MarkNeedUpd;
  2222. end;
  2223.  
  2224. function TSHP.ScanFrameForColor(Color : Byte; Frame : Integer) : Boolean;
  2225. var
  2226.  Y,X : Integer;
  2227.  PAL : PByte;
  2228. begin
  2229.  Result := False;
  2230.  
  2231.  if (Frame < 0) or (Frame > High(FFrames)) or not Assigned(FFrames[Frame].PalData) then Exit;
  2232.  
  2233.  for Y := 0 to FFrames[Frame].UsedArea[IMGAREA_H]-1 do
  2234.  begin
  2235.   PAL := PALLineStart(FFrames[Frame].PalData,Y,FFrames[Frame].UsedArea,FW);
  2236.   for X := 0 to FFrames[Frame].UsedArea[IMGAREA_W]-1 do
  2237.   begin
  2238.    if PAL^ = Color then
  2239.    begin
  2240.     Result := True;
  2241.     Exit;
  2242.    end;
  2243.    Inc(Cardinal(PAL),1);
  2244.   end;
  2245.  end;
  2246. end;
  2247.  
  2248. function TSHP.ShouldDrawShadow : Boolean;
  2249. begin
  2250.  Result := False;
  2251.  if not ((FGame in [sgTS,sgRA2]) and (FType in stBuildingorUnit)) then Exit;
  2252.  
  2253. // if (FGame = sgRA2) and (FType = stUnit) then Exit;
  2254.  
  2255.  Result := True;  
  2256. end;
  2257.  
  2258. procedure TSHP.SetType(Value : TSHP_Type);
  2259. begin
  2260.  if Value = FType then Exit;
  2261.  
  2262.  if (FType in stIsoBuilding) and Assigned(FPaletteISO) then
  2263.  begin
  2264.   FreeMem(FPaletteISO);
  2265.   FPaletteISO := Nil;
  2266.  end;
  2267.  
  2268.  FType := Value;
  2269. end;
  2270.  
  2271. function TSHP.GetFramePixel(Frame, X, Y : Integer) : Byte;
  2272. begin
  2273.  if Assigned(FFrames[Frame].PalData) then
  2274.  Result := PByte(Pointer(Cardinal(FFrames[Frame].PalData) + (Y*FW+X)))^
  2275.  else
  2276.  Result := 0;
  2277. end;
  2278.  
  2279. procedure TSHP.SetAmbientLight(Value : SmallInt);
  2280. begin
  2281.  if Value = FAmbientLight then Exit;
  2282.  
  2283.  FAmbientLight := Value;
  2284.  MarkNeedUpd;
  2285. end;
  2286.  
  2287. procedure TSHP.AddFrames(Amount,Width,Height : Integer);
  2288. var
  2289.  X, Index : Integer;
  2290. begin
  2291.  Assert(Amount > 0,'TSHP.AddFrames - Amount <= 0');
  2292.  
  2293.  if FSHPFileType = sftNone then
  2294.  FSHPFileType := sftTS;
  2295.  
  2296.  // WARNING: There is no code to actually update any existing frames
  2297.  //          if the width or height changes!!!!!
  2298.  FW := Width;
  2299.  FH := Height;
  2300.  
  2301.  Index := Count;
  2302.  SetFrameAmount(Count+Amount);
  2303.  ZeroMemory(@FFrames[Index],SizeOf(TSHP_Frame)*Amount);
  2304.  
  2305.  for X := Index to Count-1 do
  2306.  begin
  2307.   FFrames[X].NeedUpd := True;
  2308.   GetMem(FFrames[X].PalData,Width*Height);
  2309.   ZeroMemory(FFrames[X].PalData,Width*Height);
  2310.   FFrames[X].UsedArea := SetArea(0,0,Width,Height);
  2311.  end;
  2312. end;
  2313.  
  2314. procedure TSHP.UpdateUsedArea(Frame : Integer);
  2315. var
  2316.  X,Y   : Integer;
  2317.  Area  : TImgArea;
  2318.  Empty : Boolean;
  2319.  Pal   : PByte;
  2320. begin
  2321.  Area  := SetArea(FW-1,FH-1,0,0);
  2322.  Empty := True;
  2323.  Pal   := FFrames[Frame].PalData;
  2324.  
  2325.  if not Assigned(Pal) then Exit;
  2326.  
  2327.  for Y := 0 to FH-1 do
  2328.  for X := 0 to FW-1 do
  2329.  begin
  2330.   if Pal^ > 0 then
  2331.   begin
  2332.    if (X < Area[IMGAREA_X]) then
  2333.    Area[IMGAREA_X] := X;
  2334.    if (X > Area[IMGAREA_W]) then
  2335.    Area[IMGAREA_W] := X;
  2336.    if (Y < Area[IMGAREA_Y]) then
  2337.    Area[IMGAREA_Y] := Y;
  2338.    if (Y > Area[IMGAREA_H]) then
  2339.    Area[IMGAREA_H] := Y;
  2340.    Empty := False;
  2341.   end;
  2342.  
  2343.   Inc(Cardinal(Pal),1);
  2344.  end;
  2345.  
  2346.  if Empty then
  2347.   FFrames[Frame].UsedArea := SetArea(0,0,0,0)
  2348.  else
  2349.  begin
  2350.   Area[IMGAREA_W]         := Area[IMGAREA_W]-Area[IMGAREA_X]+1;
  2351.   Area[IMGAREA_H]         := Area[IMGAREA_H]-Area[IMGAREA_Y]+1;
  2352.   FFrames[Frame].UsedArea := Area;
  2353.  end;
  2354. end;
  2355.  
  2356. procedure TSHP.GetUsedPaletteColoursForFrame(Frame : Integer; Result : PByte);
  2357. type
  2358.  TPBArray  = Array [0..255] of Byte;
  2359.  PTPBArray = ^TPBArray;
  2360. var
  2361.  X : Integer;
  2362.  D : PByte;
  2363.  R : PTPBArray;
  2364. begin
  2365.  if not Assigned(FFrames[Frame].PalData) then Exit;
  2366.  
  2367.  D := FFrames[Frame].PalData;
  2368.  R := PTPBArray(Result); //Easier if we access it as a Array.
  2369.  for X := 0 to FW*FH-1 do
  2370.  begin
  2371.   R^[D^] := 1; // There is no smart way to do it other than "Brute Force".
  2372.   Inc(Cardinal(D),1);
  2373.  end;
  2374. end;
  2375.  
  2376. function TSHP.GetUsedPaletteColours(Frame : Integer) : PByte; // If Frame is -1 it will return colours for all frames. Result is always 256 bytes (Boolean value).
  2377. var
  2378.  X : Integer;
  2379. begin
  2380.  GetMem(Result,256);
  2381.  ZeroMemory(Result,256);
  2382.  
  2383.  if Frame > -1 then
  2384.   GetUsedPaletteColoursForFrame(Frame,Result)
  2385.  else
  2386.   for X := 0 to Count-1 do
  2387.   GetUsedPaletteColoursForFrame(X,Result);
  2388. end;
  2389.  
  2390. procedure TSHP.SetFrameAmount(Value : Integer);
  2391. begin
  2392.  SetLength(FFrames,Value);
  2393. end;
  2394.  
  2395. var
  2396. X,Y : Integer;
  2397.  
  2398. initialization
  2399.  //Make sure its clear!
  2400.  for X := 0 to Ord(sgRA2) do
  2401.  for Y := 0 to Ord(stUnit) do
  2402.  SHPPalettes[TSHP_Game(X),TSHP_Type(Y)] := '';
  2403.  
  2404.  for X := 0 to Ord(sgRA2) do
  2405.  for Y := 0 to Ord(sptWin) do
  2406.  SHPPalettesOver[TSHP_Game(X),TSHP_PalType(Y)] := '';
  2407.  
  2408.  SHPPalettes[sgTD,stUnit]      := 'temperat';
  2409.  SHPPalettesOver[sgTD,sptDes]  := 'desert';
  2410.  SHPPalettesOver[sgTD,sptTem]  := 'temperat';
  2411.  SHPPalettesOver[sgTD,sptWin]  := 'winter';
  2412.  
  2413.  
  2414.  SHPPalettes[sgRA1,stUnit]      := 'temperat';
  2415.  SHPPalettes[sgRA1,stBuilding]  := 'temperat';
  2416.  SHPPalettes[sgRA1,stCameo]     := 'temperat';
  2417.  SHPPalettes[sgRA1,stAnimation] := 'temperat';
  2418. // SHPPalettes[sgRA1,stBuildAnim] := 'temperat';
  2419.  SHPPalettesOver[sgRA1,sptTem]       := 'temperat';
  2420.  SHPPalettesOver[sgRA1,sptSno]       := 'snow';
  2421.  SHPPalettesOver[sgRA1,sptInt]       := 'interior';
  2422.  
  2423.  SHPPalettes[sgTS,stUnit]       := 'unittem';
  2424.  SHPPalettes[sgTS,stBuilding]   := 'unittem';
  2425.  SHPPalettes[sgTS,stCameo]      := 'cameo';
  2426.  SHPPalettes[sgTS,stAnimation]  := 'anim';
  2427. // SHPPalettes[sgTS,stBuildAnim]  := 'unittem';
  2428.  SHPPalettesOver[sgTS,sptTem]        := 'isotem';
  2429.  SHPPalettesOver[sgTS,sptSno]        := 'isosno';
  2430.  
  2431.  SHPPalettes[sgRA2,stUnit]      := 'unittem';
  2432.  SHPPalettes[sgRA2,stBuilding]  := 'unittem';
  2433.  SHPPalettes[sgRA2,stCameo]     := 'cameo';
  2434.  SHPPalettes[sgRA2,stAnimation] := 'anim';
  2435. // SHPPalettes[sgRA2,stBuildAnim] := 'unittem';
  2436.  SHPPalettesOver[sgRA2,sptTem]       := 'isotem';
  2437.  SHPPalettesOver[sgRA2,sptSno]       := 'isosno';
  2438.  SHPPalettesOver[sgRA2,sptUrb]       := 'isourb';
  2439.  SHPPalettesOver[sgRA2,sptLun]       := 'isolun';
  2440.  SHPPalettesOver[sgRA2,sptDes]       := 'isodes';
  2441.  SHPPalettesOver[sgRA2,sptNewurb]    := 'isourn';
  2442.  
  2443.  SHP_Palette_Directory := ExtractFileDir(ParamStr(0))+'\palette\';
  2444.  
  2445. finalization
  2446.  
  2447. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top