Timage

[IVAN TRACHTA]

Hola a todos
Utilizando la clase TImage, me surge el problema de la "distorsión" de la Imágen mostrada según su tamaño y forma original.
Ocurre que las imágenes guardadas no son todas iguales (ancho-alto) por lo tanto utilizando el ADJUST logro que la imágen se inserte apropiadamente en el control pero queda según el caso a veces "estirada" a lo ancho o a lo alto.
Hay alguna manera de corregir esto?

Gracias y saludos

Iván

[Daniel Garcia-Gil]

Ivan..


eso es lo que hace ADJUST estira/reduce el ancho y el alto del bitmap hasta ocupar el espacio total del control

[IVAN TRACHTA]

Gracias Daniel

Si, eso lo entiendo.
Yo quería saber si existe alguna solución a este problema.
Digamos algo que reduzca proporcionalmente la imágen, de modo que quepa en el control pero respete la proporcion de altura/ancho.

Saludos

[Daniel Garcia-Gil]

Ivan...

entiendo perfectamente, pero es un punto que no poedmos tratar como un problema pues el ADJUST se espera que trabaje exactamente como lo hace...
prueba cambiar el tamaño del control al tamaño de la imagen y no como lo haces actualmente, que es cambiar el tamaño de la imagen al tamaño del control

oImage:SetSize( nBmpWidth( oImage:hBitmap ), nBmpHeight( oImage:hBitmap ), .T. )

si no trabaja como esperas, alguna solucion te ayudaremos encontrar

[Marcelo Via Giglio]

Hola,

para tener es comportamiento, tendrías que modificar la clase TBitMap en el método paint y calcular los valores de ancho y alto en lugar
de Super:nWidth(), Super:nHeight(), lo que haces es ver la relación del tamaño de tu imagen en función al tamaño del control y en función
de cual esta mas cerca al contenedor (alto ancho) asumir este tamaño para la imagen y la otra dimensión (ancho o alto) cambiar de manera proporcional
al tamaño cambiado, jajajajajaja creo que no es fácil explicar, creo que seria mas sencillo el hacerlo.

Si el ancho de tu imagen esta mas cerca al ancho del contenedor vuelves el ancho de la imagen al del contenedor y el alto lo cambias en la proporción de la modificación del ancho, y viceversa en caso de que el alto sea mas próximo al de contenedor. Esto para mantener la relación de aspecto, podrías añadir un atributo (DATA) a la clase TbitMap para definir este ajuste al igual que el ADJUST

bueno un terrible enredo, pero creo que debería funcionar o tal vez fume mucho

saludos

Marcelo

[IVAN TRACHTA]

Si, entiendo lo que me quieres decir porque es algo más o menos intuitivo.
Pero la verdad es que me llevaría bastante tiempo de pruebas y demás hacer esto.
Imaginé que siendo hoy tan común trabajar con imágenes por ej. a alguien ya le habría ocurrido esto y habría una solución más o menos lista.
Incluso pensé que la propia clase podría estar algo más elaborada (y yo desconocer esto, obvio) y tener una alternativa a como trabaja el ADJUST.

Gracias de nuevo y veo si hago algunas pruebas.

Saludos
Ivan

[César E. Lozada]

Ya pasé por eso cuando, al actualizar un formulario, las fotos quedaban distorsionadas.

Te envío la función que hice para que el control se ajuste a la proporción de la imagen (aspect ratio).
Además de mantener el aspect ratio de la foto, la imagen siempre se ajustará a un tamaño menor o igual al del control.

Parámetros:
oImg es el control
bLoadImage es el codeblock para cargar la imagen. Ej: {|o| o:Load(,"Foto_1625.jpg") }
lHCenterControl indica si se debe centrar el control horizontalmente en el área que ocupaba inicialmente.

Es necesario guardar antes la posición y dimensiones originales del control. Lo hice en su :Cargo, pero puedes cambiar esto.
Todos _ deben hacerse con la imagen oculta.

Saludos
César Lozada

Function ImgAdjust(oImg,bLoadImg,lHCenterControl)
Local dHImg, dWImg, nRatioImg
Local yTctl, xLctl, dHctl, dWctl
Local yTctl_2, xLctl_2, dHctl_2, dWctl_2

DEFAULT lHCenterControl:=.T.

// Guardar posición y diemnsiones iniciales del control si no lo hecho
IF Empty(oImg:Cargo)
WITH OBJECT oImg:tControl()
oImg:Cargo:={:nTop,:nLeft,:nWidth,:nHeight}
END
ENDIF

// Todo debe hacerse con la imagen oculta
oImg:Hide()

// Cargar imagen
IF ValType(bLoadImg)="B"
Eval(bLoadImg,oImg)
ENDIF

// dimensiones y aspect ratio de la imagen
WITH OBJECT oImg
dWImg:=:nWidth
dHImg:=:nHeight
nRatioImg := dWimg/dHImg
END

// restablecer control a su posición y dimensiones originales
WITH OBJECT oImg
:Move( yTctl:=:Cargo[1], xLctl:=:Cargo[2], dWctl:=:Cargo[3], dHctl:=:Cargo[4])
END

