procedure TMainForm.SB11Click(Sender: TObject);
var InputStream : TFileStream; OutputStream : TStream;
begin
 if OpenDialogFile.Execute then
  begin
   InputStream := TFileStream.Create(OpenDialogFile.FileName,fmOpenRead);
   OutputStream := TFileStream.Create(OpenDialogFile.FileName+'.packed',fmCreate);
   OutputStream.CopyFrom(InputStream,InputStream.Size);
   FreeAndNil(InputStream);
   OutputStream.Seek(0,soBeginning);
   CPS_Stream(OutputStream, coCompressOnly);
   FreeAndNil(OutputStream);
  end;
end;

TPRT = record
 Header : array[1..4] of char; //PRT+#0
 HeaderType : word; //101 (0x65) - 8-bit or w\o alpha header, 102 (0x66) - 24-bit or w\ alpha header
 Bitdepth : word; // Bits per pixel
 Offset1 : word; // PRT header size \ palette beginning offset
 Offset2 : word; // Picture data beginning offset
 Width : word; // Image Width
 Height : word; // Image Height
 UsesAlpha : longword; // Uses alpha or not (0x0000 - false, 0x0001 - true)
// Optional alpha-related data (not writed if HeaderType < 102)
 Unknown1 : longword; // ???
 Unknown2 : longword; // ???
 Unknown3 : longword; // ???
 Unknown4 : longword; // ???
end;

 TPRT = record
  Header     : array[1..4] of char; //PRT+#0
  HeaderType : word;                //101 (0x65) - 8-bit or w\o alpha header, 102 (0x66) - 24-bit or w\ alpha header
  Bitdepth   : word;                // Bits per pixel
  Offset1    : word;                // PRT header size \ palette beginning offset
  Offset2    : word;                // Picture data beginning offset
  Width      : word;                // Image Width
  Height     : word;                // Image Height
  UsesAlpha  : longword;            // Uses alpha or not (0x0000 - false, 0x0001 - true)
// Optional canvas data (not writed if HeaderType < 102)
  X          : longword;            // X render coordinate
  Y          : longword;            // Y render coordinate
  RealWidth  : longword;            // Real Image Width
  RealHeight : longword;            // Real Image Height
 end;

unit AnimED_Graphics_Extended;

interface

uses Classes, Sysutils{, AnimED_Math}; // Математический модуль в данном примере не нужен :)

{...}

{ palette table }
 TARGB = packed record
  B : byte; // Blue
  G : byte; // Green
  R : byte; // Red
  A : byte; // Alpha (partial transparency color)
 end;

 TPalette = packed record
  Palette : array[0..255] of TARGB;
 end;

{...}

function GrayscalePalette : TPalette;

procedure to32(InputStream, AlphaStream, OutputStream : TStream; Width, Height : integer; BitDepth : byte; Palette : TPalette);

implementation

{...}

{ Converts to BMP\TGA-compatible 32-bit RAW stream \ combines with external alpha }
procedure to32(InputStream, AlphaStream, OutputStream : TStream; Width, Height : integer; BitDepth : byte; Palette : TPalette);
var i, j, l, m, n,
    counter, acounter,
    ScanlineLen, aScanlineLen,
    InputStreamSize, AlphaStreamSize : integer;
    Gap, aGap, k : byte; // Gap is a number of gapped bytes
    TW : word;
    ARGB : TARGB;
begin
 k := 0;
 m := 0;
 n := 0;

 counter := 0;
 acounter := 0;

 InputStream.Seek(0,soBeginning);
 OutputStream.Seek(0,soBeginning);

