Excluir FreeImage.DLL

[acuellar]

Manuel

Me tope con el SayImage de TPRINT que usa FreeImage.dll
Se puede con GDIPLUS?

Gracias por la ayuda

Saludos,

Adhemar

[mastintin]

pint:sayimage depende de la clase Timage , si vas a usar también esa clase para los formularios , lo mejor seria modificar un poco la clase tImage y matar dos pájaros de un tiro , pero implica también cambiar Tprinter .
¿ tienes muchas llamadas a sayimagen ? se podrían sustituir por una función llamada gPrnSayImage

Code: Select all  Expand view

Function  gPrnSayImage( oPrn, nRow, nCol, oImage, nWidth, nHeight, nRaster, lStretch, nAlphaLevel, nAlign )

   local hDib, hPalBmp, hPal, nRatio, n, cImageBuf, lCreated := .f.
   local hBmp, x, y
  local ogbmp , cFile
   DEFAULT nWidth := 0, nHeight := 0, lStretch := .t., nAlphaLevel := 255, nAlign := 1 // center

   if oPrn:hDC = 0
      return nil
   endif

   if ValType( oImage ) == 'C'
      if File( oImage )
         cFile:= oImage
        // oImage   := TImage():Define( , oImage )
          oImage   := TImage():Define( )
          oGBmp:= GDIBmp():new(cFile)
          oImage:hbitmap := oGBmp:GetGDIHbitmap()  
          oImage:HasAlpha()
          oImage:refresh()  
       //oGbmp:end()
         lCreated := .t.
      else
         cImageBuf := oImage
         oImage   := TImage():Define()
         oGBmp:= GDIBmp():new()
         oGBmp:LoadFromStr( cImageBuf )    
          oImage:hbitmap := oGBmp:GetGDIHbitmap()      
          oImage:HasAlpha()
          oImage:refresh()
       //oGbmp:end()    
        // oImage:LoadFromMemory( cImageBuf )
         lCreated := .t.
      endif
   endif

   do case
      case ValType( oImage ) == "O"
           hDib = DibFromBitmap( oImage:hBitmap, oImage:hPalette )
      otherwise
           hDib = 0
   endcase

   if hDib = 0
      return nil
   endif

   if ! oPrn:lMeta
      hPal := DibPalette( hDib )
   endif

   x     := nWidth; y   := nHeight

   // try to keep aspect ratio if only one size is passed in.
   if nWidth == 0 .and. nHeight > 0 .and. ( n := oImage:nHeight() ) > 0
      nRatio := oImage:nWidth() / n
      x      := int( nHeight * nRatio )
   elseif nWidth > 0 .and. nHeight == 0 .and. ( n := oImage:nWidth() ) > 0
      nRatio  := oImage:nHeight() / n
      y       := int( nWidth * nRatio )
   elseif nWidth > 0 .and. nHeight > 0 .and. ! lStretch

      if ( nWidth / oImage:nWidth() ) < ( nHeight / oImage:nHeight() )
         x     := nWidth; y := oImage:nHeight() * ( nWidth / oImage:nWidth() )
      else
         y     := nHeight; x := oImage:nWidth() * ( nHeight / oImage:nHeight() )
      endif

      if x < nWidth
         if lAnd( nAlign, 1 ) // DT_CENTER = 1
            nCol  += Int( ( nWidth - x ) / 2 )
         elseif lAnd( nAlign, 2 ) // DT_RIGHT = 2
            nCol  += ( nWidth - x )
         endif
      endif
      if y < nWidth
         if lAnd( nAlign, 4 ) // DT_VCENTER = 4
            nRow  += Int( ( nHeight - y ) / 2 )
         elseif lAnd( nAlign, 8 ) // DT_BOTTOM = 8
            nRow  += ( nHeight - y )
         endif
      endif

   endif

   if oImage:HasAlpha()
      hBmp     := ResizeBmp( oImage:hBitmap, x, y )
      ABPaint( oprn:hDCOut, nCol, nRow, hBmp, nAlphaLevel )
      DeleteObject( hBmp )
   else
      DibDraw( oprn:hDCOut, hDib, hPal, nRow, nCol, x, y, nRaster )
   endif

   GlobalFree( hDib )

   if ! oprn:lMeta
      DeleteObject( hPal )
   endif

   if lCreated
      oImage:End()
   endif

return nil

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

 

ojo que no esta probado , solo implementado "al vuelo" y puede tener algun que otro bug .

[mastintin]

Esta nueva version a mi me funciona .
He notado que según que impresora el resultado es mejor o peor ....

Code: Select all  Expand view

