bmppalettes.pas

wbs43open-src.zip 数字隐藏工具

unit BMPPalettes;

interface

  uses Classes;

  type
    TRGBA = Array[0..3] of Byte;

    TPaletteHashTable = Array[0..255] of Byte;

    THistogram = Array[0..255] of Integer;

    TBMPPalette = class
      protected
        bitPixel:    Byte;
        procedure ReadPal(bitpix: Byte; str: TStream);
        procedure WritePal(str: TStream; Offset: Longint; bitpix: Byte);
        function EncodeRGBA(r,g,b,a: Byte): TRGBA;
        function Red(c: TRGBA): Byte;
        function Green(c: TRGBA): Byte;
        function Blue(c: TRGBA): Byte;
        function Alpha(c: TRGBA): Byte;
      public
        Data:        Array[0..255] of TRGBA;
        procedure SetBitPixel(b: Byte);
        function GetBitPixel: Byte;
        procedure Read(str: TStream);
        procedure ReadFromStream(str: TStream; offset: Longint);
        procedure Write(str: TStream; offset: Longint);
    end;

implementation

    procedure TBMPPalette.SetBitPixel(b: Byte);
    begin
      bitPixel:=b;
    end;

    function TBMPPalette.GetBitPixel: Byte;
    begin
      GetBitPixel:=bitPixel;
    end;

    procedure TBMPPalette.Read(str: TStream);
    begin
      if (bitPixel=4) or (bitPixel=8) then ReadPal(bitPixel,str);
    end;

    procedure TBMPPalette.ReadFromStream(str: TStream; offset: Longint);
    var
      n:        Integer;
      mstr:     TStream;
    begin
      n:=1 shl bitpixel;
      if (bitPixel=4) or (bitPixel=8) then begin
        mstr:=TMemoryStream.Create;
        str.Seek(offset,soFromBeginning);
        mstr.CopyFrom(str,n*4);
        Read(mstr);
        mstr.Free;
      end;
    end;

    procedure TBMPPalette.Write(str: TStream; Offset: Longint);
    begin
      if (bitPixel=4) or (bitPixel=8) then Writepal(str,Offset,bitPixel)
    end;

    procedure TBMPPalette.ReadPal(bitpix: Byte; str: TStream);
    var
      pal:      Array[0..1023] of Byte;
      i:        Integer;
      n:        Integer;
    begin
      n:=1 shl bitpix;
      str.Seek(0,soFromBeginning);
      str.Read(pal,4*n);
      for i:=0 to n-1 do begin
        Data[i]:=EncodeRGBA(pal[4*i+2],pal[4*i+1],pal[4*i],pal[4*i+3]);
      end;
    end;

    procedure TBMPPalette.WritePal(str: TStream; Offset: Longint; bitpix: Byte);
    var
      pal:      Array[0..1023] Of Byte;
      n:        Integer;
      i:        Integer;
    begin
      n:=1 shl bitpix;
      for i:=0 to n-1 do begin
        pal[4*i]:=Blue(Data[i]);
        pal[4*i+1]:=Green(Data[i]);
        pal[4*i+2]:=Red(Data[i]);
        pal[4*i+3]:=Alpha(Data[i]);
      end;
      str.Seek(Offset,soFromBeginning);
      str.Write(pal,4*n);
    end;

    function TBMPPalette.EncodeRGBA(r,g,b,a: Byte): TRGBA;
    var
      col:    TRGBA;
    begin
      col[0]:=r;
      col[1]:=g;
      col[2]:=b;
      col[3]:=a;
      EncodeRGBA:=col;
    end;

    function TBMPPalette.Red(c: TRGBA): Byte;
    begin
      Red:=c[0];
    end;

    function TBMPPalette.Green(c: TRGBA): Byte;
    begin
      Green:=c[1];
    end;

    function TBMPPalette.Blue(c: TRGBA): Byte;
    begin
      Blue:=c[2];
    end;

    function TBMPPalette.Alpha(c: TRGBA): Byte;
    begin
      Alpha:=c[3];
    end;

end.