graphicex.pas

lansd aslda sldasdnaslda sdlandslasd

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

procedure SwapLong(P: PInteger; Count: Cardinal); overload;

// swaps high and low bytes of 32 bit values
// EAX contains P, EDX contains Count

asm
@@Loop:
              MOV ECX, [EAX]
              BSWAP ECX
              MOV [EAX], ECX
              ADD EAX, 4
              DEC EDX
              JNZ @@Loop
end;

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

function SwapLong(Value: Cardinal): Cardinal; overload;

// swaps high and low bytes of the given 32 bit value

asm
              BSWAP EAX
end;

//----------------- various conversion routines ------------------------------------------------------------------------

procedure Depredict1(P: Pointer; Count: Cardinal);

// EAX contains P and EDX Count

asm
@@1:
              MOV CL, [EAX]
              ADD [EAX + 1], CL
              INC EAX
              DEC EDX
              JNZ @@1
end;

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

procedure Depredict3(P: Pointer; Count: Cardinal); 

// EAX contains P and EDX Count

asm
              MOV ECX, EDX
              SHL ECX, 1
              ADD ECX, EDX         // 3 * Count
@@1:
              MOV DL, [EAX]
              ADD [EAX + 3], DL
              INC EAX
              DEC ECX
              JNZ @@1
end;

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

procedure Depredict4(P: Pointer; Count: Cardinal);

// EAX contains P and EDX Count

asm
              SHL EDX, 2          // 4 * Count
@@1:
              MOV CL, [EAX]
              ADD [EAX + 4], CL
              INC EAX
              DEC EDX
              JNZ @@1
end;

//----------------- TGraphicExGraphic ----------------------------------------------------------------------------------

constructor TGraphicExGraphic.Create;

begin
  inherited;
  FColorManager := TColorManager.Create;
end;

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

destructor TGraphicExGraphic.Destroy;

begin
  FColorManager.Free;
  inherited;
end;

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

procedure TGraphicExGraphic.Assign(Source: TPersistent);

begin
  if Source is TGraphicExGraphic then FImageProperties := TGraphicExGraphic(Source).FImageProperties;
  inherited;
end;

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

class function TGraphicExGraphic.CanLoad(const FileName: String): Boolean;

var
  Stream: TFileStream;

begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    Result := CanLoad(Stream);
  finally
    Stream.Free;
  end;
end;

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

class function TGraphicExGraphic.CanLoad(Stream: TStream): Boolean;

// Descentants have to override this method and return True if they consider the data in Stream
// as loadable by the particular class.
// Note: Make sure the stream position is the same on exit as it was on enter!

begin
  Result := False;
end;

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

procedure TGraphicExGraphic.LoadFromResourceID(Instance: THandle; ResID: Integer);

var
  Stream: TResourceStream;

begin
  Stream := TResourceStream.CreateFromID(Instance, ResID, RT_RCDATA);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

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

procedure TGraphicExGraphic.LoadFromResourceName(Instance: THandle; const ResName: String);

var
  Stream: TResourceStream;

begin
  Stream := TResourceStream.Create(Instance, ResName, RT_RCDATA);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

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

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

// Initializes the internal image properties structure.
// Descentants must override this method to fill in the actual values.
// Result is always False to show there is no image to load.

begin
  Finalize(FImageProperties);
  ZeroMemory(@FImageProperties, SizeOf(FImageProperties));
  FImageProperties.FileGamma := 1;
  Result := False;
end;

//----------------- TAutodeskGraphic -----------------------------------------------------------------------------------

{$ifdef AutodeskGraphic}

type
  TAutodeskHeader = packed record
    Width,
    Height,
    XCoord,
    YCoord: Word;
    Depth,
    Compression: Byte;
    DataSize: Cardinal;
    Reserved: array[0..15] of Byte;
  end;

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

class function TAutodeskGraphic.CanLoad(Stream: TStream): Boolean;

var
  FileID: Word;
  Header: TAutodeskHeader;
  LastPosition: Cardinal;

begin
  with Stream do
  begin
    Result := (Size - Position) > (SizeOf(FileID) + SizeOf(Header));
    if Result then
    begin
      LastPosition := Position;
      Read(FileID, SizeOf(FileID));
      Result := FileID = $9119;
      if Result then
      begin
        // read image dimensions
        Read(Header, SizeOf(Header));
        Result := (Header.Depth = 8) and (Header.Compression = 0);
      end;
      Position := LastPosition;
    end;
  end;
end;

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

