graphicex.pas

lansd aslda sldasdnaslda sdlandslasd

      Result := (Swap(Header.Magic) = SGIMagic) and
                (Header.BPC in [1, 2]) and
                (Swap(Header.Dimension) in [1..3]);
      Position := LastPosition;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TSGIGraphic.ReadAndDecode(Red, Green, Blue, Alpha: Pointer; Row, BPC: Cardinal);

var
  Count: Cardinal;
  RawBuffer: Pointer;

begin
  with FStream, FImageProperties do
    // compressed image?
    if Assigned(FDecoder) then
    begin
      if Assigned(Red) then
      begin
        Position := FBasePosition + FRowStart[Row + 0 * Height];
        Count := BPC * FRowSize[Row + 0 * Height];
        GetMem(RawBuffer, Count);
        try
          Read(RawBuffer^, Count);
          FDecoder.Decode(RawBuffer, Red, Count, Width);
        finally
          if Assigned(RawBuffer) then FreeMem(RawBuffer);
        end;
      end;

      if Assigned(Green) then
      begin
        Position := FBasePosition + FRowStart[Row + 1 * Height];
        Count := BPC * FRowSize[Row + 1 * Height];
        GetMem(RawBuffer, Count);
        try
          Read(RawBuffer^, Count);
          FDecoder.Decode(RawBuffer, Green, Count, Width);
        finally
          if Assigned(RawBuffer) then FreeMem(RawBuffer);
        end;
      end;

      if Assigned(Blue) then
      begin
        Position := FBasePosition + FRowStart[Row + 2 * Height];
        Count := BPC * FRowSize[Row + 2 * Height];
        GetMem(RawBuffer, Count);
        try
          Read(RawBuffer^, Count);
          FDecoder.Decode(RawBuffer, Blue, Count, Width);
        finally
          if Assigned(RawBuffer) then FreeMem(RawBuffer);
        end;
      end;

      if Assigned(Alpha) then
      begin
        Position := FBasePosition + FRowStart[Row + 3 * Height];
        Count := BPC * FRowSize[Row + 3 * Height];
        GetMem(RawBuffer, Count);
        try
          Read(RawBuffer^, Count);
          FDecoder.Decode(RawBuffer, Alpha, Count, Width);
        finally
          if Assigned(RawBuffer) then FreeMem(RawBuffer);
        end;
      end;
    end
    else
    begin
      if Assigned(Red) then
      begin
        Position := FBasePosition + 512 + (Row * Width);
        Read(Red^, BPC * Width);
      end;

      if Assigned(Green) then
      begin
        Position := FBasePosition + 512 + (Row * Width) + (Width * Height);
        Read(Green^, BPC * Width);
      end;

      if Assigned(Blue) then
      begin
        Position := FBasePosition + 512 + (Row * Width) + (2 * Width * Height);
        Read(Blue^, BPC * Width);
      end;

      if Assigned(Alpha) then
      begin
        Position := FBasePosition + 512 + (Row * Width) + (3 * Width * Height);
        Read(Alpha^, BPC * Width);
      end;
    end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TSGIGraphic.LoadFromStream(Stream: TStream);

var
  Y: Cardinal;
  RedBuffer,
  GreenBuffer,
  BlueBuffer,
  AlphaBuffer: Pointer;
  Header: TSGIHeader;
  Count: Cardinal;

