Hola, espero te sirva.
PARAMETERS tcBitmapSource, tcBitmapDest, tnMaxWidth, tnMaxHeight
LOCAL llResult
llResult= .F.
LOCAL lcError
lcError = ""
LOCAL loImage, lnAncho, lnAlto, lnWidth, lnHeight
TRY
loImage = CreateObject("image")
loImage.Picture = tcBitmapSource
loImage.Stretch = 0
lnAncho = loImage.Width
lnAlto = loImage.Height
DO CASE
CASE lnAncho = lnAlto
lnHeight = tnMaxHeight
lnWidth = tnMaxWidth
CASE lnAlto > lnAncho
lnPorc = (lnAncho * 100)/ lnAlto
lnHeight = tnMaxHeight
lnWidth = (tnMaxWidth * lnPorc)/100
CASE lnAlto < lnAncho
lnPorc = (lnAlto *100)/ lnAncho
lnHeight = (tnMaxHeight * lnPorc)/100
lnWidth = tnMaxWidth
ENDCASE
IF !PEMSTATUS(_SCREEN, "System", 5)
DO (LOCFILE("
system.app"))
ENDIF
WITH _SCREEN.System.Drawing
* Cargar la imagen original
LOCAL loSrcImage as xfcBitmap
*-loSrcImage = .Bitmap.New(tcBitmapSource)
loSrcImage = .Bitmap.FromFile(tcBitmapSource)
* Crea una nueva imagen con el tamaño deseado
LOCAL loResized as xfcBitmap
loResized = .Bitmap.New(lnWidth, lnHeight,.Imaging.PixelFormat.Format32bppARGB)
* Fija la resolución de la imagen para que sea la misma que la original
loResized.SetResolution(loSrcImage.HorizontalResolution, loSrcImage.VerticalResolution)
* Crea un objeto Graphics para poder obtener los derechos de dibujar sobre el
LOCAL loGfx as xfcGraphics
loGfx = .Graphics.FromImage(loResized)
* Establece algunas propiedades para asegurarse de tener la mejor calidad de la imagen
loGfx.SmoothingMode = .Drawing2D.SmoothingMode.HighQuality
loGfx.InterpolationMode = .Drawing2D.InterpolationMode.HighQualityBicubic
* Dibuja la imagen original en la nueva imagen con las dimensiones deseadas
loGfx.DrawImage(loSrcImage, 0, 0, lnWidth, lnHeight)
* Hace toda la imagen transparente
*-loGfx.Clear(.Color.FromARGB(0,0,0,0))
* Crea Carpeta de Destino en caso de que no Exista
IF !DIRECTORY(JUSTPATH(tcBitmapDest))
MD (JUSTPATH(tcBitmapDest) )
ENDIF
* Guarda la imagen redimensionada como Png
DO CASE
CASE UPPER(JUSTEXT(tcBitmapDest)) = "BMP"
loResized.Save(tcBitmapDest, .Imaging.ImageFormat.bmp)
CASE UPPER(JUSTEXT(tcBitmapDest)) = "TIF"
loResized.Save(tcBitmapDest, .Imaging.ImageFormat.tiff)
CASE UPPER(JUSTEXT(tcBitmapDest)) = "JPG"
loResized.Save(tcBitmapDest, .Imaging.ImageFormat.jpeg)
CASE UPPER(JUSTEXT(tcBitmapDest)) = "GIF"
loResized.Save(tcBitmapDest, .Imaging.ImageFormat.gif)
OTHERWISE
loResized.Save(tcBitmapDest, .Imaging.ImageFormat.png)
ENDCASE
ENDWITH
llResult = FILE(tcBitmapDest)
IF !llResult
lcError = "No se ha podido crear la Imagen"
ENDIF
CATCH TO loErr
lcError = "No se ha podido crear la Imagen: "+loErr.Message
llResult = .F.
ENDTRY
IF !llResult
=MESSAGEBOX("No se ha podido crear la Imagen en miniatura."+CHR(13)+lcError)
ENDIF
RETURN llResult