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
o tal vez fume mucho 