begin
  // free previous image
  Handle := 0;

  // keep stream reference and start position for seek operations
  FStream := Stream;
  FBasePosition := Stream.Position;

  if ReadImageProperties(Stream, 0) then
  begin
    with FImageProperties, Stream do
    begin
      FProgressRect := Rect(0, 0, Width, 1);
      Progress(Self, psStarting, 0, False, FProgressRect, gesPreparing);

      Stream.Position := FBasePosition;
      // read header again, we need some additional information
      ReadBuffer(Header, SizeOf(Header));

      // SGI images are always stored in big endian style
      ColorManager.SourceOptions := [coNeedByteSwap];
      with Header do ColorMap := SwapLong(ColorMap);

      if Compression = ctRLE then
      begin
        Count := Height * SamplesPerPixel;
        SetLength(FRowStart, Count);
        SetLength(FRowSize, Count);
        // read line starts and sizes from stream
        Read(FRowStart[0], Count * SizeOf(Cardinal));
        SwapLong(@FRowStart[0], Count);
        Read(FRowSize[0], Count * SizeOf(Cardinal));
        SwapLong(@FRowSize[0], Count);
        FDecoder := TSGIRLEDecoder.Create(BitsPerSample);
      end
      else
      begin
        FDecoder := nil;
      end;

      // set pixel format before size to avoid possibly large conversion operation
      with ColorManager do
      begin
        SourceBitsPerSample := BitsPerSample;
        TargetBitsPerSample := 8;
        SourceSamplesPerPixel := SamplesPerPixel;
        TargetSamplesPerPixel := SamplesPerPixel;
        SourceColorScheme := ColorScheme;
        case ColorScheme of
          csRGBA:
            TargetColorScheme := csBGRA;
          csRGB:
            TargetColorScheme := csBGR;
        else
          TargetColorScheme := csIndexed;
        end;
        PixelFormat := TargetPixelFormat;
      end;
      Self.Width := Width;
      Self.Height := Height;

      RedBuffer := nil;
      GreenBuffer := nil;
      BlueBuffer := nil;
      AlphaBuffer := nil;
      Progress(Self, psEnding, 100, True, FProgressRect, '');

      Progress(Self, psStarting, 0, False, FProgressRect, gesTransfering);
      try
        Count := (BitsPerPixel div 8) * Width;
        // read lines and put them into the bitmap
        case ColorScheme of
          csRGBA:
            begin
              GetMem(RedBuffer, Count);
              GetMem(GreenBuffer, Count);
              GetMem(BlueBuffer, Count);
              GetMem(AlphaBuffer, Count);
              for  Y := 0 to Height - 1 do
              begin
                ReadAndDecode(RedBuffer, GreenBuffer, BlueBuffer, AlphaBuffer, Y, Header.BPC);
                ColorManager.ConvertRow([RedBuffer, GreenBuffer, BlueBuffer, AlphaBuffer],
                                        ScanLine[Height - Y - 1], Width, $FF);
                Progress(Self, psRunning, MulDiv(Y, 100, Height), True, FProgressRect, '');
                OffsetRect(FProgressRect, 0, 1);
              end;
            end;
          csRGB:
            begin
              GetMem(RedBuffer, Count);
              GetMem(GreenBuffer, Count);
              GetMem(BlueBuffer, Count);
              for  Y := 0 to Height - 1 do
              begin
                ReadAndDecode(RedBuffer, GreenBuffer, BlueBuffer, nil, Y, Header.BPC);
                ColorManager.ConvertRow([RedBuffer, GreenBuffer, BlueBuffer],
                                        ScanLine[Height - Y - 1], Width, $FF);
                Progress(Self, psRunning, MulDiv(Y, 100, Height), True, FProgressRect, '');
                OffsetRect(FProgressRect, 0, 1);
              end;
            end;
        else
          // any other format is interpreted as being 256 gray scales
          Palette := ColorManager.CreateGrayscalePalette(False);
          for  Y := 0 to Height - 1 do
          begin
            ReadAndDecode(ScanLine[Height - Y - 1], nil, nil, nil, Y, Header.BPC);
            Progress(Self, psRunning, MulDiv(Y, 100, Height), True, FProgressRect, '');
            OffsetRect(FProgressRect, 0, 1);
          end;
        end;

      finally
        Progress(Self, psEnding, 100, True, FProgressRect, '');

        if Assigned(RedBuffer) then FreeMem(RedBuffer);
        if Assigned(GreenBuffer) then FreeMem(GreenBuffer);
        if Assigned(BlueBuffer) then FreeMem(BlueBuffer);
        if Assigned(AlphaBuffer) then FreeMem(AlphaBuffer);
        FDecoder.Free;
      end;
    end;
  end
  else GraphicExError(gesInvalidImage, ['sgi, bw or rgb(a)']);
end;

//----------------------------------------------------------------------------------------------------------------------