//Ajusto el control según el ancho de la imagen
dWctl_2 := dWctl
dHctl_2 := Int(dWctl_2/nRatioImg)

//Si la altura de la imagen excede la altura del control ajusto según su altura
IF dHctl_2>dHctl
dHctl_2 := dHctl
dWctl_2 := Int(dHctl_2*nRatioImg)
ENDIF

//Nueva posición del control
xLctl_2 := xLctl
yTctl_2 := yTctl

//Centro el control en el espacio que ocupaba originalmente
IF lHCenterControl
xLctl_2 := Int(xLctl+(dWctl-dWctl_2)/2)
ENDIF

//Mover control a nueva posición y re-dimensionar
oImg:Move(yTctl_2,xLctl_2,dWctl_2,dHctl_2)

//Mostrar imagen
oImg:Show()

return nil

[IVAN TRACHTA]

César, genial lo tuyo....
Copié tu código, lo compilé y de una hace lo que pretendo.
Realmente muchas gracias a vos especialmente y a todos los que ayudan.

Un abrazo
Iván

[juan_arroyo_t]

Cesar

Muy buena tu rutina, es algo que andaba buscando

Muchas gracias por desprenderte de tus conocimientos

Saludos

[J. Ernesto]

Saludos al foro

Cesar por favor, esta Function ImgAdjust para imprimir en un formulario como la aplico con el codigo fuente.

Gracias

[sysctrl2]

Alguiem puede escribir un ejemplo,
como se usa la funcion ImgAdjust(oImg,bLoadImg,lHCenterControl)
de CESAR ?

saludos..

[juan_arroyo_t]

Este es mi prg

Logre hacer esto con la ayuda de post de rao y cesar e lozada

anexo dos imagenes
http://www.mediafire.com/view/gv5olyoii ... 700512.JPG
http://www.mediafire.com/view/d52ayo35e ... 701054.JPG

Code: Select all

#include 'fivewin.ch'
#include 'xbrowse.ch'
#include "ord.ch"
#include 'image.ch'

STATIC cAlias, oImage, oBrw, cDesCor

