graphicex.pas

很管用的GIS控件

unit GraphicEx;

// (c) Copyright 1999, 2000  Dipl. Ing. Mike Lischke ([e-mail]). All rights reserved.
//
// This package is freeware for non-commercial use only.
// Contact author for licenses ([e-mail]) and see License.txt which comes with the package.
//
// GraphicEx -
//   This unit is an addendum to Graphics.pas, in order to enable your application
//   to import many common graphic files.
//
// See help file for a description of supported image types. Additionally, there is a resample routine
// (Stretch) based on code from Anders Melander (http://www.melander.dk/delphi/resampler/index.html)
// which has been optimized quite a lot to work faster and bug fixed.
//
// version - 9.9
//
// 03-SEP-2000 ml:
//   EPS with alpha channel, workaround for TIFs with wrong alpha channel indication,
//   workaround for bad packbits compressed (TIF) images
// 28-AUG-2000 ml:
//   small bugfixes
// 27-AUG-2000 ml:
//   changed all FreeMemory(P) calls back to ... if Assigned(P) then FreeMem(P); ...
// 24-AUG-2000 ml:
//   small bug in LZ77 decoder removed
// 18-AUG-2000 ml:
//   TIF deflate decoding scheme
// 15-AUG-2000 ml:
//   workaround for TIF images without compression, but prediction scheme set (which is not really used in this case)
// 12-AUG-2000 ml:
//   small changes 
//
// For older history please look into the help file.
//
// Note: The library provides usually only load support for the listed image formats but will perhaps be enhanced
//       in the future to save those types too. It can be compiled with Delphi 4 or newer versions.
//
//
// (c) Copyright 1999, 2000  Dipl. Ing. Mike Lischke ([e-mail]). All rights reserved.
//
// This package is freeware for non-commercial use only!
// Contact author for licenses ([e-mail]) and see License.txt which comes with the package.

interface

{$I GraphicConfiguration.inc}

uses
  Windows, Classes, ExtCtrls, Graphics, SysUtils, JPEG,
  GraphicCompression, GraphicStrings, GraphicColor;