function TSGIGraphic.ReadImageProperties(Stream: TStream; ImageIndex: Cardinal): Boolean;

var
  Header: TSGIHeader;
 
begin
  Result := inherited ReadImageProperties(Stream, ImageIndex);
  with FImageProperties do
  begin
    Stream.ReadBuffer(Header, SizeOf(Header));
    if Swap(Header.Magic) = SGIMagic then
    begin 
      Options := [ioBigEndian];
      BitsPerSample := Header.BPC * 8;
      Width := Swap(Header.XSize);
      Height := Swap(Header.YSize);
      SamplesPerPixel := Swap(Header.ZSize);
      case SamplesPerPixel of
        4:
          ColorScheme := csRGBA;
        3:
          ColorScheme := csRGB;
      else
        // all other is considered as being 8 bit gray scale
        ColorScheme := csIndexed;
      end;

      BitsPerPixel := BitsPerSample * SamplesPerPixel;
      if Header.Storage = SGI_COMPRESSION_RLE then Compression := ctRLE
                                              else Compression := ctNone;
      Result := True;
    end;
  end;
end;

{$endif} // SGIGraphic

//----------------- TTIFFGraphic ---------------------------------------------------------------------------------------

{$ifdef TIFFGraphic}

const // TIFF tags
  TIFFTAG_SUBFILETYPE = 254;                     // subfile data descriptor
    FILETYPE_REDUCEDIMAGE = $1;                  // reduced resolution version
    FILETYPE_PAGE = $2;                          // one page of many
    FILETYPE_MASK = $4;                          // transparency mask
  TIFFTAG_OSUBFILETYPE = 255;                    // kind of data in subfile (obsolete by revision 5.0)
    OFILETYPE_IMAGE = 1;                         // full resolution image data
    OFILETYPE_REDUCEDIMAGE = 2;                  // reduced size image data
    OFILETYPE_PAGE = 3;                          // one page of many
  TIFFTAG_IMAGEWIDTH = 256;                      // image width in pixels
  TIFFTAG_IMAGELENGTH = 257;                     // image height in pixels
  TIFFTAG_BITSPERSAMPLE = 258;                   // bits per channel (sample)
  TIFFTAG_COMPRESSION = 259;                     // data compression technique
    COMPRESSION_NONE = 1;                        // dump mode
    COMPRESSION_CCITTRLE = 2;                    // CCITT modified Huffman RLE
    COMPRESSION_CCITTFAX3 = 3;                   // CCITT Group 3 fax encoding
    COMPRESSION_CCITTFAX4 = 4;                   // CCITT Group 4 fax encoding
    COMPRESSION_LZW = 5;                         // Lempel-Ziv & Welch
    COMPRESSION_OJPEG = 6;                       // 6.0 JPEG (old version)
    COMPRESSION_JPEG = 7;                        // JPEG DCT compression (new version)
    COMPRESSION_ADOBE_DEFLATE = 8;               // new id but same as COMPRESSION_DEFLATE
    COMPRESSION_NEXT = 32766;                    // next 2-bit RLE
    COMPRESSION_CCITTRLEW = 32771;               // modified Huffman with word alignment
    COMPRESSION_PACKBITS = 32773;                // Macintosh RLE
    COMPRESSION_THUNDERSCAN = 32809;             // ThunderScan RLE
    // codes 32895-32898 are reserved for ANSI IT8 TIFF/IT <[e-mail])
    COMPRESSION_IT8CTPAD = 32895;                // IT8 CT w/padding
    COMPRESSION_IT8LW = 32896;                   // IT8 Linework RLE
    COMPRESSION_IT8MP = 32897;                   // IT8 Monochrome picture
    COMPRESSION_IT8BL = 32898;                   // IT8 Binary line art
    // compression codes 32908-32911 are reserved for Pixar
    COMPRESSION_PIXARFILM = 32908;               // Pixar companded 10bit LZW
    COMPRESSION_PIXARLOG = 32909;                // Pixar companded 11bit ZIP
    COMPRESSION_DEFLATE = 32946;                 // Deflate compression (LZ77)
    // compression code 32947 is reserved for Oceana Matrix <[e-mail]>
    COMPRESSION_DCS = 32947;                     // Kodak DCS encoding
    COMPRESSION_JBIG = 34661;                    // ISO JBIG
  TIFFTAG_PHOTOMETRIC = 262;                     // photometric interpretation
    PHOTOMETRIC_MINISWHITE = 0;                  // min value is white
    PHOTOMETRIC_MINISBLACK = 1;                  // min value is black
    PHOTOMETRIC_RGB = 2;                         // RGB color model
    PHOTOMETRIC_PALETTE = 3;                     // color map indexed
    PHOTOMETRIC_MASK = 4;                        // holdout mask
    PHOTOMETRIC_SEPARATED = 5;                   // color separations
    PHOTOMETRIC_YCBCR = 6;                       // CCIR 601
    PHOTOMETRIC_CIELAB = 8;                      // 1976 CIE L*a*b*
  TIFFTAG_THRESHHOLDING = 263;                   // thresholding used on data (obsolete by revision 5.0)
    THRESHHOLD_BILEVEL = 1;                      // b&w art scan
    THRESHHOLD_HALFTONE = 2;                     // or dithered scan
    THRESHHOLD_ERRORDIFFUSE = 3;                 // usually floyd-steinberg
  TIFFTAG_CELLWIDTH = 264;                       // dithering matrix width (obsolete by revision 5.0)
  TIFFTAG_CELLLENGTH = 265;                      // dithering matrix height (obsolete by revision 5.0)
  TIFFTAG_FILLORDER = 266;                       // data order within a Byte
    FILLORDER_MSB2LSB = 1;                       // most significant -> least
    FILLORDER_LSB2MSB = 2;                       // least significant -> most
  TIFFTAG_DOCUMENTNAME = 269;                    // name of doc. image is from
  TIFFTAG_IMAGEDESCRIPTION = 270;                // info about image
  TIFFTAG_MAKE = 271;                            // scanner manufacturer name
  TIFFTAG_MODEL = 272;                           // scanner model name/number
  TIFFTAG_STRIPOFFSETS = 273;                    // Offsets to data strips
  TIFFTAG_ORIENTATION = 274;                     // image FOrientation (obsolete by revision 5.0)
    ORIENTATION_TOPLEFT = 1;                     // row 0 top, col 0 lhs
    ORIENTATION_TOPRIGHT = 2;                    // row 0 top, col 0 rhs
    ORIENTATION_BOTRIGHT = 3;                    // row 0 bottom, col 0 rhs
    ORIENTATION_BOTLEFT = 4;                     // row 0 bottom, col 0 lhs
    ORIENTATION_LEFTTOP = 5;                     // row 0 lhs, col 0 top
    ORIENTATION_RIGHTTOP = 6;                    // row 0 rhs, col 0 top
    ORIENTATION_RIGHTBOT = 7;                    // row 0 rhs, col 0 bottom
    ORIENTATION_LEFTBOT = 8;                     // row 0 lhs, col 0 bottom
  TIFFTAG_SAMPLESPERPIXEL = 277;                 // samples per pixel
  TIFFTAG_ROWSPERSTRIP = 278;                    // rows per strip of data
  TIFFTAG_STRIPBYTECOUNTS = 279;                 // bytes counts for strips
  TIFFTAG_MINSAMPLEVALUE = 280;                  // minimum sample value (obsolete by revision 5.0)
  TIFFTAG_MAXSAMPLEVALUE = 281;                  // maximum sample value (obsolete by revision 5.0)
  TIFFTAG_XRESOLUTION = 282;                     // pixels/resolution in x
  TIFFTAG_YRESOLUTION = 283;                     // pixels/resolution in y
  TIFFTAG_PLANARCONFIG = 284;                    // storage organization
    PLANARCONFIG_CONTIG = 1;                     // single image plane
    PLANARCONFIG_SEPARATE = 2;                   // separate planes of data
  TIFFTAG_PAGENAME = 285;                        // page name image is from
  TIFFTAG_XPOSITION = 286;                       // x page offset of image lhs
  TIFFTAG_YPOSITION = 287;                       // y page offset of image lhs
  TIFFTAG_FREEOFFSETS = 288;                     // byte