JPEG/GIF/BMP/PNG/PCX등 이미지 관련 정보를 간단히 얻기

JPEG/GIF/BMP/PNG/PCX등의 이미지를 이미지 컴포넌트를 사용하지 않고 간단히 이미지 정보를 얻을 수 있음

다음과같은 정보를 얻을 수 있습니다
  - 이미지 크기(width, heigjht)
  - 이미지 컬러수(Depth, 8, 24 ..)
  - 이미지 유형(BMP, JPEG, GIF...)
  - 파일크기

다음 유닛을 Uses 절에 추가후 사용
사용 예)

    
 

    ImageInfo := TDCImageInfo.Create;
    ImageInfo.ReadFile(AFileName);
    if ImageInfo.Depth=8 then
    begin
       ...
    end;
    ImageInfo.free;

. Unit : DCImageInfo.pas

 {*******************************************************************************

TDCImageInfo

?2001 David Crowell

www.davidcrowell.com

Description:
TDCImageInfo returns image type, dimensions, and color depth from GIF, JPEG, PNG,
BMP, PCX, and TIFF files.

This is a port of my CImageInfo class which was created with Visual Basic.

Usage:
var
  ImageInfo: TDCImageInfo;

Begin
  ImageInfo := TDCImageInfo.Create;
  ImageInfo.ReadFile('test.jpg');
  Writeln(ImageInfo.Width);  // etc...
  ImageInfo.Free;

*******************************************************************************}
unit DCImageInfo;

interface
uses SysUtils, Classes;

const
TIFF_WIDTH = 256;
TIFF_HEIGHT = 257;
TIFF_BITSPERSAMPLE = 258;
TIFF_BYTE = 1;
TIFF_WORD = 3;
TIFF_DWORD = 4;

{*******************************************************************************
image type enumeration
*******************************************************************************}
type
  TImageType = (itUnknown, itGIF, itJPEG, itPNG, itBMP, itPCX, itTIFF);

{*******************************************************************************
class declaration
*******************************************************************************}
type
  TDCImageInfo = Class(TObject)
  private
    ImageFile: TFileStream;
    FWidth: integer;
    FHeight: integer;
    FDepth: integer;
    FImageType: TImageType;
    FFileSize: integer;
    procedure ReadPNG;
    procedure ReadGIF;
    procedure ReadBMP;
    procedure ReadPCX;
    procedure ReadLETIFF;
    procedure ReadBETIFF;
    procedure ReadJPEG;
    procedure ResetValues;
    function Swap32(Value: Integer): Integer;

  public
    property Width: integer read FWidth;
    property Height: integer read FHeight;
    property Depth: integer read FDepth;
    property ImageType: TImageType read FImageType;
    property FileSize: integer read FFileSize;
    procedure ReadFile(const FileName: String);

end;

implementation

{*******************************************************************************
ReadFile
*******************************************************************************}
  procedure TDCImageInfo.ReadFile(const FileName: String);
  var
    Buffer: array[0..2] of Byte;

  begin

    // Clear any left over data...
    ResetValues;

    // Open the file
    Try
      ImageFile := TFileStream.Create(FileName, fmOpenRead);
    Except;
      Exit;
    End;

    FFileSize := ImageFile.Size;

    // read the first 3 bytes to determine file type
    Try
      ImageFile.ReadBuffer(Buffer, 3);
    Except;
      ImageFile.Free;
      Exit;
    End;

    // check for PNG
    if (Buffer[0] = 137) and (Buffer[1] = 80) and (Buffer[2] = 78) Then
    begin
      Try
        ReadPNG;
      Except
        ResetValues;
      End;
    end;

    // check for GIF
    if (Buffer[0] = 71) and (Buffer[1] = 73) and (Buffer[2] = 70) Then
    begin
      Try
        ReadGIF;
      Except
        ResetValues;
      End;
    end;

    // check for BMP
    if (Buffer[0] = 66) and (Buffer[1] = 77) Then
    begin
      Try
        ReadBMP;
      Except
        ResetValues;
      End;
    end;

    // check for PCX
    if (Buffer[0] = 10) Then
    begin
      Try
        ReadPCX;
      Except
        ResetValues;
      End;
    end;

    // check for TIFF (little endian)
    if (Buffer[0] = 73) and (Buffer[1] = 73) and (Buffer[2] = 42) Then
    begin
      Try
        ReadLETIFF;
      Except
        ResetValues;
      End;
    end;

    // check for TIFF (big endian)
    if (Buffer[0] = 77) and (Buffer[1] = 77) and (Buffer[2] = 42) Then
    begin
      Try
        ReadBETIFF;
      Except
        ResetValues;
      End;
    end;

    // if we haven't found the correct type by now, it's either invalid or
    // a JPEG
    if FImageType = itUnknown Then
    begin
      Try
        ReadJPEG;
      Except
        ResetValues;
      End;
    end;

    // clean up
    ImageFile.Free;

  end;

