unit Free;

{$ifdef LAZARUS}
  {$MODE Delphi}
{$else}
  {$DEFINE DELPHI}
{$endif}

// ============================================================================
//
// DELPHI + LAZARUS for Windows - additional functions for FreeImage 3
//
// (re)arranged by Breakoutbox
// with help from
// - matze  (TFreeWinBitmapToTBitmap)
// - FfmpegLazGui
//
// This file is for FreeImage 3
//
// COVERED CODE IS PROVIDED UNDER THIS LICENSE ON AN "AS IS" BASIS, WITHOUT WARRANTY
// OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, WITHOUT LIMITATION, WARRANTIES
// THAT THE COVERED CODE IS FREE OF DEFECTS, MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE
// OR NON-INFRINGING. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE COVERED
// CODE IS WITH YOU. SHOULD ANY COVERED CODE PROVE DEFECTIVE IN ANY RESPECT, YOU (NOT
// THE INITIAL DEVELOPER OR ANY OTHER CONTRIBUTOR) ASSUME THE COST OF ANY NECESSARY
// SERVICING, REPAIR OR CORRECTION. THIS DISCLAIMER OF WARRANTY CONSTITUTES AN ESSENTIAL
// PART OF THIS LICENSE. NO USE OF ANY COVERED CODE IS AUTHORIZED HEREUNDER EXCEPT UNDER
// THIS DISCLAIMER.
//
// Use at your own risk!
//
// ============================================================================

interface

uses SysUtils, Classes, Dialogs,
     FreeImage,
     FreeBitmap,
     {$ifdef LAZARUS}
       {Lazarus/FreePascal:} LCLIntf, LCLType, jwawinuser //, jwawinbase
     {$endif}

     {$ifdef DELPHI}
     Windows, Graphics
     { REMARK: 'Graphis' must be BEHIND 'FreeImage' + 'FreeBitmap' !}
     {$endif}
     ;



{ ***** copy a TFreeWinBitmap to a TBitmap *********************************** }
function TFreeWinBitmapToTBitmap( FBitmap:TFreeWinBitmap; BMP:TBitmap):integer;

{ ***** copy a TBitmap to a TFreeWinBitmap *********************************** }
function TBitmapToTFreeWinBitmap( FBitmap:TFreeWinBitmap; BMP:TBitmap):integer;



{ ***** LOWLEVEL subfuncions ************************************************* }
{ ***** copy a hBITMAP to a pFIBITMAP **************************************** }
function BitmapToFreeWinBitmap( hBmp:HBITMAP):pFIBITMAP;
{ Example of usage:                                                    }
{ FBitmap.Dib:= FreeImage_hBitmapToDib( Image.Picture.Bitmap.Handle);  }



implementation


{ ***** copy a TFreeWinBitmap to a TBitmap *********************************** }
function TFreeWinBitmapToTBitmap( FBitmap:TFreeWinBitmap; BMP:TBitmap):integer;
var tmpDIB  : pFIBITMAP;
    pStream : PFIMEMORY;
    data    : PByte;
    aStream : TMemoryStream;
    res     : boolean;
    size    : dword;
begin
  result:= -1;
  data:= NIL;
  size:= 0;

  if not Assigned( FBitmap) then exit;
  if not Assigned( BMP) then exit;

  { create the DIB : }
  //tmpDIB:= FreeImage_ConvertToStandardType( FBitmap.Dib, TRUE);
  tmpDIB:= FreeImage_Clone( FBitmap.Dib);

  { save DIB to stream : }
  pStream:= freeimage_openmemory;
  freeimage_savetomemory( fif_bmp, tmpDIB, pStream);
  res:= freeimage_acquirememory( pStream, data, size);

  aStream:= TMemoryStream.create;
  try
    aStream.write( data^, size);
    aStream.position:= 0;
    BMP.loadfromstream( aStream);
  finally
    FreeAndNil( aStream);
  end;

  freeimage_unload( tmpDIB);
  freeimage_closememory( pStream);

  result:= 0;
end;


{ ***** copy a TBitmap to a TFreeWinBitmap *********************************** }
function TBitmapToTFreeWinBitmap( FBitmap:TFreeWinBitmap; BMP:TBitmap):integer;
begin
  result:= -1;

  if Assigned( FBitmap) then
  if Assigned( BMP) then
    TRY
      FBitmap.Dib:= BitmapToFreeWinBitmap( BMP.Handle);
      result:= 0;
    EXCEPT
      // 'exception in TBitmapToTFreeWinBitmap'
    END;
end;


{ ***** copy a hBITMAP to a pFIBITMAP *************************************** }
function BitmapToFreeWinBitmap( hBmp:hBITMAP):pFIBITMAP;
var bmp           : BITMAP;
    pDIB          : pFIBITMAP;
    nColors       : integer;
    DeviceContext : HDC;
    success       : integer;
    pBI           : pBITMAPINFO;
begin
  { --- no error checking --- }
  { the function EXPECTS (!) that  hBmp  is valid ! }
  GetObject( hBmp, SizeOf( BITMAP), @bmp );
  pDIB:= FreeImage_Allocate( bmp.bmWidth, bmp.bmHeight, bmp.bmBitsPixel, 0, 0, 0 );
  nColors:= FreeImage_GetColorsUsed( pDIB);
  DeviceContext:= GetDC( 0);
  pBI:= FreeImage_GetInfo( pDIB^);

  success:= GetDIBits( DeviceContext,
                       hBmp,
                       0,
                       FreeImage_GetHeight( pDIB),
                       FreeImage_GetBits( pDIB),
                       pBI^,
                       DIB_RGB_COLORS);
  ReleaseDC( 0, DeviceContext);

  // restore BITMAPINFO members
  //FreeImage_GetInfoHeader(dib)->biClrUsed = nColors;
  //FreeImage_GetInfoHeader(dib)->biClrImportant = nColors;

  BitmapToFreeWinBitmap:= pDIB;
end;


end.