function Modelos()

   local oDlg, oFont, oCol
   LOCAL aoSay := { nil, nil }
    LOCAL aoBtn := { nil, nil, nil, nil, nil, nil, nil }
   LOCAL aoChk := { nil, nil }
   LOCAL lStr := .f.
   LOCAL lSetAlpha := .t.
    LOCAL aGradBarSelFocus:= { { 1, RGB(252,232,171)   , RGB(248,195, 34) } }
    LOCAL aGradBarSel:= {{1, RGB(252,235, 184), RGB(251,222,88)}}
    
    dbCloseAll()
    
    if ! net_use( "art",,,oApp:xDatos ) .or. ;      // catalogo de articulos
        ! net_use( "pro",,,oApp:xDatos ) .or. ;     // catalogo de proveedores
        ! net_use( "mar",,,oApp:xDatos ) .or. ;     // catalogo de marcas
        ! net_use( "lin",,,oApp:xDatos )                    // catalogo de lineas
        dbCloseAll()
        RETURN NIL
    endif
   
   cAlias := "ART"
   (cAlias)->(dbgotop())

   DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-12
   
   DEFINE DIALOG oDlg RESOURCE "DLG_UNO" TITLE "Módulo de imágenes"
   
   REDEFINE IMAGE oImage    ID 301 OF oDlg UPDATE //;
    
   REDEFINE CHECKBOX aoChk[1] VAR lStr ID 601 OF oDlg ;
      ON CHANGE ( oImage:lStretch(lStr), oImage:ScrollAdjust(), oImage:Refresh() )

   REDEFINE CHECKBOX aoChk[2] VAR lSetAlpha     ID 602 OF oDlg ;
      ON CHANGE ( SetAlpha( lSetAlpha ), oImage:Refresh() ) 
      
    oBrw := TXBrowse():New( oDlg )
      oBrw:CreateFromResource(500)
      oBrw:cAlias := cAlias

      oBrw:nMarqueeStyle       := MARQSTYLE_HIGHLROW
      oBrw:nColDividerStyle    := LINESTYLE_LIGHTGRAY
      oBrw:nRowDividerStyle    := LINESTYLE_LIGHTGRAY
      oBrw:lColDividerComplete := .t.
      oBrw:bClrStd    := { || If( oBrw:KeyNo() % 2 == 0, ;
               { CLR_BLACK, RGB( 224, 236, 255 ) }, ;
               { CLR_BLACK, RGB( 189, 211, 253 ) } ) }
        oBrw:bClrSel       := {|| { nRGB(  0,  0,255), aGradBarSel } }  // para barra de linea selecc cuando el control no tiene el foco
      oBrw:bClrSelFocus := { || { CLR_BLACK, aGradBarSelFocus } }     // para barra de linea selecc cuando el control tiene el foco     
               
      oBrw:nFreeze             := 1
      oBrw:nFooterLines        := 1
      oBrw:bSeek            := { |c| (cAlias)->(DbSeek( Upper(c) )) }
      oBrw:lFooter      := .t.
      oBrw:bKeyChar         := {|nKey| IIF(nKey=13, VerDesc( .f. ),) }
      oBrw:bLDblClick   := { || VerDesc( .f. ) }
                                                                            
      oCol := oBrw:AddCol()                                             
      oCol:bStrData := { || (cAlias)->modelo }   
      oCol:cHeader  := "MODELO"                                      
      oCol:nWidth        := 80
      oCol:nDataStrAlign := AL_LEFT                                     
      oCol:nHeadStrAlign := AL_CENTER
      oCol:nFootStrAlign := 2
      oCol:bFooter := {|| Alltrim(Transform((cAlias)->(OrdKeyCount()),'9,999,999'))+" Reg(s)"  }
      
      oCol := oBrw:AddCol()                                             
      oCol:bStrData := { || (cAlias)->id_pro }   
      oCol:cHeader  := "PROV"                                      
      oCol:nWidth        := 60
      oCol:nDataStrAlign := AL_LEFT                                     
      oCol:nHeadStrAlign := AL_CENTER
      
      oCol := oBrw:AddCol()                                             
      oCol:bStrData := { || (cAlias)->id_mar }   
      oCol:cHeader  := "MARCA"                                      
      oCol:nWidth        := 60
      oCol:nDataStrAlign := AL_LEFT                                     
      oCol:nHeadStrAlign := AL_CENTER
      
      oCol := oBrw:AddCol()                                             
      oCol:bStrData := { || (cAlias)->id_lin }   
      oCol:cHeader  := "LINEA"                                      
      oCol:nWidth        := 60
      oCol:nDataStrAlign := AL_LEFT                                     
      oCol:nHeadStrAlign := AL_CENTER
      
        WITH OBJECT oBrw
            :nMarqueeStyle       := MARQSTYLE_HIGHLROW
        :nColDividerStyle    := LINESTYLE_LIGHTGRAY
        :nRowDividerStyle    := LINESTYLE_LIGHTGRAY
        :lColDividerComplete := .t.
        :bClrStd                := { || If( oBrw:KeyNo() % 2 == 0, { CLR_BLACK, RGB( 224, 236, 255 ) }, { CLR_BLACK, RGB( 189, 211, 253 ) } ) }
            :bClrSel            := {|| { nRGB(  0,  0,255), aGradBarSel } }  // para barra de linea selecc cuando el control no tiene el foco
        :bClrSelFocus           := { || { CLR_BLACK, aGradBarSelFocus } }     // para barra de linea selecc cuando el control tiene el foco     
            :nFreeze             := 1
        :nFooterLines        := 1
        :bSeek                 := { |c| (cAlias)->(DbSeek( Upper(c) )) }
        :lFooter                := .t.
        :bKeyChar               := {|nKey| IIF(nKey=13, VerDesc( .f. ),) }
        :bLDblClick             := { || VerDesc( .f. ) }
        
        :nStretchCol            := 1
        :lHScroll               := .f.
        :bChange            := { || ImgAdjust(oImage:LoadFromMemory( (cAlias)->imagen )), ;
                                                  cDesCor := alltrim((cAlias)->descor), aoSay[2]:refresh(), oImage:Refresh() }
    END
    oBrw:aCols[1]:bFooter := {|| Alltrim(Transform((cAlias)->(OrdKeyCount()),'9,999,999'))+" Reg(s)"  }
    oBrw:aCols[1]:nFootStrAlign := 2
    
   REDEFINE SAY aoSay[1] oBrw:oSeek PROMPT oBrw:cSeek ID 701 OF oDlg PICTURE "@!" UPDATE ;
      COLOR CLR_BLACK,CLR_YELLOW FONT oFont
      
    REDEFINE SAY aoSay[2] VAR cDesCor   ID 302 OF oDlg UPDATE ;
        COLOR CLR_BLACK,CLR_YELLOW
    
   ACTIVATE DIALOG oDlg ON INIT ( MenuDialogo(oDlg), ;
               ImgAdjust(oImage:LoadFromMemory( (cAlias)->imagen )), cDesCor := alltrim((cAlias)->descor), ;
                aoSay[2]:refresh(), oImage:Refresh(), oBrw:SetFocus(), oDlg:move(120,70) )

   RELEASE FONT oFont
   dbCloseAll()

return nil

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

static function BorrarArticulo()
    if !MsgYesNo( "Esta seguro de borrar el modelo seleccionado ?",oApp:cEmpresa)
        return nil
    endif
    if (cAlias)->(rec_lock())
        (cAlias)->(dbDelete())
        (cAlias)->(dbskip(-1))
        (cAlias)->(dbUnlock())
    endif
return nil

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