type
  TCardinalArray = array of Cardinal;
  TByteArray = array of Byte;
  TFloatArray = array of Single;

  TImageOptions = set of (
    ioTiled,       // image consists of tiles not strips (TIF)
    ioBigEndian,   // byte order in values >= words is reversed (TIF, RLA, SGI)
    ioMinIsWhite,  // minimum value in grayscale palette is white not black (TIF)
    ioReversed,    // bit order in bytes is reveresed (TIF)
    ioUseGamma     // gamma correction is used
  );

  // describes the compression used in the image file
  TCompressionType = (
    ctUnknown,     // compression type is unknown
    ctNone,        // no compression at all
    ctRLE,         // run length encoding
    ctPackedBits,  // Macintosh packed bits
    ctLZW,         // Lempel-Zif-Welch
    ctFax3,        // CCITT T.4 (1d), also known as fax group 3
    ctFaxRLE,      // modified Huffman (CCITT T.4 derivative)
    ctFax4,        // CCITT T.6, also known as fax group 4
    ctFaxRLEW,     // CCITT T.4 with word alignment
    ctLZ77,        // Hufman inflate/deflate
    ctJPEG,        // TIF JPEG compression (new version)
    ctOJPEG,       // TIF JPEG compression (old version)
    ctThunderscan, // TIF thunderscan compression
    ctNext,
    ctIT8CTPAD,
    ctIT8LW,
    ctIT8MP,
    ctIT8BL,
    ctPixarFilm,
    ctPixarLog,
    ctDCS,
    ctJBIG,
    ctPCDHuffmann  // PhotoCD Hufman compression
  );

  // properties of a particular image which are set while loading an image or when
  // they are explicitly requested via ReadImageProperties
  PImageProperties = ^TImageProperties;
  TImageProperties = record
    Version: Cardinal;                 // TIF, PSP, GIF
    Options: TImageOptions;            // all images
    Width,                             // all images
    Height: Cardinal;                  // all images
    ColorScheme: TColorScheme;         // all images
    BitsPerSample,                     // all Images
    SamplesPerPixel,                   // all images
    BitsPerPixel: Byte;                // all images
    Compression: TCompressionType;     // all images
    FileGamma: Single;                 // RLA, PNG
    XResolution,
    YResolution: Single;               // given in dpi (TIF, PCX, PSP)
    Interlaced,                        // GIF, PNG
    HasAlpha: Boolean;                 // TIF, PNG

    // informational data, used internally and/or by decoders
    // TIF
    FirstIFD,
    PlanarConfig,                      // most of this data is needed in the JPG decoder
    CurrentRow,
    TileWidth,
    TileLength,
    BytesPerLine: Cardinal;
    RowsPerStrip: TCardinalArray;
    YCbCrSubSampling,
    JPEGTables: TByteArray;
    JPEGColorMode,
    JPEGTablesMode: Cardinal;
    CurrentStrip,
    StripCount,
    Predictor: Integer;
    // EzGis needed in TIFF
    EzStream: TStream;
    EzDecoder: TDecoder;
    // dynamically assigned handler
    EzDeprediction: procedure(P: Pointer; Count: Cardinal);
    EzOffsets, EzByteCounts: TCardinalArray;

    // PCD
    Overview: Boolean;                 // true if image is an overview image
    Rotate: Byte;                      // describes how the image is rotated (aka landscape vs. portrait image)
    ImageCount: Word;                  // number of subimages if this is an overview image

    // GIF
    LocalColorTable: Boolean;          // image uses an own color palette instead of the global one

    // RLA
    BottomUp: Boolean;                 // images is bottom to top

    // PSD
    Channels: Byte;                    // up to 24 channels per image

    // PNG
    FilterMode: Byte;                 
  end;

  // This is the general base class for all image types implemented in GraphicEx.
  // It contains some generally used class/data.
  TGraphicExGraphic = class(TBitmap)
  private
    FColorManager: TColorManager;
    FImageProperties: TImageProperties;
    FBasePosition: Cardinal;  // stream start position
    FStream: TStream;         // used for local references of the stream the class is currently loading from
    FProgressRect: TRect;
  public
    constructor Create; override;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    class function CanLoad(const FileName: String): Boolean; overload; virtual;
    class function CanLoad(Stream: TStream): Boolean; overload; virtual; 
    procedure LoadFromResourceName(Instance: THandle; const ResName: String);
    procedure LoadFromResourceID(Instance: THandle; ResID: Integer);
    function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; virtual;

    property ColorManager: TColorManager read FColorManager;
    property ImageProperties: TImageProperties read FImageProperties write FImageProperties;
  end;

  TGraphicExGraphicClass = class of TGraphicExGraphic;
   
  {$ifdef SGIGraphic}
  // *.bw, *.rgb, *.rgba, *.sgi images
  TSGIGraphic = class(TGraphicExGraphic)
  private
    FRowStart,
    FRowSize: TCardinalArray;    // start and length of a line (if compressed)
    FDecoder: TDecoder;          // ...same applies here
    procedure ReadAndDecode(Red, Green, Blue, Alpha: Pointer; Row, BPC: Cardinal);
  public
    class function CanLoad(Stream: TStream): Boolean; override;
    procedure LoadFromStream(Stream: TStream); override;
    function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; override;
  end;
  {$endif}

  {$ifdef AutodeskGraphic}
  // *.cel, *.pic images
  TAutodeskGraphic = class(TGraphicExGraphic)
  public
    class function CanLoad(Stream: TStream): Boolean; override;
    procedure LoadFromStream(Stream: TStream); override;
    function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; override;
  end;
  {$endif}

  {$ifdef TIFFGraphic}
  // *.tif, *.tiff images
  // one entry in a an IFD (image file directory)
  TIFDEntry = packed record
    Tag: Word;
    DataType: Word;
    DataLength: Cardinal;
    Offset: Cardinal;
  end;

  TTIFFPalette = array[0..787] of Word;

  TTIFFGraphic = class(TGraphicExGraphic)
  private
    FIFD: array of TIFDEntry; // the tags of one image file directory
    FPalette: TTIFFPalette;
    FYCbCrPositioning: Cardinal;
    FYCbCrCoefficients: TFloatArray;
    function FindTag(Tag: Cardinal; var Index: Cardinal): Boolean;
    procedure GetValueList(Stream: TStream; Tag: Cardinal; var Values: TByteArray); overload;
    procedure GetValueList(Stream: TStream; Tag: Cardinal; var Values: TCardinalArray); overload;
    procedure GetValueList(Stream: TStream; Tag: Cardinal; var Values: TFloatArray); overload;
    function GetValue(Stream: TStream; Tag: Cardinal; Default: Single = 0): Single; overload;
    function GetValue(Tag: Cardinal; Default: Cardinal = 0): Cardinal; overload;
    function GetValue(Tag: Cardinal; var Size: Cardinal; Default: Cardinal = 0): Cardinal; overload;
    procedure SortIFD;
    procedure SwapIFD;
  public
    class function CanLoad(Stream: TStream): Boolean; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; override;

    // EzGis methods added
    procedure EzOpen(const FileName: string);
    procedure EzOpenFromStream(AStream: TStream);
    procedure EzReadStrips(StartStrip, StopStrip: Integer);
    procedure EzClose;
    procedure EzCloseFromStream;
  end;

    {$ifdef EPSGraphic}
    TEPSGraphic = class(TTIFFGraphic)
    public
      class function CanLoad(Stream: TStream): Boolean; override;
      procedure LoadFromStream(Stream: TStream); override;
      function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; override;
    end;
    {$endif} // EPSGraphic
  {$endif} // TIFFGraphic

  {$ifdef TargaGraphic}
  // *.tga; *.vst; *.icb; *.vda; *.win images
  TTargaGraphic = class(TGraphicExGraphic)
   public
    class function CanLoad(Stream: TStream): Boolean; override;
    procedure LoadFromStream(Stream: TStream); override;
    function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; override;
    procedure SaveToStream(Stream: TStream); overload; override;
    procedure SaveToStream(Stream: TStream; Compressed: Boolean); reintroduce; overload;
  end;
  {$endif}

  {$ifdef PCXGraphic}
  // *.pcx; *.pcc; *.scr images
  // Note: Due to the badly designed format a PCX/SCR file cannot be part in a larger stream because the position of the
  //       color palette as well as the decoding size can only be determined by the size of the image.
  //       Hence the image must be the only one in the stream or the last one.
  TPCXGraphic = class(TGraphicExGraphic)
  public
    class function CanLoad(Stream: TStream): Boolean; override;
    procedure LoadFromStream(Stream: TStream); override;
    function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; override;
  end;
  {$endif}

  {$ifdef PCDGraphic}
  // *.pcd images
  // Note: By default the BASE resolution of a PCD image is loaded with LoadFromStream. 
  TPCDGraphic = class(TGraphicExGraphic)
  public
    class function CanLoad(Stream: TStream): Boolean; override;
    procedure LoadFromStream(Stream: TStream); override;
    function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; override;
  end;
  {$endif}

  {$ifdef PortableMapGraphic}
  // *.ppm, *.pgm, *.pbm images
  TPPMGraphic = class(TGraphicExGraphic)
  private
    FBuffer: array[0..4095] of Char;
    FIndex: Integer;
    function CurrentChar: Char;
    function GetChar: Char;
    function GetNumber: Cardinal;
    function ReadLine: String;
  public
    class function CanLoad(Stream: TStream): Boolean; override;
    procedure LoadFromStream(Stream: TStream); override;
    function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; override;
  end;
  {$endif}

  {$ifdef CUTGraphic}
  // *.cut (+ *.pal) images
  // Note: Also this format should not be used in a stream unless it is the only image or the last one!
  TCUTGraphic = class(TGraphicExGraphic)
  private
    FPaletteFile: String;
  protected
    procedure LoadPalette;
  public
    class function CanLoad(Stream: TStream): Boolean; override;
    procedure LoadFromFile(const FileName: String); override;
    procedure LoadFromStream(Stream: TStream); override;
    function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; override;

    property PaletteFile: String read FPaletteFile write FPaletteFile;
  end;
  {$endif}

  {$ifdef GIFGraphic}
  // *.gif images
  TGIFGraphic = class(TGraphicExGraphic)
  private
    function SkipExtensions: Byte;
  public
    class function CanLoad(Stream: TStream): Boolean; override;
    procedure LoadFromStream(Stream: TStream); override;
    function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; override;
  end;
  {$endif}

  {$ifdef RLAGraphic}
  // *.rla, *.rpf images
  // implementation based on code from Dipl. Ing. Ingo Neumann ([e-mail], [e-mail])
  TRLAGraphic = class(TGraphicExGraphic)
  private
    procedure SwapHeader(var Header); // start position of the image header in the stream
  public
    class function CanLoad(Stream: TStream): Boolean; override;
    procedure LoadFromStream(Stream: TStream); override;
    function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; override;
  end;
  {$endif}

  {$ifdef PhotoshopGraphic}
  // *.psd, *.pdd images
  TPSDGraphic = class(TGraphicExGraphic)
  public
    class function CanLoad(Stream: TStream): Boolean; override;
    procedure LoadFromStream(Stream: TStream); override;
    function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; override;
  end;
  {$endif}

  {$ifdef PaintshopProGraphic}
  // *.psp images (file version 3 and 4)
  TPSPGraphic = class(TGraphicExGraphic)
  public
    class function CanLoad(Stream: TStream): Boolean; override;
    procedure LoadFromStream(Stream: TStream); override;
    function ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean; override;
  end;
  {$endif}