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 los cambios 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/gv5olyoiim7s6g5/1700512.JPG
http://www.mediafire.com/view/d52ayo35e5tu65k/1701054.JPG

Code: Select all | Expand

#include 'fivewin.ch'#include 'xbrowse.ch'#include "ord.ch"#include 'image.ch'STATIC cAlias, oImage, oBrw, cDesCorfunction 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())    endifreturn 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.   ENDIFRETURN(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) )   endifreturn 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 controlbLoadImage 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 los cambios deben hacerse con la imagen oculta.SaludosCé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())    ENDMENUoDlg: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())    ENDIFRETURN 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   ENDPRINTreturn nil//----------------------------------------------------------------------------//// FIN DE MODELOS.PRG