STATIC FUNCTION CreaFiltro( oDlgCot )
    local oDlg, oFld
   LOCAL aoObjetos := { nil, nil, nil, nil, nil, nil, nil }
   LOCAL aoBtn := { nil, nil, nil, nil, nil, nil }
   LOCAL aoSay := { nil, nil, nil, nil }
   LOCAL cId_Pro := "", cId_Mar := "", cId_Lin := ""
   LOCAL cNomPro := "", cNomMar := "", cNomLin := ""
    LOCAL cTitulo := "Filtrado detalle de modelos"
    LOCAL nOpcion

   cId_Art := space(18)
    cId_Pro := cId_Mar := cId_Lin := SPACE(5)
    cNomArt := space(45)
    cNomPro := cNomMar := cNomLin := SPACE(40)

   DEFINE DIALOG oDlg RESOURCE "FLD_FILTRA" TITLE cTitulo

   REDEFINE FOLDER oFld ID 110 OF oDlg ;
      PROMPT "Proveedor", "Marca", "Línea" ;
      DIALOGS "SUB_CLIENTE", "SUB_CLIENTE", "SUB_CLIENTE"

   // Redefine controles dialogo 1  proveedores
   
   REDEFINE SAY aoSay[1] PROMPT "Proveedor :"   ID 301 OF oFld:aDialogs[ 1 ] UPDATE

    REDEFINE GET aoObjetos[1]  VAR cId_Pro ID 101 OF oFld:aDialogs[ 1 ] UPDATE ;
      PICTURE "@!" ;
        MESSAGE "Clave del proveedor" ;
      VALID EVAL ( { || cId_Pro := ValCod( cId_Pro, "pro"), ;
                                cNomPro := pro->nombre, ;
                                nOpcion := 1, oDlg:Update(), .T. } )
        aoObjetos[1]:cToolTip := "Introduzca o seleccione la clave del proveedor"

   REDEFINE GET aoObjetos[2] VAR cNomPro ID 102 OF oFld:aDialogs[ 1 ] UPDATE ;
        WHEN .F.

    REDEFINE BUTTONBMP aoBtn[1] ID 400 OF oFld:aDialogs[1] ;
    PROMPT "A&ceptar " ;
    BITMAP "BTN_OK" TEXTRIGHT ;
    ACTION ( Filtra( nOpcion, cId_Pro, cNomPro, oDlgCot ), oDlg:End() ) ;
      MESSAGE "Aceptar" UPDATE
      aoBtn[1]:cToolTip := "Presione para Continuar"

    REDEFINE BUTTONBMP aoBtn[2] ID 401 OF oFld:aDialogs[1] ;
        PROMPT "&Cancelar " BITMAP "BTN_CAN" TEXTRIGHT ;
    ACTION ( lContinuar := .F., oDlg:End() ) ;
      MESSAGE "Cancelar" UPDATE
      aoBtn[2]:cToolTip := "Presione para Cancelar"

    // Redefine controles dialogo 2 marcas
    
    REDEFINE SAY aoSay[2] PROMPT "Marca :"  ID 301 OF oFld:aDialogs[ 2 ] UPDATE
    
    REDEFINE GET aoObjetos[3]  VAR cId_Mar ID 101 OF oFld:aDialogs[ 2 ] UPDATE ;
      PICTURE "@!" ;
        MESSAGE "Clave de la marca" ;
      VALID EVAL ( { || cId_Mar := ValCod( cId_Mar, "mar"), ;
                                cNomMar := mar->nombre, ;
                                nOpcion := 2, oDlg:Update(), .T. } )
        aoObjetos[3]:cToolTip := "Introduzca o seleccione la clave de la marca"

   REDEFINE GET aoObjetos[4] VAR cNomMar ID 102 OF oFld:aDialogs[ 2 ] UPDATE ;
        WHEN .F.

    REDEFINE BUTTONBMP aoBtn[3] ID 400 OF oFld:aDialogs[2] ;
    PROMPT "A&ceptar " ;
    BITMAP "BTN_OK" TEXTRIGHT ;
    ACTION ( Filtra( nOpcion, cId_Mar, cNomMar, oDlgCot ), oDlg:End() ) ;
      MESSAGE "Aceptar" UPDATE
      aoBtn[3]:cToolTip := "Presione para Continuar"

    REDEFINE BUTTONBMP aoBtn[4] ID 401 OF oFld:aDialogs[2] ;
        PROMPT "&Cancelar " BITMAP "BTN_CAN" TEXTRIGHT ;
    ACTION ( lContinuar := .F., oDlg:End() ) ;
      MESSAGE "Cancelar" UPDATE
      aoBtn[4]:cToolTip := "Presione para Cancelar"

    // Redefine controles dialogo 3     líneas

    REDEFINE SAY aoSay[3] PROMPT "Línea :"     ID 301 OF oFld:aDialogs[ 3 ] UPDATE
    
    REDEFINE GET aoObjetos[5]  VAR cId_Lin ID 101 OF oFld:aDialogs[ 3 ] UPDATE ;
      PICTURE "@!" ;
        MESSAGE "Clave de la línea" ;
      VALID EVAL ( { || cId_Lin := ValCod( cId_Lin, "lin"), ;
                                cNomLin := lin->nombre, ;
                                nOpcion := 3, oDlg:Update(), .T. } )
        aoObjetos[5]:cToolTip := "Introduzca o seleccione la clave de la línea"

   REDEFINE GET aoObjetos[6] VAR cNomLin ID 102 OF oFld:aDialogs[ 3 ] UPDATE ;
        WHEN .F.

    REDEFINE BUTTONBMP aoBtn[5] ID 400 OF oFld:aDialogs[3] ;
    PROMPT "A&ceptar " ;
    BITMAP "BTN_OK" TEXTRIGHT ;
    ACTION ( Filtra( nOpcion, cId_Lin, cNomLin, oDlgCot ), oDlg:End() ) ;
      MESSAGE "Aceptar" UPDATE
      aoBtn[5]:cToolTip := "Presione para Continuar"

    REDEFINE BUTTONBMP aoBtn[6] ID 401 OF oFld:aDialogs[3] ;
        PROMPT "&Cancelar " BITMAP "BTN_CAN" TEXTRIGHT ;
    ACTION ( lContinuar := .F., oDlg:End() ) ;
      MESSAGE "Cancelar" UPDATE
      aoBtn[6]:cToolTip := "Presione para Cancelar"

   ACTIVATE DIALOG oDlg CENTERED ;
      ON INIT ( oninit( oDlg ), aoObjetos[1]:SetFocus() )