{*******************************************************************************
ReadPNG
*******************************************************************************}
  procedure TDCImageInfo.ReadPNG;
  var
    b: Byte;
    c: Byte;
    w: Word;

  begin
    FImageType := itPNG;
    ImageFile.Position := 24;

    ImageFile.ReadBuffer(b, 1);
    ImageFile.ReadBuffer(c, 1);

    // color depth
    Case c Of
      0: FDepth := b;  // greyscale
      2: FDepth := b * 3; // RGB
      3: FDepth := 8; // Palette based
      4: FDepth := b * 2; // greyscale with alpha
      6: FDepth := b * 4; // RGB with alpha
    Else
      FImageType := itUnknown;
    End;
    
    If FImageType = itPNG Then
    begin
      ImageFile.Position := 18;
      ImageFile.ReadBuffer(w, 2);
      FWidth := Swap(w);
      ImageFile.Position := 22;
      ImageFile.ReadBuffer(w, 2);
      FHeight := Swap(w);
    end;
  end;

{*******************************************************************************
ReadGIF
*******************************************************************************}
  procedure TDCImageInfo.ReadGIF;
  var
    b: Byte;
    w: Word;

  begin
    FImageType := itGIF;
    ImageFile.Position := 6;

    ImageFile.ReadBuffer(w, 2);
    FWidth := w;

    ImageFile.ReadBuffer(w, 2);
    FHeight := w;

    ImageFile.ReadBuffer(b, 1);
    FDepth := (b and 7) + 1;
  end;

{*******************************************************************************
ReadBMP
*******************************************************************************}
  procedure TDCImageInfo.ReadBMP;
  var
    b: Byte;
    w: Word;

  begin
    FImageType := itBMP;

    ImageFile.Position := 18;
    ImageFile.ReadBuffer(w, 2);
    FWidth := w;

    ImageFile.Position := 22;
    ImageFile.ReadBuffer(w, 2);
    FHeight := w;

    ImageFile.Position := 28;
    ImageFile.ReadBuffer(b, 1);
    FDepth := b;
  end;


{*******************************************************************************
ReadPCX
*******************************************************************************}
  procedure TDCImageInfo.ReadPCX;
  var
    b1: Byte;
    b2: Byte;
    X1: Word;
    X2: Word;
    Y1: Word;
    Y2: Word;

  begin
    FImageType := itPCX;

    ImageFile.Position := 3;
    ImageFile.ReadBuffer(b1, 1);
    ImageFile.ReadBuffer(X1, 2);
    ImageFile.ReadBuffer(Y1, 2);
    ImageFile.ReadBuffer(X2, 2);
    ImageFile.ReadBuffer(Y2, 2);
    ImageFile.Position := 65;
    ImageFile.ReadBuffer(b2, 1);

    FWidth := (X2 - X1) + 1;
    FHeight := (Y2 - Y1) + 1;
    FDepth := b1 * b2;
  end;

