evbfileformatpnm.pas

很好的源代码

unit EvBFileFormatPNM;
{ TEvBBitmapFileFormat extensions for reading (unix) PGM and PPM files }

interface

uses
  EvBGraphics, Graphics, Classes;

type
  TEvBPNMFileFormat = class(TEvBBitmapFileFormat)
  { The base class for PGM and PPM file format filters }
  private
    function ReadValue: Integer;
    procedure WriteValue(const Value: Integer);
    procedure WriteLineFeed;
  protected
    function ReadMagic: String;
    procedure ReadHeader;
    procedure WriteMagic(const Magic: String);
    procedure WriteHeader;
  end;

type
  TEvBPGMFileFormat = class(TEvBPNMFileFormat)
  { File format filter for reading and writing Portable GreyMap (PGM) files }
  public
    procedure ReadStream(const Stream: TStream); override;
    procedure WriteStream(const Stream: TStream); override;
  end;

type
  TEvBPPMFileFormat = class(TEvBPNMFileFormat)
  { File format filter for reading and writing Portable PixMap (PPM) files }
  private
    FRow: array of TEvBXYZ;
    procedure ReadRGB(const Bitmap: TBitmap; const Row: Integer);
    procedure WriteRGB(const Bitmap: TBitmap; const Row: Integer);
  public
    procedure ReadStream(const Stream: TStream); override;
    procedure WriteStream(const Stream: TStream); override;
  end;

implementation

uses
  SysUtils;

const
  PGMMagic = 'P5';
  PPMMagic = 'P6';

{ TEvBPNMFileFormat }

procedure TEvBPNMFileFormat.ReadHeader;
begin
  Bitmap.Width := ReadValue;
  Bitmap.Height := ReadValue;
  if ReadValue > 255 then
    // MaxValue should be < 256
    InvalidStream;
end;

function TEvBPNMFileFormat.ReadMagic: String;
begin
  SetLength(Result,2);
  Stream.ReadBuffer(Result[1],2);
end;

function TEvBPNMFileFormat.ReadValue: Integer;
var
  S: String;
  C: Char;
  I: Integer;
begin
  repeat
    repeat
      Stream.ReadBuffer(C,1);
    until (C > ' ');
    if C = '#' then repeat
      // Ignore comment
      Stream.ReadBuffer(C,1);
    until (C in [#10,#13]);
  until (C > ' ');

  SetLength(S,16);
  I := 0;
  while (C > ' ') and (C <> '#') and (I < 16) do begin
    Inc(I);
    S[I] := C;
    Stream.ReadBuffer(C,1);
  end;
  SetLength(S,I);
  Val(S,Result,I);
  if I <> 0 then
    InvalidStream;
end;

procedure TEvBPNMFileFormat.WriteHeader;
begin
  WriteValue(Bitmap.Width);
  WriteValue(Bitmap.Height);
  WriteValue(255); // MaxValue
end;

procedure TEvBPNMFileFormat.WriteLineFeed;
const
  LF: Char = #10;
begin
  Stream.WriteBuffer(LF,1);
end;

procedure TEvBPNMFileFormat.WriteMagic(const Magic: String);
begin
  Stream.WriteBuffer(Magic[1],Length(Magic));
  WriteLineFeed;
end;

procedure TEvBPNMFileFormat.WriteValue(const Value: Integer);
var
  S: String;
begin
  S := IntToStr(Value);
  Stream.WriteBuffer(S[1],Length(S));
  WriteLineFeed;
end;

{ TEvBPGMFileFormat }

procedure TEvBPGMFileFormat.ReadStream(const Stream: TStream);
var
  Y: Integer;
begin
  inherited;
  if ReadMagic <> PGMMagic then
    InvalidStream;
  Bitmap.PixelFormat := pf8Bit;
  ReadHeader;
  Bitmap.Palette := CreateGreyscalePalette;
  for Y := 0 to Bitmap.Height - 1 do
    Stream.ReadBuffer(Bitmap.ScanLine[Y]^,Bitmap.Width);
end;

procedure TEvBPGMFileFormat.WriteStream(const Stream: TStream);
var
  Y: Integer;
  B: TBitmap;
begin
  inherited;
  if (Bitmap.PixelFormat = pf8Bit) and IsGreyscalePalette(Bitmap.Palette) then
    B := Bitmap
  else
    B := CreateGreyscaleBitmapCopy;
  WriteMagic(PGMMagic);
  WriteHeader;
  for Y := 0 to B.Height - 1 do
    Stream.WriteBuffer(B.ScanLine[Y]^,B.Width);
end;

{ TEvBPPMFileFormat }

procedure TEvBPPMFileFormat.ReadRGB(const Bitmap: TBitmap; const Row: Integer);
var
  P: PEvBXYZ;
  B: Byte;
  I: Integer;
begin
  P := Bitmap.ScanLine[Row];
  Stream.ReadBuffer(P^,Bitmap.Width * 3);
  for I := 0 to Bitmap.Width - 1 do begin
    B := P.X;
    P.X := P.Z;
    P.Z := B;
    Inc(P);
  end;
end;

procedure TEvBPPMFileFormat.ReadStream(const Stream: TStream);
var
  Y: Integer;
begin
  inherited;
  if ReadMagic <> PPMMagic then
    InvalidStream;
  Bitmap.PixelFormat := pf24Bit;
  ReadHeader;
  for Y := 0 to Bitmap.Height - 1 do
    ReadRGB(Bitmap,Y);
end;

procedure TEvBPPMFileFormat.WriteRGB(const Bitmap: TBitmap; const Row: Integer);
var
  P, Q: PEvBXYZ;
  I: Integer;
begin
  P := Bitmap.ScanLine[Row];
  Q := @FRow[0];
  for I := 0 to Bitmap.Width - 1 do begin
    Q.X := P.Z;
    Q.Y := P.Y;
    Q.Z := P.X;
    Inc(P);
    Inc(Q);
  end;
  Stream.WriteBuffer(FRow[0],Bitmap.Width * 3);
end;

procedure TEvBPPMFileFormat.WriteStream(const Stream: TStream);
var
  Y: Integer;
  B: TBitmap;
begin
  inherited;
  if Bitmap.PixelFormat = pf24Bit then
    B := Bitmap
  else
    B := CreateTrueColorBitmapCopy;
  WriteMagic(PPMMagic);
  WriteHeader;
  SetLength(FRow,Bitmap.Width);
  for Y := 0 to B.Height - 1 do
    WriteRGB(B,Y);
end;

initialization
  TEvBBitmap.RegisterFileFormat('Portable GreyMap','.pgm',PGMMagic,TEvBPGMFileFormat,False);
  TEvBBitmap.RegisterFileFormat('Portable PixMap','.ppm',PPMMagic,TEvBPPMFileFormat,False);

end.