mORMot Open Source

// ****************************************
//    Interface Section Code
// ****************************************

    // ****************************************
    // add to the private section of the TGDIPlus class
    // ****************************************
    GetFrameCount: function (image: THandle; dimensionID: PGUID; var count: UINT): TGdipStatus; stdcall;
    SelectActiveFrame: function (image: THandle; dimensionID: PGUID; frameIndex: UINT): TGdipStatus; stdcall;


    // ****************************************
    // Replace the existing declaration of TTiffImage
    // ****************************************
   TTiffImage = class(TSynPicture)
  private
    fActivePage : integer;
  protected
    //Selects the active frame/page for the TIFF
    procedure SelectPage(index:integer); //rjm
  public
    constructor Create; override; //rjm

    //Extract a page from the TIFF and assign it to a bitmap
    procedure ExtractPage(index:integer; wBMP:TBitmap); //rjm

    //Retrieve the number of pages in the TIFF file
    function GetPageCount:integer;

    //Default Frame/Page Index is 0
    property ActivePageIndex : integer read fActivePage write SelectPage;
  end;


// ****************************************
//    Implementation Section Code
// ****************************************


    // ****************************************
    // add to the top of the implementaion section
    // ****************************************
const
//---------------------------------------------------------------------------
// Predefined multi-frame dimension IDs
//---------------------------------------------------------------------------

  FrameDimensionPage       : TGUID = '{7462dc86-6180-4c7e-8e3f-ee7333a7a483}';
  {$EXTERNALSYM FrameDimensionPage}


    // ****************************************
    // Replace the existing declaration of GdiPProcNames
    // ****************************************

const GdiPProcNames: array[0..18{$ifdef USEDPI}+1{$endif}
      {$ifdef USEENCODERS}+2{$endif}] of PChar =
    ('GdiplusStartup','GdiplusShutdown',
     'GdipDeleteGraphics','GdipCreateFromHDC',
     'GdipLoadImageFromStream','GdipLoadImageFromFile',
     'GdipDrawImageRectI','GdipDrawImageRectRectI',
{$ifdef USEDPI} 'GdipDrawImageI', {$endif}
     'GdipDisposeImage', 'GdipGetImageRawFormat',
     'GdipGetImageWidth','GdipGetImageHeight','GdipSaveImageToStream',
{$ifdef USEENCODERS} 'GdipGetImageEncodersSize','GdipGetImageEncoders', {$endif}
     'GdipCreateBitmapFromHBITMAP','GdipCreateBitmapFromGdiDib','GdipBitmapSetResolution',
     'GdipImageGetFrameCount', 'GdipImageSelectActiveFrame',  // <--new function names //rjm
     nil);

    // ****************************************
    //  add to the bottom of the unit above the initialization section
    // ****************************************


{ TTiffImage }

//rjm
function TTiffImage.GetPageCount: integer;
var
  wCount : UINT;
begin
  if (fImage<>0) then
  begin
    Gdip.GetFrameCount(fImage, @FrameDimensionPage, wCount);
    result := wCount;
  end
  else
    result := 0;
end;

//rjm
procedure TTiffImage.SelectPage(index: integer);
var
  wFrames : integer;
begin
  wFrames := GetPageCount;
  if (wFrames > 0) and ((index >= 0) and (index < wFrames)) then
  begin
    Gdip.SelectActiveFrame(fImage, @FrameDimensionPage, index);
    fActivePage := index;
  end
  else
    raise ERangeError.Create('Invalid Page Index');
end;

//rjm
constructor TTiffImage.Create;
begin
  inherited;
  fActivePage := 0;
end;

//rjm
procedure TTiffImage.ExtractPage(index: integer; wBMP:TBitmap);
var
  wFrames : integer;
  wStrm : TMemoryStream;
begin
  wFrames := GetPageCount;
  if (wFrames > 0) and ((index >= 0) and (index < wFrames)) then
  begin
    Try
      Gdip.SelectActiveFrame(fImage, @FrameDimensionPage, index);
      wStrm := TMemoryStream.Create;
      try
        SaveAs(wstrm,gptBMP);
        wStrm.Position := 0;
        wBmp.LoadFromStream(wStrm);
      finally
        wStrm.Free;
      end;
    finally
      Gdip.SelectActiveFrame(fImage, @FrameDimensionPage, fActivePage);
    end;
  end
  else
    raise ERangeError.Create('Invalid Page Index');
end;