Function  gPrnSayImage( oPrn, nRow, nCol, oImage, nWidth, nHeight, nRaster, lStretch, nAlphaLevel, nAlign )

   local hDib, hPalBmp, hPal, nRatio, n, cImageBuf, lCreated := .f.
   local hBmp, x, y
  local ogbmp, cfile
   DEFAULT nWidth := 0, nHeight := 0, lStretch := .t., nAlphaLevel := 255, nAlign := 1 // center

   if oPrn:hDC = 0
      return nil
   endif

   if ValType( oImage ) == 'C'
      if File( oImage )
           cfile := oImage
          oImage   := TImage():Define( )
          oGBmp:= GDIBmp():new(cFile)
          oGbmp:resize(  nWidth, nHeight )
          oImage:hbitmap := oGBmp:GetGDIHbitmap()
          oImage:HasAlpha()
         oGbmp:end()
         lCreated := .t.
      else
         cImageBuf := oImage
         oImage   := TImage():Define()
         oGBmp:= GDIBmp():new()
         oGBmp:LoadFromStr( cImageBuf )
         oGbmp:resize(  nWidth, nHeight )
          oImage:hbitmap := oGBmp:GetGDIHbitmap()
          oImage:HasAlpha()
          oGbmp:end()
         lCreated := .t.
      endif
   endif

   do case
      case ValType( oImage ) == "O"
           hDib = DibFromBitmap( oImage:hBitmap, oImage:hPalette )
      otherwise
           hDib = 0
   endcase

   if hDib = 0
      return nil
   endif

   if ! oprn:lMeta
      hPal := DibPalette( hDib )
   endif

   if oImage:HasAlpha()
      ABPaint( oprn:hDCOut, nCol, nRow, oimage:hBitmap, nAlphaLevel )
   else
      hDib = DibFromBitmap( oImage:hBitmap, oImage:hPalette )
      DibDraw( oprn:hDCOut, hDib, hPal, nRow, nCol, nWidth, nHeight, nRaster )
   endif

   GlobalFree( hDib )

   if ! oprn:lMeta
      DeleteObject( hPal )
   endif

   if lCreated
      oImage:End()
   endif

return nil

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

 

[acuellar]

Perfecto, funciona

Muchas gracias Manuel

Como en el caso anterior e comentado // oGbmp:end()
porque da error


Saludos,

Adhemar

[mastintin]

Probado con bcc68 . El warning que da según he visto por san google se puede ignorar ...
No me da error , por lo que probablemente sea que tus librerías de gdiplus no tienen algun cambio que las mias si tienen .
descarga este rar que tiene los dos obj ( tgdiplus.prg y gdiplus.cpp ) compilados con harbour y bcc68 y enlazalos en vez sus prg a ver si con esto no da error y me dices.
https://www.dropbox.com/s/afythr43g4zr1 ... s.rar?dl=0

[acuellar]

Manuel

Reemplace en FIVEH.LIB los .obj que descargue
Me da los siguientes errores:

Error: Unresolved external '_HB_FUN_PAUSA' referenced from D:\SISTEMAS\COMPILER\FWH\LIB\FIVEH.LIB|tgdiplus
Cree la función vacía y compila

Al mostrar da:

Error description: Error BASE/1004 Message not found: GDIBMP:LOADFROMSTR
Args:
[ 1] = O GDIBMP

Saludos,

Adhemar

[mastintin]

perdon error mio , mande la version de antes de implementar lo de cargalo de cstr
MIra a ver con estos :
https://www.dropbox.com/s/afythr43g4zr1 ... s.rar?dl=0

[acuellar]

Al compilar da

Error: Unresolved external '_HB_FUN_GDIPLUSIMAGELFROMSTR' referenced from D:\SISTEMAS\COMPILER\FWH\LIB\FIVEH.LIB|tgdiplus
La cree vacía y al mostrar se cuelga.

Saludos,

Adhemar

[mastintin]

TE enviolos originales https://www.dropbox.com/s/afythr43g4zr1 ... s.rar?dl=0

[acuellar]

Perfecto!!
Funciona

El único error de advertencia es:
Warning W8022 D:\SISTEMAS\COMPILER\BCC68\include\windows\GdiplusHeaders.h 636: 'Bitmap::Clone(const Rect &,int)' hides virtual function 'Image::Clone()'

Muchas gracias Manuel.

Saludos,

Adhemar

[mastintin]

Perfecto!!
Funciona

El único error de advertencia es:
Warning W8022 D:\SISTEMAS\COMPILER\BCC68\include\windows\GdiplusHeaders.h 636: 'Bitmap::Clone(const Rect &,int)' hides virtual function 'Image::Clone()'

Muchas gracias Manuel.

Saludos,

Adhemar

Ese warning parece un problema no resuelto por borland-embarcadero introducido en versiones posteriores a la 5.82.
Parece ser que para corregirlo en la configuracion general del IDE de borland tendríamos que poner un parametro STRICT ( ¿? )
como no usamos el IDE , para evitar el warning ( no resuelve el problema )
al comienzo de gdiplus.cpp ...

Code: Select all  Expand view

#pragma warn -hid  // nuevo
#include "GdiPlus.h"
#pragma warn .hid  // nuevo

 

[cnavarro]

Manuel, en linea de comandos creo que seria -DSTRICT

https://community.embarcadero.com/index ... -is-strict

[mastintin]

Manuel, en linea de comandos creo que seria -DSTRICT

https://community.embarcadero.com/index ... -is-strict

pues parece que no lo arregla
no importa , se vive con ese warning sin problemas