return nil

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

STATIC FUNCTION ExpImg()
    LOCAl oDlg
    LOCAL cOpcion := "Actual", nFormat := "2 - Jpg"
    LOCAL aoCbx := { nil, nil }
    LOCAL aoBtn := { nil, nil }
    
    
    DEFINE DIALOG oDlg RESOURCE "DLG_EXP_IMG" TITLE "Exporta imágenes"
    
    REDEFINE COMBOBOX aoCbx[1] VAR cOpcion  ID 201 OF oDlg UPDATE ;
        ITEMS { "Actual", "Resto", "Todas" }
        
    REDEFINE COMBOBOX aoCbx[2] VAR nFormat  ID 202 OF oDlg UPDATE ;
        ITEMS { "0 - Bmp", "2 - Jpg", "13 - Png" }
        
    REDEFINE BUTTON PROMPT "Aceptar" ID 400 OF oDlg UPDATE ;
        ACTION ( Exporta( cOpcion, nFormat ), oDlg:End() )
        
    REDEFINE BUTTON PROMPT "Cancelar" ID 401 OF oDlg UPDATE ;
        ACTION oDlg:End()
        
    ACTIVATE DIALOG oDlg CENTERED
    
RETURN NIL

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

STATIC FUNCTION Exporta( cOpcion, nFormat )
    LOCAL nQuality := 100, cImagen, nRegAnt := (cAlias)->(recno())
    LOCAL cRutaFile := cGetDir()
    
    if (cAlias)->(reccount()) = 0
        MsgInfo( "No hay imagenes para exportar" )
        RETURN NIL
    endif
    
    nFormat := VAL(LEFT(nFormat,2))
    
    if empty(cRutaFile)
        MsgInfo("No seleccionó ningun directorio")
        RETURN NIL
    endif
    IF LEFT(cOpcion,1) == "A"
        cImagen := trim((cAlias)->modelo)+iif(nFormat==0,".BMP",iif(nFormat==2,".JPG",".PNG"))
        oImage:SaveImage(cRutaFile+"\"+cImagen,nFormat, nQuality)
        MsgInfo( "Imagen exportada..." )
        RETURN NIL
    ENDIF
    IF LEFT(cOpcion,1) == "T"
        (cAlias)->(dbgotop())
    ENDIF
    
    DO WHILE ! (cAlias)->(eof())
        cImagen := trim((cAlias)->modelo)+iif(nFormat==0,".BMP",iif(nFormat==2,".JPG",".PNG"))
        oImage:LoadFromMemory((cAlias)->imagen)
        oImage:SaveImage(cRutaFile+"\"+cImagen,nFormat,nQuality)
        (cAlias)->(dbskip())
    ENDDO
    MsgInfo( "Proceso de exportación terminado...")
    (cAlias)->(dbgoto(nRegAnt))
    oImage:LoadFromMemory( (cAlias)->imagen ); oImage:Refresh(); oBrw:SetFocus()
    
return nil
    
//----------------------------------------------------------------------------//

STATIC FUNCTION f_Existe_Modelo( cModelo )
   LOCAL lExiste := .F.
    IF (cAlias)->(dbseek(cModelo))
        lExiste := .t.
   ENDIF
RETURN(lExiste)

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

STATIC FUNCTION Filtra( nOpcion, cClave, cNomCla, oDlgCot )
    LOCAL cTexto := "Detalle de modelos filtrados por : "
    IF nOpcion = 1
        art->(OrdSetFocus(2))
        cTexto := cTexto + "Proveedor : [ " + TRIM(cClave) + " - " + TRIM(cNomCla) + " ]"
    ELSEIF nOpcion = 2
        art->(OrdSetFocus(3))
        cTexto := cTexto + "Marca : [ " + TRIM(cClave) + " - " + TRIM(cNomCla) + " ]"
    ELSEIF nOpcion = 3
        art->(OrdSetFocus(4))
        cTexto := cTexto + "Línea : [ " + TRIM(cClave) + " - " + TRIM(cNomCla) + " ]"
    ENDIF
    
    art->(Dbgotop())
   art->(OrdScope(0,))
   art->(OrdScope(1,))
   art->(dbgotop())
   art->(OrdScope(0,cClave))    //  filtrar registro inicial
   art->(OrdScope(1,cClave))    // hasta registro final
   art->(Dbgotop())
   ImgAdjust(oImage:LoadFromMemory( (cAlias)->imagen )); oImage:Refresh(); oBrw:SetFocus()
   oDlgCot:SetText( cTexto )
   
RETURN NIL

//----------------------------------------------------------------------------//        
function GetImage()
   local gcFile := cGetFile( "Bitmap (*.bmp)| *.bmp|" +         ;
                             "DIB   (*.dib)| *.dib|" +          ;
                             "PCX   (*.pcx)| *.pcx|"  +         ;
                             "JPEG  (*.jpg)| *.jpg|" +          ;
                             "GIF   (*.gif)| *.gif|"  +         ;
                             "TARGA (*.tga)| *.tga|" +          ;
                             "RLE   (*.rle)| *.rle|" +          ;
                             "All Files (*.*)| *.*"             ;
                            ,"Please select a image file", 4 )

   if ! Empty( gcFile ) .and. File( gcFile )
    ImgAdjust( oImage:LoadBmp(gcFile) )
   endif

return nil

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

function GuardaImagen()
    local oDlg
    local aoObjetos := { nil, nil, nil, nil, nil, nil }
    local aoSay := { nil, nil, nil }
    local aoBtn := { nil, nil }
    local cModelo := space(40), cNomIma, cDesc := space(50)
    local cId_Pro, cId_Mar, cId_Lin
    local cNomPro, cNomMar, cNomLin
    local lContinuar := .f., lAddReg := .f.
    local cRuta := CurDrive()+":\"+CurDir()+"\imagenes\", cFoto
    cId_Pro := cId_Mar := cId_Lin := space(5)
    cNomPro := cNomMar := cNomLin := " "
    cDesCor := space(45)
    
    DEFINE DIALOG oDlg RESOURCE "DLG_TRES" TITLE "Guardar imagen"
   
    REDEFINE GET aoObjetos[1] VAR cModelo   ID 101 OF oDlg UPDATE ;
        PICTURE "@!" ;
        VALID EVAL ( { || iif(f_Existe_Modelo( cModelo ), ;
                                    iif( !MsgYesNo("El modelo ya existe, lo sobreescribe ?",oApp:cEmpresa),(aoObjetos[1]:SetPos(1),.f.), ;
                                        ( lAddReg := .f., cId_Pro := (cAlias)->id_pro, cId_Mar := (cAlias)->id_mar, ;
                                          cId_Lin := (cAlias)->id_lin, ;
                                          cNomPro:=iif(pro->(dbseek(cId_Pro)),pro->nombre,""), ;
                                          cNomMar:=iif(mar->(dbseek(cId_Mar)),mar->nombre,""), ;
                                          cNomLin:=iif(lin->(dbseek(cId_Lin)),lin->nombre,""), ;
                                          cDesCor := (cAlias)->descor, cDesc:=(cAlias)->desc, ;
                                          oDlg:Update(),.t.)),(lAddReg := .t.,oDlg:Update(),.t.)) } )
      aoObjetos[1]:cToolTip := "Introduzca el Modelo"
      
    REDEFINE GET aoObjetos[2] VAR cId_Pro   ID 102 OF oDlg UPDATE ;
        PICTURE "@!" ;
        BITMAP "BMP_CATALOGO" ;
      ACTION ( Catalogo( "PRO", .T.), aoObjetos[2]:SetFocus(), oDlg:Update() ) ;
      VALID EVAL ( { || cId_Pro := ValCod( cId_Pro, "pro" ), ;
                        IIF(EMPTY(cId_Pro), (aoObjetos[2]:SetFocus(),.f.), ;
                            (cId_Pro := pro->id, ;
                             cNomPro := pro->nombre, oDlg:Update(), .T.)) } ) ; 
      MESSAGE "Clave del proveedor"
      aoObjetos[2]:cToolTip  := "Introduzca o seleccione el proveedor"
      
    REDEFINE SAY aoSay[1] VAR cNomPro       ID 301 OF oDlg UPDATE      
      
   REDEFINE GET aoObjetos[3] VAR cId_Mar    ID 103 OF oDlg UPDATE ;
        PICTURE "@!" ;
        BITMAP "BMP_CATALOGO" ;
      ACTION ( Catalogo( "MAR", .T.), aoObjetos[3]:SetFocus(), oDlg:Update() ) ;
      VALID EVAL ( { || cId_Mar := ValCod( cId_Mar, "mar" ), ;
                        IIF(EMPTY(cId_Mar), (aoObjetos[3]:SetFocus(),.f.), ;
                            (cId_Mar := mar->id, ;
                             cNomMar := mar->nombre, oDlg:Update(), .T.)) } ) ; 
      MESSAGE "Clave de la marca"
      aoObjetos[3]:cToolTip  := "Introduzca o seleccione la marca"
      
    REDEFINE SAY aoSay[2] VAR cNomMar       ID 302 OF oDlg UPDATE            
      
    REDEFINE GET aoObjetos[4] VAR cId_Lin   ID 104 OF oDlg UPDATE ;
        PICTURE "@!" ;
        BITMAP "BMP_CATALOGO" ;
      ACTION ( Catalogo( "LIN", .T.), aoObjetos[4]:SetFocus(), oDlg:Update() ) ;
      VALID EVAL ( { || cId_Lin := ValCod( cId_Lin, "lin" ), ;
                        IIF(EMPTY(cId_Lin), (aoObjetos[4]:SetFocus(),.f.), ;
                            (cId_Lin := lin->id, ;
                             cNomLin := lin->nombre, oDlg:Update(), .T.)) } ) ; 
      MESSAGE "Clave de la linea"
      aoObjetos[4]:cToolTip  := "Introduzca o seleccione la linea" 
              
    REDEFINE SAY aoSay[3] VAR cNomLin       ID 303 OF oDlg UPDATE
    
    REDEFINE GET aoObjetos[5] VAR cDesCor   ID 105 OF oDlg UPDATE ;
        PICTURE "@!"          
       
    REDEFINE GET aoObjetos[5] VAR cDesc     ID 106 OF oDlg UPDATE MEMO
    
    REDEFINE BUTTON aoBtn[1]    ID 400 OF oDlg UPDATE ;
        ACTION ( lContinuar := .t., ;
                    oImage:SaveImage( ".\imagenes\"+alltrim(cModelo)+".JPG",2,75), ;
                    oDlg:End() )
        
    REDEFINE BUTTON aoBtn[2]    ID 401 OF oDlg UPDATE ;
        ACTION ( lContinuar := .f., oDlg:End() )
    
    ACTIVATE DIALOG oDlg CENTER
    
    if lContinuar
        if lAddReg
            IF (cAlias)->(Add_Rec())
                replace (cAlias)->modelo    WITH cModelo
                replace (cAlias)->id_pro    with cId_Pro
                replace (cAlias)->id_mar    with cId_Mar
                replace (cAlias)->id_lin    with cId_Lin
                replace (cAlias)->descor    with cDesCor
                replace (cAlias)->desc      with cDesc
                replace (cAlias)->imagen    with MEMOREAD(".\imagenes\"+TRIM(cModelo)+".JPG")
                (cAlias)->(dbUnlock())
                cFoto := cRuta+TRIM(cModelo)+".JPG"
                ferase( cFoto )
            ENDIF
        ELSE
            IF (cAlias)->(rec_lock())
                replace (cAlias)->modelo    WITH cModelo
                replace (cAlias)->id_pro    with cId_Pro
                replace (cAlias)->id_mar    with cId_Mar
                replace (cAlias)->id_lin    with cId_Lin
                replace (cAlias)->descor    with cDesCor
                replace (cAlias)->desc      with cDesc
                replace (cAlias)->imagen    with MEMOREAD(".\imagenes\"+TRIM(cModelo)+".JPG")
                (cAlias)->(dbUnlock())
            ENDIF
        endif
        cDesCor := alltrim(cDesCor)
    endif
    
return nil
    
//----------------------------------------------------------------------------//    

/*
Te envío la función que hice para que el control se ajuste a la proporción de la imagen (aspect ratio).
Además de mantener el aspect ratio de la foto, la imagen siempre se ajustará a un tamaño menor o igual al del control.

Parámetros:
oImg es el control
bLoadImage es el codeblock para cargar la imagen. Ej: {|o| o:Load(,"Foto_1625.jpg") }
lHCenterControl indica si se debe centrar el control horizontalmente en el área que ocupaba inicialmente.

Es necesario guardar antes la posición y dimensiones originales del control. Lo hice en su :Cargo, pero puedes cambiar esto.
Todos _ deben hacerse con la imagen oculta.

Saludos
César Lozada*/

Function ImgAdjust( Imagen, lHCenterControl )
    Local dHImg, dWImg, nRatioImg
    Local yTctl, xLctl, dHctl, dWctl
    Local yTctl_2, xLctl_2, dHctl_2, dWctl_2
    
    DEFAULT lHCenterControl:=.T.
    
    // Guardar posición y diemnsiones iniciales del control si no lo hecho
    
    IF Empty(oImage:Cargo)
        WITH OBJECT oImage:tControl()
            oImage:Cargo:={:nTop,:nLeft,:nWidth,:nHeight}
        END
    ENDIF
    
    // Todo debe hacerse con la imagen oculta
    oImage:Hide()
    
    // Cargar imagen
    //IF ValType(bLoadImg)="B"
    //  Eval(bLoadImg,oImage)
    //ENDIF
    
    // dimensiones y aspect ratio de la imagen
    WITH OBJECT oImage
        dWImg:=:nWidth
        dHImg:=:nHeight
        nRatioImg := dWimg/dHImg
    END
    
    // restablecer control a su posición y dimensiones originales
    WITH OBJECT oImage
        :Move( yTctl:=:Cargo[1], xLctl:=:Cargo[2], dWctl:=:Cargo[3], dHctl:=:Cargo[4])
    END
    
    //Ajusto el control según el ancho de la imagen
    dWctl_2 := dWctl
    dHctl_2 := Int(dWctl_2/nRatioImg)
    
    //Si la altura de la imagen excede la altura del control ajusto según su altura
    IF dHctl_2>dHctl
        dHctl_2 := dHctl
        dWctl_2 := Int(dHctl_2*nRatioImg)
    ENDIF
    
    //Nueva posición del control
    xLctl_2 := xLctl
    yTctl_2 := yTctl
    
    //Centro el control en el espacio que ocupaba originalmente
    IF lHCenterControl
        xLctl_2 := Int(xLctl+(dWctl-dWctl_2)/2)
    ENDIF
    
    //Mover control a nueva posición y re-dimensionar
    oImage:Move(yTctl_2,xLctl_2,dWctl_2,dHctl_2)
    
    //Mostrar imagen
    oImage:Show()

return nil 

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

FUNCTION MenuDialogo(oDlg)
    LOCAL oMenu
    MENU oMenu 2007
        MENUITEM "" HELP
        MENUITEM "Imagenes "
            MENU
                MENUITEM "&Seleccionar " ;
                    ACTION GetImage( oImage )
                MENUITEM "&Copiar " ;
                    ACTION oImage:CopyToClipboard()
                MENUITEM "&Guardar " ;
                    ACTION ( GuardaImagen(oImage), oDlg:Update(), oBrw:Refresh() )
                MENUITEM "&Imprimir " ;
                    ACTION PrintImage( oImage )
            ENDMENU
        MENUITEM "Items "
            MENU
                MENUITEM "Eliminar item " ;
                    ACTION ( BorrarArticulo(), oBrw:refresh() )
                MENUITEM "Descripción"
                    MENU
                        MENUITEM "Ver descripción" ;
                            ACTION VerDesc( .f. )
                        MENUITEM "Modificar descripción" ;
                            ACTION VerDesc( .t. )
                    ENDMENU 
            ENDMENU
        MENUITEM "Filtrar "
            MENU
                MENUITEM "Filtrar " ;
                    ACTION ( CreaFiltro( oDlg ), oBrw:Refresh() )
                MENUITEM "Restaurar " ;
                    ACTION ( Restaura( oDlg ), oBrw:Refresh() )
            ENDMENU
        MENUITEM "Exportar imagen" ACTION ExpImg()
        MENUITEM "S&alir " ACTION(oDlg:End())

    ENDMENU
oDlg:SetMenu(oMenu)

Return nil
    
//----------------------------------------------------------------------------//    
    
STATIC FUNCTION MeteDesc(cDesc)
    //MsgInfo(cGetDir())
    IF !MsgYesNo( "Seguro que desea modificar la descripción ?",oApp:cEmpresa )
        RETURN NIL
    ENDIF
    IF (cAlias)->(rec_lock())
        replace (cAlias)->desc  WITH cDesc
        (cAlias)->(dbunlock())
    ENDIF
RETURN NIL

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

STATIC FUNCTION Restaura( oDlgCot )
    LOCAL cTexto := "Módulo de imágenes"
    art->(dbSetFilter())
    art->(Dbgotop())
    art->(OrdScope(0,))
    art->(OrdScope(1,))
    art->(dbgotop())
    art->(OrdSetFocus(1))
    art->(dbgotop())
    ImgAdjust(oImage:LoadFromMemory( (cAlias)->imagen )); oImage:Refresh(); oBrw:SetFocus()
    oDlgCot:SetText( cTexto )
RETURN NIL

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

static function VerDesc( lModify )
    LOCAL oDlg, oGet, oBtn
    LOCAL cTitulo := if(lModify,"Modificar descripción","Ver descripción")
    LOCAL nxLineas, x, cDesc := ""
    IF LEN(TRIM((cAlias)->desc)) > 0
      nxLineas := MlCount( (cAlias)->desc, 45 )
      for x := 1 to nxLineas
        cDesc += alltrim(MemoLine( (cAlias)->desc, 45, x ))+CRLF
      next
    ENDIF
    DEFINE DIALOG oDlg RESOURCE "DLG_DES_IMG" TITLE cTitulo
    
    IF lModify
        REDEFINE GET oGet VAR cDesc ID 101 OF oDlg UPDATE ;
            MEMO
    ELSE
        REDEFINE GET oGet VAR cDesc ID 101 OF oDlg UPDATE ;
            MEMO READONLY
    ENDIF
        
    REDEFINE BUTTON oBtn    ID 400 ;
        ACTION IF(lModify,(MeteDesc(cDesc),oDlg:End()),oDlg:End())
        
    ACTIVATE DIALOG oDlg ON INIT oDlg:move(530,690)
    
RETURN NIL
    
//----------------------------------------------------------------------------//

function PrintImage( oImage )

   local oPrn

   PRINT oPrn NAME "Image Printing" PREVIEW
      PAGE
         oPrn:SayImage( 0, 0, oImage )
      ENDPAGE
   ENDPRINT

return nil

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

// FIN DE MODELOS.PRG