{*******************************************************************************
ReadLETIFF (little endian TIFF)
*******************************************************************************}
  procedure TDCImageInfo.ReadLETIFF;
  var
  pIFD: Integer;
  pEntry: Integer;
  NumEntries: Word;
  i: Integer;
  b: Byte;
  w: Word;
  w2: Word;
  w3: Word;
  dw: Integer;

  begin
    FImageType := itTIFF;

    // get pointer to IFD
    ImageFile.Position := 4;
    ImageFile.ReadBuffer(pIFD, 4);

    // get number of entries in the IFD
    ImageFile.Position := pIFD;
    ImageFile.ReadBuffer(NumEntries, 2);

    // loop through each entry
    For i := 0 to NumEntries - 1 do
    begin
      pEntry := pIFD + 2 + (12 * i);

      ImageFile.Position := pEntry;
      ImageFile.ReadBuffer(w, 2);

      // width
      if w = TIFF_WIDTH then
      begin
        ImageFile.ReadBuffer(w2, 2);
        ImageFile.Position := pEntry + 8;
        Case w2 of
          TIFF_BYTE:
          begin
            ImageFile.ReadBuffer(b, 1);
            FWidth := b;
          end;
          TIFF_WORD:
          begin
            ImageFile.ReadBuffer(w3, 2);
            FWidth := w3;
          end;
          TIFF_DWORD:
          begin
            ImageFile.ReadBuffer(dw, 4);
            FWidth := dw;
          end;
        Else
        FWidth := 0;
        end;
      end;   // end of TIFF_WIDTH

      // Height
      if w = TIFF_HEIGHT then
      begin
        ImageFile.ReadBuffer(w2, 2);
        ImageFile.Position := pEntry + 8;
        Case w2 of
          TIFF_BYTE:
          begin
            ImageFile.ReadBuffer(b, 1);
            FHeight := b;
          end;
          TIFF_WORD:
          begin
            ImageFile.ReadBuffer(w3, 2);
            FHeight := w3;
          end;
          TIFF_DWORD:
          begin
            ImageFile.ReadBuffer(dw, 4);
            FHeight := dw;
          end;
        Else
        FHeight := 0;
        end;
      end;   // end of TIFF_HEIGHT

      // Depth
      if w = TIFF_BITSPERSAMPLE then
      begin
        ImageFile.ReadBuffer(w2, 2);
        ImageFile.Position := pEntry + 8;
        Case w2 of
          TIFF_BYTE:
          begin
            ImageFile.ReadBuffer(b, 1);
            FDepth := b;
          end;
          TIFF_WORD:
          begin
            ImageFile.ReadBuffer(w3, 2);
            FDepth := w3;
          end;
          TIFF_DWORD:
          begin
            ImageFile.ReadBuffer(dw, 4);
            FDepth := dw;
          end;
        Else
        FDepth := 0;
        end;
      end;   // end of TIFF_BITSPERSAMPLE

    end; // end of loop

    if not((FWidth > 0) and (FHeight > 0) and (FDepth > 0)) then
      ResetValues;

  end;  // end of procedure

{*******************************************************************************
ReadBETIFF (big endian TIFF)
*******************************************************************************}
  procedure TDCImageInfo.ReadBETIFF;
  var
  pIFD: Integer;
  pEntry: Integer;
  NumEntries: Word;
  i: Integer;
  b: Byte;
  w: Word;
  w2: Word;
  w3: Word;
  dw: Integer;

  begin
    FImageType := itTIFF;

    // get pointer to IFD
    ImageFile.Position := 4;
    ImageFile.ReadBuffer(pIFD, 4);
    pIFD := Swap32(pIFD);

    // get number of entries in the IFD
    ImageFile.Position := pIFD;
    ImageFile.ReadBuffer(NumEntries, 2);
    NumEntries := Swap(NumEntries);

    // loop through each entry
    For i := 0 to NumEntries - 1 do
    begin
      pEntry := pIFD + 2 + (12 * i);

      ImageFile.Position := pEntry;
      ImageFile.ReadBuffer(w, 2);
      w := Swap(w);

      // width
      if w = TIFF_WIDTH then
      begin
        ImageFile.ReadBuffer(w2, 2);
        w2 := Swap(w2);
        ImageFile.Position := pEntry + 8;
        Case w2 of
          TIFF_BYTE:
          begin
            ImageFile.ReadBuffer(b, 1);
            FWidth := b;
          end;
          TIFF_WORD:
          begin
            ImageFile.ReadBuffer(w3, 2);
            FWidth := Swap(w3);
          end;
          TIFF_DWORD:
          begin
            ImageFile.ReadBuffer(dw, 4);
            FWidth := Swap32(dw);
          end;
        Else
        FWidth := 0;
        end;
      end;   // end of TIFF_WIDTH

      // Height
      if w = TIFF_HEIGHT then
      begin
        ImageFile.ReadBuffer(w2, 2);
        w2 := Swap(w2);
        ImageFile.Position := pEntry + 8;
        Case w2 of
          TIFF_BYTE:
          begin
            ImageFile.ReadBuffer(b, 1);
            FHeight := b;
          end;
          TIFF_WORD:
          begin
            ImageFile.ReadBuffer(w3, 2);
            FHeight := Swap(w3);
          end;
          TIFF_DWORD:
          begin
            ImageFile.ReadBuffer(dw, 4);
            FHeight := Swap32(dw);
          end;
        Else
        FHeight := 0;
        end;
      end;   // end of TIFF_HEIGHT

      // Depth
      if w = TIFF_BITSPERSAMPLE then
      begin
        ImageFile.ReadBuffer(w2, 2);
        w2 := Swap(w2);
        ImageFile.Position := pEntry + 8;
        Case w2 of
          TIFF_BYTE:
          begin
            ImageFile.ReadBuffer(b, 1);
            FDepth := b;
          end;
          TIFF_WORD:
          begin
            ImageFile.ReadBuffer(w3, 2);
            FDepth := Swap(w3);
          end;
          TIFF_DWORD:
          begin
            ImageFile.ReadBuffer(dw, 4);
            FDepth := Swap32(dw);
          end;
        Else
        FDepth := 0;
        end;
      end;   // end of TIFF_BITSPERSAMPLE

    end; // end of loop

    if not((FWidth > 0) and (FHeight > 0) and (FDepth > 0)) then
      ResetValues;

  end;  // end of procedure

