bitmaps.pas

wbs43open-src.zip 数字隐藏工具

unit Bitmaps;

{Bitmap Handling Unit Verison 1.02.16}

interface

  Type
    BMPHeader=Record
      Content:   Array[0..53] Of Byte;
      Width:     Longint;
      Height:    Longint;
      ColDepth:  Byte;
      DataSize:  Longint;
    End;
    BMPPaletteEntry=Array[0..3] Of Byte;
    BMPPalette=Record
      Error:     Boolean;
      Colors:    Byte;
      Values:    Array[0..255] Of BMPPaletteEntry;
    End;
    BMPColorUsage=Record
      Used:      Array[0..255] Of Boolean;
      Number:    Byte;
    End;

  procedure ReadBMPHeader(FileName: String; Var Header: BMPHeader);
  procedure ReadBMPPalette(FileName: String; Var Palette: BMPPalette);

  procedure WriteBMPHeader(FileName: String; Header: BMPHeader);
  procedure WriteBMPPalette(FileName: String; Palette: BMPPalette);

  procedure GetNoOfUsedColors(FileName: String; xHeader: BMPHeader; xPalette: BMPPalette; Var CU: BMPColorUsage);

implementation

  procedure ReadBMPHeader(FileName: String; Var Header: BMPHeader);
  var
    BMPFile:   File Of Byte;
    Data:      Byte;
    i:         Byte;
  begin
    AssignFile(BMPFile,FileName);
    Reset(BMPFile);
    For i:=0 To 53 Do Begin
      Seek(BMPFile,i);
      Read(BMPFile,Data);
      Header.Content[i]:=Data;
    End;
    CloseFile(BMPFile);
    With Header Do Begin
      Width:=Longint(Content[18])+Longint(Content[19]*$100)+Longint(Content[20]*$10000)+Longint(Content[21]*$1000000);
      Height:=Longint(Content[22])+Longint(Content[23]*$100)+Longint(Content[24]*$10000)+Longint(Content[25]*$1000000);
      ColDepth:=Content[28];
      DataSize:=Content[34]+Content[35]*$100+Content[36]*$10000+Content[37]*$1000000;
      If (Content[35] And $80)=$80 Then DataSize:=DataSize+$10000;
    End;
  end;

  procedure ReadBMPPalette(FileName: String; Var Palette: BMPPalette);
  var
    BMPFile:  File Of Byte;
    i:        Byte;
  begin
    Palette.Error:=True;
    If (Palette.Colors=1) Or (Palette.Colors=15) Or (Palette.Colors=255) Then Palette.Error:=False;
    If Not Palette.Error Then Begin
      Assign(BMPFile,FileName);
      Reset(BMPFile);
      For i:=0 To Palette.Colors Do Begin
        Seek(BMPFile,i*4+54);
        Read(BMPFile,Palette.Values[i,0]);
        Read(BMPFile,Palette.Values[i,1]);
        Read(BMPFile,Palette.Values[i,2]);
        Read(BMPFile,Palette.Values[i,3]);
      End;
      Close(BMPFile);
    End;
  end;

 procedure WriteBMPPalette(FileName: String; Palette: BMPPalette);
  var
    BMPFile:  File Of Byte;
    i:        Byte;
  begin
    Palette.Error:=True;
    If (Palette.Colors=1) Or (Palette.Colors=15) Or (Palette.Colors=255) Then Palette.Error:=False;
    If Not Palette.Error Then Begin
      Assign(BMPFile,FileName);
      Reset(BMPFile);
      For i:=0 To Palette.Colors Do Begin
        Seek(BMPFile,i*4+54);
        Write(BMPFile,Palette.Values[i,0]);
        Write(BMPFile,Palette.Values[i,1]);
        Write(BMPFile,Palette.Values[i,2]);
        Write(BMPFile,Palette.Values[i,3]);
      End;
      Close(BMPFile);
    End;
  end;


  procedure WriteBMPHeader(FileName: String; Header: BMPHeader);
  var
    BMPFile:   File Of Byte;
    Data:      Byte;
    i:         Byte;
  begin
    AssignFile(BMPFile,FileName);
    Reset(BMPFile);
    With Header Do Begin
      Content[18]:=Width And $000000FF;
      Content[19]:=(Width And $0000FF00) Shr 8;
      Content[20]:=(Width And $00FF0000) Shr 16;
      Content[21]:=(Width And $FF000000) Shr 24;
      Content[22]:=Height And $000000FF;
      Content[23]:=(Height And $0000FF00) Shr 8;
      Content[24]:=(Height And $00FF0000) Shr 16;
      Content[25]:=(Height And $FF000000) Shr 24;
      Content[28]:=ColDepth;
      Content[34]:=DataSize And $000000FF;
      Content[35]:=(DataSize And $0000FF00) Shr 8;
      Content[36]:=(DataSize And $00FF0000) Shr 16;
      Content[37]:=(DataSize And $FF000000) Shr 24;
    End;
    For i:=0 To 53 Do Begin
      Seek(BMPFile,i);
      Data:=Header.Content[i];
      Write(BMPFile,Data);
    End;
    Close(BMPFile);
  end;

  procedure GetNoOfUsedColors(FileName: String; xHeader: BMPHeader; xPalette: BMPPalette; Var CU: BMPColorUsage);
  var
    BMPFile:    File Of Byte;
    Base, xi:   Longint;
    Data:       Byte;
    x, j:       Byte;        
  begin
    For xi:=0 To 255 Do CU.Used[xi]:=False;
    AssignFile(BMPFile,FileName);
    Reset(BMPFile);
    Base:=54;
    Case xPalette.Colors Of
      1:   Inc(Base,8);
      15:  Inc(Base,64);
      255: Inc(Base,1024);
    End;
    Seek(BMPFile,Base);
    While Not(EOF(BMPFile)) Do Begin
      Read(BMPFile,Data);
      Case xPalette.Colors Of
        1:   For j:=0 To 7 Do Begin
               x:=1 Shl j;
               If (Data And x)=x Then CU.Used[1]:=True Else CU.Used[0]:=True;
             End;
        15:  Begin
               x:=(Data And $F0) Shr 4;
               CU.Used[x]:=True;
               x:=Data And $0F;
               CU.Used[x]:=True;
             End;
        255: CU.Used[Data]:=True;
      End;
    End;
    Close(BMPFile);
    CU.Number:=0;
    For xi:=0 To xPalette.Colors Do If CU.Used[xi] Then Inc(CU.Number);
  end;

end.