palettes.pas

wbs43open-src.zip 数字隐藏工具

unit Palettes;

{ Palette Color Depth Transformation

  Version 1.02.16

  created september 18, 1997
}

interface

  uses Bitmaps;

  type
    BMPPalTransform = Record
      Even:     Byte;
      Odd:      Byte;
    End;
    BMPTransPalette = Array[0..255] Of BMPPalTransform;

  procedure CreateNewPal(Var Palette: BMPPalette; CU: BMPColorUsage; Var PT: BMPTransPalette);

   { procedure savepalette(p1,p2: bmppalette; t: bmptranspalette; n: string); }


implementation

  {previous version
   ----------------

  procedure CreateNewPal(Var Palette: BMPPalette; CU: BMPColorUsage; Var PT: BMPTransPalette);
  var
    NNPool:    Byte;
    NewPal:    BMPPalette;
    i:         Byte;
  begin
    NNPool:=0;
    NewPal.Error:=False;
    NewPal:=Palette;
    for i:=0 to palette.colors do begin
      PT[i].Even:=i;
      PT[i].Odd:=i;
      cu.used[i]:=false;
    end;
    For i:=0 To Palette.Colors Do Begin
      If CU.Used[i] Then Begin
        PT[i].Even:=NNPool;
        NewPal.Values[NNPool]:=Palette.Values[i];
        PT[i].Odd:=NNPool+1;
        NewPal.Values[NNPool+1]:=Palette.Values[i];
        Inc(NNPool,2);
      End;
    End;
    savepalette(palette,newpal,pt,'j:\trans.txt');
    Palette:=NewPal;
  end;

 { -------------------------------------------------------
  }
 {   procedure savepalette(p1,p2: bmppalette; t: bmptranspalette; n: string);
  var
     f:   textfile;
     i,j: integer;
  begin
    assignfile(f,n);
    rewrite(f);
    for i:=0 to 255 do begin
        for j:=0 to 2 do begin
              write(f,inttostr(p1.values[i,j])+' ');
        end;
        write(f,' - ');
        for j:=0 to 2 do begin
              write(f,inttostr(p2.values[t[i].even,j])+' ');
        end;
        writeln(f,' ');
    end;
    closefile(f);
  end;     }


  procedure CreateNewPal(Var Palette: BMPPalette; CU: BMPColorUsage; Var PT: BMPTransPalette);
  var
    NNPool:    Byte;
    NewPal:    BMPPalette;
    i:         Byte;
  begin
    NNPool:=0;
    NewPal.Error:=False;
    NewPal.Colors:=Palette.Colors;
    For i:=0 To Palette.Colors Do Begin
      NewPal.Values[i,0]:=0;
      NewPal.Values[i,1]:=0;
      NewPal.Values[i,2]:=0;
    End;
    For i:=0 To Palette.Colors Do Begin
      If CU.Used[i] Then Begin
        If Odd(NNPool) Then Begin
          PT[i].Odd:=NNPool;
          NewPal.Values[PT[i].Odd]:=Palette.Values[i];
          If NNPool<Trunc((Palette.Colors+1)/2)-1 Then PT[i].Even:=NNPool+Trunc((Palette.Colors+1)/2)+1
          Else PT[i].Even:=Trunc((Palette.Colors+1)/2);
          NewPal.Values[PT[i].Even]:=Palette.Values[i];
          Inc(NNPool);
        End
        Else Begin
          PT[i].Even:=NNPool;
          NewPal.Values[PT[i].Even]:=Palette.Values[i];
          If NNPool<Trunc((Palette.Colors+1)/2)-1 Then PT[i].Odd:=NNPool+Trunc((Palette.Colors+1)/2)+1
          Else PT[i].Odd:=Trunc((Palette.Colors+1)/2);
          NewPal.Values[PT[i].Odd]:=Palette.Values[i];
          Inc(NNPool);
        End;
      End;
    End;
    Palette:=NewPal;
  end;
                     
end.