Adolfo:
Tube un problema similar en mi anterior proyecto y encontre una clase que es modificación de la TImage: se llama
tZoomImage, te dejo el fuente y el CH para que lo pruebes... Por cierto que es de la autoría de Jaime Irurzun.
zImage.Prg
- Code: Select all Expand view
**
* PROYECTO ...: Clase tZoomImage
* COPYRIGHT ..: (c) Jaime Irurzun
**
#include "Fivewin.ch"
CLASS TZoomImage FROM TImage
CLASSDATA lRegistered AS LOGICAL
METHOD PAINT()
ENDCLASS
/*_____________________________________________________________________________*/
METHOD PAINT() CLASS TZoomImage
// jaime 17.10.04
LOCAL nWBmp := nBmpWidth( ::hBitmap )
LOCAL nHBmp := nBmpHeight( ::hBitmap )
LOCAL aRect := GetClientRect( ::hWnd )
LOCAL nWidth := aRect[4] - aRect[2]
LOCAL nHeight := aRect[3] - aRect[1]
// fin jaime
IF EMPTY( ::hBitmap ) .and. ! EMPTY( ::cBmpFile )
::LoadBmp( ::cBmpFile )
ENDIF
IF EMPTY( ::hBitmap )
IF ::bPainted != nil
EVAL( ::bPainted, ::hDC )
ENDIF
RETURN nil
ENDIF
// jaime 17.10.04
IF ::lStretch
PALBMPDraw( ::hDC, ::nX, ::nY, ::hBitmap, ::hPalette,;
nWidth, nHeight,, ::lTransparent, ::nClrPane ) // (nClrPane) Added by RRR 23/04/01 07:58
ELSE
IF ::nZoom > 0
IF nHBmp > nHeight .OR. nWBmp > nWidth
// si es más alta que ancha (o son iguales)
IF nHBmp >= nWBmp
nWBmp := ( nWBmp * nHeight ) / nHBmp
nHBmp := nHeight
// si el lado contrario ha quedado más grande, reajusto
IF nWBmp > nWidth
nHBmp := ( nHBmp * nWidth ) / nWBmp
nWBmp := nWidth
ENDIF
PALBMPDraw( ::hDC, ::nX, ::nY, ::hBitmap, ::hPalette,;
nWBmp, nHBmp,, ::lTransparent, ::nClrPane ) // (nClrPane) Added by RRR 23/04/01 07:58
// si es más ancha que alta
ELSE
nHBmp := ( nHBmp * nWidth ) / nWBmp
nWBmp := nWidth
// si el lado contrario ha quedado más grande, reajusto
IF nHBmp > nHeight
nWBmp := ( nWBmp * nHeight ) / nHBmp
nHBmp := nHeight
ENDIF
PALBMPDraw( ::hDC, ::nX, ::nY, ::hBitmap, ::hPalette,;
nWBmp, nHBmp,, ::lTransparent, ::nClrPane ) // (nClrPane) Added by RRR 23/04/01 07:58
ENDIF
ELSE
PALBMPDraw( ::hDC, ::nX, ::nY, ::hBitmap, ::hPalette,;
nWBmp, nHBmp,, ::lTransparent, ::nClrPane ) // (nClrPane) Added by RRR 23/04/01 07:58
ENDIF
ENDIF
ENDIF
// fin jaime
IF ::bPainted != nil
EVAL( ::bPainted, ::hDC )
ENDIF
RETURN nil
y el archivo de Cabecera ZIMAGE.CH
- Code: Select all Expand view
/*----------------------------------------------------------------------------//
!short: ZoomImage */
#xcommand REDEFINE ZoomImage [ <oBmp> ] ;
[ ID <nId> ] ;
[ <of: OF, WINDOW, DIALOG> <oWnd> ] ;
[ <resource: NAME, RESNAME, RESOURCE> <cResName> ] ;
[ <file: FILE, FILENAME, DISK> <cBmpFile> ] ;
[ <lClick: ON ClICK, ON LEFT CLICK> <uLClick> ] ;
[ <rClick: ON RIGHT CLICK> <uRClick> ] ;
[ <scroll: SCROLL> ] ;
[ <adjust: ADJUST> ] ;
[ CURSOR <oCursor> ] ;
[ MESSAGE <cMsg> ] ;
[ <update: UPDATE> ] ;
[ WHEN <uWhen> ] ;
[ VALID <uValid> ] ;
=> ;
[ <oBmp> := ] TZoomImage():ReDefine( <nId>, <cResName>, <cBmpFile>,;
<oWnd>, [\{ |nRow,nCol,nKeyFlags| <uLClick> \}],;
[\{ |nRow,nCol,nKeyFlags| <uRClick> \}],;
<.scroll.>, <.adjust.>, <oCursor>, <cMsg>, <.update.>,;
<{uWhen}>, <{uValid}> )
dentro de tu prg inclulles la definición a ZImage
- Code: Select all Expand view
#Include "FIVEWIN.CH"
#Include "ZIMAGE.CH"
...
...
Local oBmp
REDEFINE ZOOMIMAGE oBmp ID 120 OF oDlg FILENAME ".\LLAVE.BMP" //Resource "LLAVE"
Y dentro del Pelles C creas un nuevo control personalizado llamado "
TZoomImage" con estilo de Ventana "0x50000000" y estilo de Ventana Extendido "0x00000000" y listo, no se si haya sido de tu ayuda, pero espero te funcione...
Saludos.