procedure TAutodeskGraphic.LoadFromStream(Stream: TStream);

var
  FileID: Word;
  FileHeader: TAutodeskHeader;
  LogPalette: TMaxLogPalette;
  I: Integer;

begin
  Handle := 0;
  FBasePosition := Stream.Position;

  if ReadImageProperties(Stream, 0) then
  begin
    with Stream do
    begin
      Position := FBasePosition;

      FProgressRect := Rect(0, 0, Width, 1);
      Progress(Self, psStarting, 0, False, FProgressRect, gesTransfering);
      Read(FileID, 2);

      // read image dimensions
      Read(FileHeader, SizeOf(FileHeader));

      // read palette entries and create a palette
      ZeroMemory(@LogPalette, SizeOf(LogPalette));
      LogPalette.palVersion := $300;
      LogPalette.palNumEntries := 256;
      for I := 0 to 255 do
      begin
        Read(LogPalette.palPalEntry[I], 3);
        LogPalette.palPalEntry[I].peBlue := LogPalette.palPalEntry[I].peBlue shl 2;
        LogPalette.palPalEntry[I].peGreen := LogPalette.palPalEntry[I].peGreen shl 2;
        LogPalette.palPalEntry[I].peRed := LogPalette.palPalEntry[I].peRed shl 2;
      end;

      // setup bitmap properties
      PixelFormat := pf8Bit;
      Palette := CreatePalette(PLogPalette(@LogPalette)^);
      Width := FileHeader.Width;
      Height := FileHeader.Height;
      // finally read image data
      for I := 0 to Height - 1 do
      begin
        Read(Scanline[I]^, FileHeader.Width);
                                                        
        Progress(Self, psRunning, MulDiv(I, 100, Height), True, FProgressRect, '');
        OffsetRect(FProgressRect, 0, 1);
      end;

      Progress(Self, psEnding, 0, False, FProgressRect, '');
    end;
  end
  else GraphicExError(gesInvalidImage, ['Autodesk']);
end;

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

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

var
  FileID: Word;
  Header: TAutodeskHeader;

begin
  Result := inherited ReadImageProperties(Stream, ImageIndex);
  with Stream, FImageProperties do
  begin
    Read(FileID, 2);
    if FileID = $9119 then
    begin
      // read image dimensions
      Read(Header, SizeOf(Header));

      ColorScheme := csIndexed;
      Width := Header.Width;
      Height := Header.Height;
      BitsPerSample := 8;
      SamplesPerPixel := 1;
      BitsPerPixel := 8;
      Compression := ctNone;

      Result := True;
    end;
  end;
end;

{$endif} // AutodeskGraphic

//----------------- TSGIGraphic ----------------------------------------------------------------------------------------

{$ifdef SGIGraphic}

const
  SGIMagic = 474;

  SGI_COMPRESSION_VERBATIM = 0;
  SGI_COMPRESSION_RLE = 1;

type
  TSGIHeader = packed record
    Magic: SmallInt;         // IRIS image file magic number
    Storage,                 // Storage format
    BPC: Byte;               // Number of bytes per pixel channel (1 or 2)
    Dimension: Word;         // Number of dimensions
                             //   1 - one single scanline (and one channel) of length XSize
                             //   2 - two dimensional (one channel) of size XSize x YSize
                             //   3 - three dimensional (ZSize channels) of size XSize x YSize
    XSize,                   // width of image
    YSize,                   // height of image
    ZSize: Word;             // number of channels/planes in image (3 for RGB, 4 for RGBA etc.)
    PixMin,                  // Minimum pixel value
    PixMax: Cardinal;        // Maximum pixel value
    Dummy: Cardinal;         // ignored
    ImageName: array[0..79] of Char;
    ColorMap: Integer;       // Colormap ID
                             //  0 - default, almost all images are stored with this flag
                             //  1 - dithered, only one channel of data (pixels are packed), obsolete
                             //  2 - screen (palette) image, obsolete
                             //  3 - no image data, palette only, not displayable
    Dummy2: array[0..403] of Byte; // ignored
  end;

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

class function TSGIGraphic.CanLoad(Stream: TStream): Boolean;

// returns True if the data in Stream represents a graphic which can be loaded by this class

var
  Header: TSGIHeader;
  LastPosition: Cardinal;

begin
  with Stream do
  begin
    Result := (Size - Position) > SizeOf(TSGIHeader);
    if Result then
    begin
      LastPosition := Position;
      ReadBuffer(Header, SizeOf(Header));
      // one number as check is too unreliable, hence we take some more fields into the check