{*******************************************************************************
ReadJPEG
*******************************************************************************}
  procedure TDCImageInfo.ReadJPEG;
  var
    Pos: Integer;
    w: Word;
    b: Byte;
    Buffer: array[0..2] of Byte;

  begin
    Pos :=0;

    // find beginning of JPEG stream
    While True do
    begin
      ImageFile.Position := Pos;
      ImageFile.ReadBuffer(Buffer, 3);
      if (Buffer[0] = $FF) and (Buffer[1] = $D8) and (Buffer[2] = $FF) then
        break;
      Pos := Pos + 1;
    end;

    Pos := Pos +1;

    // loop through each marker until we find the C0 marker (or C1 or C2) which
    // has the image information
    While True do
    begin

      // find beginning of next marker
      While True do
      begin
        ImageFile.Position := Pos;
        ImageFile.ReadBuffer(Buffer, 2);
        if (Buffer[0] = $FF) and (Buffer[1] <> $FF) then
          break;
        Pos := Pos + 1;
      end;

      // exit the loop if we've found the correct marker
      b := Buffer[1];
      if (b = $C0) or (b = $C1) or (b = $c2) or (b = $C3) then
        break;

      // otherwise find position of next marker
      ImageFile.Position := Pos + 2;
      ImageFile.ReadBuffer(w, 2);
      Pos := Pos + Swap(w);

      //writeln(pos);

    end;

    // if we haven't errored by this point then we're at the right
    // marker, and can retrieve the info

    FImageType := itJPEG;

    ImageFile.Position := Pos + 5;
    ImageFile.ReadBuffer(w, 2);
    FHeight := Swap(w);

    //ImageFile.Position := Pos + 6;
    ImageFile.ReadBuffer(w, 2);
    FWidth := Swap(w);

    //ImageFile.Position := Pos + 8;
    ImageFile.ReadBuffer(b, 1);
    FDepth := b * 8;

  end;

{*******************************************************************************
ResetValues
*******************************************************************************}
  procedure TDCImageInfo.ResetValues;
  begin
    FImageType := itUnknown;
    FWidth := 0;
    FHeight := 0;
    FDepth := 0;
  end;

{*******************************************************************************
Swap32
*******************************************************************************}
  function TDCImageInfo.Swap32(Value: Integer): Integer;
  var
    b1: Integer;
    b2: Integer;
    b3: Integer;
    b4: Integer;
    r: Integer;
  begin
    b1 := Value and 255;
    b2 := (Value shr 8) and 255;
    b3 := (Value shr 16) and 255;
    b4 := (Value shr 24) and 255;

    b1 := b1 shl 24;
    b2 := b2 shl 16;
    b3 := b3 shl 8;

    r := b1 or b2 or b3 or b4;

    result := r;
  end;
end.