{ Note: alpha is ALWAYS stored as 8-bit image ONLY and must be at the same sizes
  as original image (WxH), otherwise an error will occur }
 if AlphaStream <> nil then
  begin
   AlphaStream.Seek(0,soBeginning);
   aScanlineLen := ((Width + 3) shr 2) shl 2;
   aGap := aScanlineLen - Width;
   AlphaStreamSize := aScanLineLen * Height;
  end;

 case BitDepth of
  1 : begin
       for i := 1 to InputStream.Size do
        begin
         InputStream.Read(j,1);
         for k := 8 downto 1 do
          begin
           l := j shr k-1;
           l := l and $1;
           ARGB := Palette.Palette[l];
           if AlphaStream <> nil then
            begin
             inc(m);
             if m >= 3 then
              begin
               m := 0;
               AlphaStream.Read(ARGB.A,1);
               inc(acounter);
               if acounter = Width then
                begin
                 AlphaStream.Seek(aGap,soCurrent);
                 acounter := 0;
                end;
              end;
            end;
           OutputStream.Write(ARGB,4);
          end;
        end;
      end;
  4 : begin
       ScanlineLen := ((Width + 7) shr 3) shl 2;
       Gap := ScanlineLen - Width div 2;
       InputStreamSize := ScanLineLen * Height;
       for i := 1 to InputStreamSize do
        try
         InputStream.Read(j,1);
         inc(counter);
         if counter = (Width div 2) then
          begin
           InputStream.Seek(Gap,soCurrent);
           counter := 0;
          end;
         for l := 1 to 2 do
          begin
           case l of
            1 : k := j and $f;
            2 : k := j shr 4;
           end;
           ARGB := Palette.Palette[k];
           if AlphaStream <> nil then
            begin
             AlphaStream.Read(ARGB.A,1);
             inc(acounter);
             if acounter = Width then
              begin
               AlphaStream.Seek(aGap,soCurrent);
               acounter := 0;
              end;
            end;
           OutputStream.Write(ARGB,4);
          end;
        except
        end;
      end;
  8 : begin
       ScanlineLen := ((Width + 3) shr 2) shl 2;
       Gap := ScanlineLen - Width;
       InputStreamSize := ScanLineLen * Height;
       for i := 1 to InputStreamSize do
        try
         InputStream.Read(j,1);
         inc(counter);
         if counter = Width then
          begin
           InputStream.Seek(Gap,soCurrent);
           counter := 0;
          end;
         ARGB := Palette.Palette[j];
       { Replaces original alpha value with alpha channel }
         if AlphaStream <> nil then
          begin
           AlphaStream.Read(ARGB.A,1);
           inc(acounter);
           if acounter = Width then
            begin
             AlphaStream.Seek(aGap,soCurrent);
             acounter := 0;
            end;
          end;
         OutputStream.Write(ARGB,4);
        except
        end;
      end;
  16: begin
       ScanlineLen := ((Width * 2 + 3) shr 2) shl 2;
       Gap := ScanlineLen - Width * 2;
       InputStreamSize := ScanLineLen * Height;
       for i := 1 to InputStreamSize div 2 do
        begin
         InputStream.Read(tw,2);
         inc(counter,2);
         if counter = (Width * 2) then
          begin
           InputStream.Seek(Gap,soCurrent);
           counter := 0;
          end;
         ARGB.A := tw shr 15;
         ARGB.R := (tw shr 10) and $1F;
         ARGB.G := (tw shr 5) and $1F;
         ARGB.B := tw and $1F;
       { Replaces original alpha value with alpha channel }
         if AlphaStream <> nil then
          begin
           AlphaStream.Read(ARGB.A,1);
           inc(acounter);
           if acounter = Width then
            begin
             AlphaStream.Seek(aGap,soCurrent);
             acounter := 0;
            end;
          end;
         OutputStream.Write(ARGB,4);
        end;
      end;
  24: begin
       ScanlineLen := ((Width * 3 + 3) shr 2) shl 2;
       Gap := ScanlineLen - Width * 3;
       InputStreamSize := ScanLineLen * Height;
       for i := 1 to (InputStreamSize div 3) do
        begin
         InputStream.Read(ARGB.B,1);
         InputStream.Read(ARGB.G,1);
         InputStream.Read(ARGB.R,1);
         inc(counter,3);
         if counter = (Width * 3) then
          begin
           InputStream.Seek(Gap,soCurrent);
           counter := 0;
          end;
         ARGB.A := 0;
       { Replaces original alpha value with alpha channel }
         if AlphaStream <> nil then
          begin
           AlphaStream.Read(ARGB.A,1);
           inc(acounter);
           if acounter = Width then
            begin
             AlphaStream.Seek(aGap,soCurrent);
             acounter := 0;
            end;
          end;
         OutputStream.Write(ARGB,4);
        end;
      end;
  32: begin
       ScanlineLen := Width * 4;
       InputStreamSize := ScanlineLen * Height;
       for i := 1 to (InputStreamSize div 4) do
        begin
         InputStream.Read(ARGB,4);
       { Replaces original alpha channel with new alpha channel }
         if AlphaStream <> nil then
          begin
           AlphaStream.Read(ARGB.A,1);
           inc(acounter);
           if acounter = Width then
            begin
             AlphaStream.Seek(aGap,soCurrent);
             acounter := 0;
            end;
          end;
         OutputStream.Write(ARGB,4);
        end;
      end;
 end;
end;

function GrayscalePalette : TPalette;
var i : integer; Palette : TPalette; ARGB : TARGB;
begin
 for i := 0 to 255 do
  begin
   with ARGB do
    begin
     B := i;
     G := i;
     R := i;
     A := 0;
    end;
   Palette.Palette[i] := ARGB;
  end;
 GrayscalePalette := Palette;
end;

end.