30 de junio de 2015

BMPs con fondos transparentes

Artículo original: BMPs with Transparent Backgrounds
http://weblogs.foxite.com/vfpimaging/archive/2007/10/24/5190.aspx
Autor: Cesar Ch.
Traducido por: Luis María Guayán


Aquí están algunas notas sobre BMPs transparentes en VFP, basadas en algunas conclusiones que tomé después de varios debates en Foxite, especialmente aquellos con Bernard Bout.

Los archivos de imágenes BMP, cuando se utilizan en la propiedad Picture de un control Image, suelen mostrar los blancos (RGB (255,255,255)) como transparente. VFP crea una máscara temporal para las imágenes a fin de mostrarlas de esta manera.

Imagen 1: Los BMPs pueden tener los blancos convertidos a transparentes cuando se lo utiliza en la propiedad "Picture" y se configura "BackStyle" en "Transparente".

Pero esto sólo funciona para la propiedad PICTURE, NO para PICTUREVAL!

El siguiente código crea una simple imagen sobre la marcha, y la guarda en disco. La imagen de la izquierda utiliza la propiedad PICTURE, y la derecha utiliza PICTUREVAL.

IMPORTANTE

Requiere VFP9 y GdiPlusX para funcionar.

¡Por favor asegúrese que tiene la última versión!

http://www.codeplex.com/VFPX/Wiki/View.aspx?title=GDIPlusX&referringTitle=Home

PUBLIC oForm
oForm = NEWOBJECT("form1")
oForm.Show
RETURN
 
DEFINE CLASS form1 AS form
   Top = 13
   Left = 17
   Height = 168
   Width = 314
   DoCreate = .T.
   Caption = "Testing PictureVal rendering"
   Name = "Form1"

ADD OBJECT image1 AS image WITH ;
   BackStyle = 0, ;
   Height = 120, ;
   Left = 24, ;
   Top = 24, ;
   Width = 120, ;
   Name = "Image1"

ADD OBJECT image2 AS image WITH ;
   BackStyle = 0, ;
   Height = 120, ;
   Left = 168, ;
   Top = 24, ;
   Width = 120, ;
   Name = "Image2"

PROCEDURE Init
   DO LOCFILE("System.prg")
   LOCAL loBmp as xfcBitmap
   LOCAL loGfx as xfcGraphics
   WITH _Screen.System.Drawing 
      loBmp = .Bitmap.New(60, 60, 0, .Imaging.PixelFormat.Format24bppRGB)
      loGfx = .Graphics.FromImage(loBmp)
      loGfx.Clear(.Color.White)
      loGfx.DrawRectangle(.Pen.New(.Color.Red, 3), 10,10,40,40)
      loBmp.Save("c:\tempBMP.bmp", .Imaging.ImageFormat.Bmp)
   ENDWITH
   Thisform.Image1.Picture = "c:\tempBMP.bmp"
   Thisform.Image2.PictureVal = FILETOSTR("c:\tempBMP.bmp")
ENDPROC

ENDDEFINE

Imagen 2: Los BMPs muestran el BLANCO como transparentes sólo cuando se utiliza la propiedad "Picture". Cuando se utiliza la propiedad "PictureVal", se muestra sin una máscara transparente.

La imagen de la izquierda utiliza la propiedad Picture, y la de la derecha utiliza la propiedad PictureVal de la forma más sencilla: FILETOSTRING("c:\MyPicture.Bmp")

Esto nos demuestra que, lamentablemente, no podemos obtener transparencias en BMPs utilizando la propiedad PictureVal.

Afortunadamente en VFP9 SP2, el Equipo VFP corrigió el problema con las presentación de lo PNG, y podemos usar nuestros archivos PNGs con los objetos Image de VFP. Pero en este caso, la necesidad de establecer manualmente el canal Alpha, especificando que color (o colores) se convertiran en transparente.

Con GdiPlusX estas cosas se vuelven realmente fáciles. Solo una línea hará el truco:

This.oBmp.MakeTransparent(.Color.White)

Reemplace el código del procedimiento INIT() de arriba, con el que se muestra abajo, que solo cambia a la prestación PNG, y utiliza el método "MAKETRANSPARENT" de la libreria xfcBitmap GdiPlusX:

PROCEDURE Init
   DO LOCFILE("System.prg")
   LOCAL loBmp as xfcBitmap
   LOCAL loGfx as xfcGraphics
   WITH _Screen.System.Drawing 
      loBmp = .Bitmap.New(60, 60) && The default is 32bppARGB
      loGfx = .Graphics.FromImage(loBmp)
      loGfx.Clear(.Color.White)
      loGfx.DrawRectangle(.Pen.New(.Color.Red, 3), 10,10,40,40)
      loBmp.MakeTransparent(.Color.White)
      loBmp.Save("c:\tempPNG.png", .Imaging.ImageFormat.Png)
   ENDWITH
   Thisform.Image1.Picture = "c:\tempPNG.png"
   Thisform.Image2.PictureVal = FILETOSTR("c:\tempPNG.png")
ENDPROC

Imagen 3: Los PNGs permiten el uso de los canales Alpha, de modo que las transparencias están disponibles tanto para las propiedades Picture y PictureVal.

¿Esto es suficiente?

Aun no es suficiente para Bernard - Parte 1

Como él dijo en un hilo de Foxite: "VFP tiene un problema refrescando PNGs de un tamaño razonable. Hacen "Flash". El mejor formato para usar con VFP es BMP". - TOTALMENTE CIERTO - Bah!. Esto es muy fácil de reproducir, crear cualquier formulario, poner un objeto imagen dentro del mismo, utilizando cualquier imagen PNG. Luego, agregue otra imagen, pero esta vez utilizar un BMP. Configurar las propiedades Anchor, ejecutar el formulario y cambiar su tamaño para comprender lo que ocurre. Tal vez para la gran mayoría de las personas esto es aceptable, pero con BMPs podemos tener un buen resultado.

Aun no es suficiente para Bernard - Parte 2

El observo que los BMPs se originaron a partir de los ejemplos que he venido utilizando con GDI+ y no podría haber convertido sus BLANCOS a TRANSPARENTES cuando se utilizan en el control Imagen.

!#*$¨*&¨($%+)(*#$%&(_*%¨#)&*(¨#&*()YUIOH%&*_#(*&%(_*#$¨

La verdad es que él había reportado esto el año pasado, cuando creé un ejemplo para su fabuloso ONE NOTE TABS - VFP -X GDI+ code samples for "Recreating One Note Tabs in VFP9" from Bernard

Él acaba de traer este tema otra vez en un hilo reciente de Foxite, y finalmente me tomé el tiempo para hacer algunas nuevas pruebas, y encontré el problema.

En la mayoria de casos, cuando creé mis bitmaps desde cero, usé el método xfcBitmap.Create(), exactamente como esto:

LOCAL loBmp as xfcBitmap
loBmp = .Bitmap.New(lnWidth, lnHeight)

Esto crea por defecto un mapa de bits con las dimensiones lnWidth X lnHeight, con 32bppARGB PixelFormat. Esto significa que para cada píxel del mapa de bits se utilizan 32bits, o 4 bytes, para ROJO, VERDE, AZUL y ALPHA (transparencia).

¡Pero los BMPs no soportan transparencias!

De esta manera, el byte ALFA es totalmente inútil para el caso de BMPs, haciendo nuestro archivo un 25% más grande...

El mayor problema es que VFP no transforma BLANCOS de Bitmaps de 32bppARGB en transparente!!!

Así, creando un mapa de bit que será guardado con el formato de imagen BMP, NUNCA use 32bppARGB. ¡Use en cambio 24bppRGB! Y este definitivamente soluciona nuestro problema, y Bernard será capaz de continuar desarrollando sus obras maestras de su diseño, con esperanza, usando GdiPlusX.

En lugar de:

loBmp = .Bitmap.New(lnWidth, lnHeight)

Uso:

loBmp = .Bitmap.New(60, 60, 0, .Imaging.PixelFormat.Format24bppRGB)

¡Gracias Bernard! Esto fue una buena lección para mí, he aprendido varias cosas buenas en esta investigación. Muy gentil, ya que esto trae algunas nuevas posibilidades para varios de los nuevos controles.

El control GdiPlusX ImageCanvas también recibirá algunas modificaciones, lo que permite interpretar en modo de archivo, guardando en archivos TMP, pero utilizando 24bppRGB, para permitir las transparencias. Otra modificación que hemos acordado, es agregar un modo de interpretar PNG, ya que los PNGs permiten el uso del canal alfa.

VFPPaint también ha sido actualizado, y permite a los usuarios elegir entre 24bppRGB (nuevo valor por omisión) y 32bppARGB.


25 de junio de 2015

Dibujar Logos en sus imágenes con GdiPlusX - Parte 2

Artículo original: Draw Logos in your images with GdiPlusX - Part 2
http://weblogs.foxite.com/vfpimaging/archive/2007/07/27/4338.aspx
Autor: Cesar Ch.
Traducido por: Luis Maria Guayán


Aquí están 5 nuevos ejemplos derivados de otros que mostré en un artículo anterior. (Nota del traductor: la traducción de este artículo está en este Blog)

Para todos los ejemplos que proporcionaré, el logo de VFPX será dibujado en algunas imágenes mas grandes. Para demostrar toda la flexibilidad que GDI+ puede ofrecernos, algunos efectos serán aplicados al logo.

IMPORTANTE

Requiere VFP9 y GdiPlusX para funcionar.

¡Por favor asegúrese que tiene la última versión!

http://www.codeplex.com/VFPX/Wiki/View.aspx?title=GDIPlusX&referringTitle=Home

EJEMPLO 5:

Aplico 100% de transparencia al color blanco para eliminar el fondo. Dibujo el logo aplicando la matriz de color definida con la siguiente transformación: convierto a escala de grises con 50% de transparencia a toda la imagen.
Posición: Borde superior izquierdo.

_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx"))) 
WITH _SCREEN.System.Drawing as xfcDrawing

  LOCAL lcMainPict, lcLogoPict
  LOCAL loMainBmp as xfcBitmap
  LOCAL loLogoBmp as xfcBitmap
  LOCAL loGfx as xfcGraphics

  lcMainPict = GETPICT()
  lcLogoPict = GETPICT()
  loMainBmp = .Bitmap.FromFile(lcMainPict)
  loLogoBmp = .Bitmap.FromFile(lcLogoPict)
  loGfx = .Graphics.FromImage(loMainBmp)
 
  *!* Sample 5
  *!* Aply 100% transparency to the white color, to eliminate the background
  *!* Draw the logo aplying predefined ColorMatrix that will 
  *!* the following transformation: convert to greyscale 50% transparency to the whole image
  *!* Position: Top Left

  * First step: eliminate the white background
  loLogoBmp.MakeTransparent(.Color.White)

  * Define the transparency ratio that will be aplied
  * This parameter ranges from 0 (totally transparent) to 1 (totally opaque)
  LOCAL lnTranspRatio
  lnTranspRatio = 0.50 && 50%

  * Create a ColorMatrix that will have the transformations information
  * The position (4,4) of the matrix is responsible for the opacity 
  LOCAL loClrMatrix AS xfcColorMatrix
  loClrMatrix = .Imaging.ColorMatrix.New( ; 
     0.33, 0.33, 0.33, 0 , 0, ; 
     0.33, 0.33, 0.33, 0 , 0, ; 
     0.33, 0.33, 0.33, 0 , 0, ;
     0, 0, 0, lnTranspRatio, 0, ; 
     0, 0, 0, 0 , 0)

  * Create an Image Attributes object to create the effects based in our ClrMatrix
  LOCAL loAttr AS xfcImageAttributes
  loAttr = .Imaging.ImageAttributes.New() 
  loAttr.SetColorMatrix(loClrMatrix)

  * We need to create a rectangle that will contain the coordinates and size of the transformed logo
  LOCAL loRect as xfcRectangle
  loRect = .Rectangle.New()
  loRect.X = 0 
  loRect.Y = 0
  loRect.Width = loLogoBmp.Width
  loRect.Height = loLogoBmp.Height 

  * Draw the transformed image using the rectangle and ImgAttributes/ClrMatrix
  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loMainBmp.Save("c:\logo5.jpg", .Imaging.ImageFormat.Jpeg)
  RUN /N explorer.exe c:\logo5.jpg
ENDWITH 
RETURN

Ejemplo 6:

Aplico 100% de transparencia al color blanco para eliminar el fondo. Dibujo el logo aplicando la matriz de color definida con la siguiente transformación: convierto a escala de grises con 50% de transparencia a toda la imagen.
Posición: Centro.
Tamaño: Agrandada 4 veces

_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx")))

WITH _SCREEN.System.Drawing as xfcDrawing

  LOCAL lcMainPict, lcLogoPict
  LOCAL loMainBmp as xfcBitmap
  LOCAL loLogoBmp as xfcBitmap
  LOCAL loGfx as xfcGraphics

  lcMainPict = GETPICT()
  lcLogoPict = GETPICT()
  loMainBmp = .Bitmap.FromFile(lcMainPict)
  loLogoBmp = .Bitmap.FromFile(lcLogoPict)
  loGfx = .Graphics.FromImage(loMainBmp)
 
  *!* Sample 6
  *!* Aply 100% transparency to the white color, to eliminate the background
  *!* Draw the logo aplying predefined ColorMatrix that will 
  *!* the following transformation: convert to greyscale 50% transparency to the whole image
  *!* Position: Center
  *!* Size: Expanded 4 times

  * First step: eliminate the white background
  loLogoBmp.MakeTransparent(.Color.White)

  * Define the transparency ratio that will be aplied
  * This parameter ranges from 0 (totally transparent) to 1 (totally opaque)
  LOCAL lnTranspRatio
  lnTranspRatio = 0.25 && 25%

  * Create a ColorMatrix that will have the transformations information
  * The position (4,4) of the matrix is responsible for the opacity 
  LOCAL loClrMatrix AS xfcColorMatrix
  loClrMatrix = .Imaging.ColorMatrix.New( ; 
     0.33, 0.33, 0.33, 0 , 0, ; 
     0.33, 0.33, 0.33, 0 , 0, ; 
     0.33, 0.33, 0.33, 0 , 0, ;
     0, 0, 0, lnTranspRatio, 0, ; 
     0, 0, 0, 0 , 0)

  * Create an Image Attributes object to create the effects based in our ClrMatrix
  LOCAL loAttr AS xfcImageAttributes
  loAttr = .Imaging.ImageAttributes.New() 
  loAttr.SetColorMatrix(loClrMatrix)

  * We need to create a rectangle that will contain the coordinates and size of the transformed logo
  LOCAL loRect as xfcRectangle
  loRect = .Rectangle.New()
  loRect.X = (loMainBmp.Width - loLogoBmp.Width*4) / 2 
  loRect.Y = (loMainBmp.Height - loLogoBmp.Height*4) / 2
  loRect.Width = loLogoBmp.Width * 4
  loRect.Height = loLogoBmp.Height * 4

  * Draw the transformed image using the rectangle and ImgAttributes/ClrMatrix
  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loMainBmp.Save("c:\logo6.jpg", .Imaging.ImageFormat.Jpeg)

  RUN /N explorer.exe c:\logo6.jpg
ENDWITH 
RETURN

Ejemplo 7:

Aplico 100% de transparencia al color blanco para eliminar el fondo. Dibujo el logo aplicando 25% de opacidad a toda la imagen.
Posición: Centro.
Tamaño: Agrandada 4 veces

_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx")))

WITH _SCREEN.System.Drawing as xfcDrawing

  LOCAL lcMainPict, lcLogoPict
  LOCAL loMainBmp as xfcBitmap
  LOCAL loLogoBmp as xfcBitmap
  LOCAL loGfx as xfcGraphics

  lcMainPict = GETPICT()
  lcLogoPict = GETPICT()
  loMainBmp = .Bitmap.FromFile(lcMainPict)
  loLogoBmp = .Bitmap.FromFile(lcLogoPict)
  loGfx = .Graphics.FromImage(loMainBmp)
 
  *!* Sample 7
  *!* Aply 100% transparency to the white color, to eliminate the background
  *!* Draw the logo aplying 25% OPACITY to the whole image
  *!* Position: CENTER
  *!* Size: Expanded 4 times

  * First step: eliminate the white background
  loLogoBmp.MakeTransparent(.Color.White)

  * Define the transparency ratio that will be aplied
  * This parameter ranges from 0 (totally transparent) to 1 (totally opaque)
  LOCAL lnTranspRatio
  lnTranspRatio = 0.25 && 25%

  * Create a ColorMatrix that will have the transformations information
  * The position (4,4) of the matrix is responsible for the opacity 
  LOCAL loClrMatrix AS xfcColorMatrix
  loClrMatrix = .Imaging.ColorMatrix.New( ; 
     1, 0, 0, 0 , 0, ; 
     0, 1, 0, 0 , 0, ; 
     0, 0, 1, 0 , 0, ;
     0, 0, 0, lnTranspRatio, 0, ; 
     0, 0, 0, 0 , 0)

  * Create an Image Attributes object to create the effects based in our ClrMatrix
  LOCAL loAttr AS xfcImageAttributes
  loAttr = .Imaging.ImageAttributes.New() 
  loAttr.SetColorMatrix(loClrMatrix)

  * We need to create a rectangle that will contain the coordinates and size of the transformed logo
  LOCAL loRect as xfcRectangle
  loRect = .Rectangle.New()
  loRect.X = (loMainBmp.Width - loLogoBmp.Width*4) / 2 
  loRect.Y = (loMainBmp.Height - loLogoBmp.Height*4) / 2
  loRect.Width = loLogoBmp.Width * 4
  loRect.Height = loLogoBmp.Height * 4

  * Draw the transformed image using the rectangle and ImgAttributes/ClrMatrix
  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loMainBmp.Save("c:\logo7.jpg", .Imaging.ImageFormat.Jpeg)
  RUN /N explorer.exe c:\logo7.jpg
ENDWITH 
RETURN

Ejemplo 8:

Usando la tecnica mostrada anteriormente, dibujo logos y textos aplicando transparencias variables.

El siguiente código no está optimizado, y solo intenta mostrar algunas posibilidades.

_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx")))

WITH _SCREEN.System.Drawing as xfcDrawing

  LOCAL lcMainPict, lcLogoPict
  LOCAL loMainBmp as xfcBitmap
  LOCAL loLogoBmp as xfcBitmap
  LOCAL loGfx as xfcGraphics
  lcMainPict = GETPICT()
  lcLogoPict = GETPICT()
  loMainBmp = .Bitmap.FromFile(lcMainPict)
  loLogoBmp = .Bitmap.FromFile(lcLogoPict)
  loGfx = .Graphics.FromImage(loMainBmp)
 
  *!* Sample 8
  *!* Draw image and text in different transparencies
  LOCAL lcString
  LOCAL loFont as xfcFont
  loFont = .Font.New("Verdana", 22, .FontStyle.BoldItalic)
  LOCAL loColor as xfcColor
  loColor = .Color.White
  LOCAL lnXString
  lnXString = 0 + loLogoBmp.Width
 
  * First step: eliminate the white background
  loLogoBmp.MakeTransparent(.Color.White)

  * Define the transparency ratio that will be aplied
  * This parameter ranges from 0 (totally transparent) to 1 (totally opaque)
  LOCAL lnTranspRatio

  * Create a ColorMatrix that will have the transformations information
  * The position (4,4) of the matrix is responsible for the opacity 
  LOCAL loClrMatrix AS xfcColorMatrix
  loClrMatrix = .Imaging.ColorMatrix.New()

  * Create an Image Attributes object to create the effects based in our ClrMatrix
  LOCAL loAttr AS xfcImageAttributes
  loAttr = .Imaging.ImageAttributes.New() 

  * We need to create a rectangle that will contain the coordinates and size of the transformed logo
  LOCAL loRect as xfcRectangle
  loRect = .Rectangle.New()
  loRect.Width = loLogoBmp.Width
  loRect.Height = loLogoBmp.Height
  LOCAL loBrush as xfcSolidBrush
  loBrush = .SolidBrush.New(loColor)
 
  * Step 1
  * Draw image and text 100% opaque
  lnOpaqueRatio = 1 && 100%
  loClrMatrix.Matrix33 = lnOpaqueRatio
  loAttr.SetColorMatrix(loClrMatrix)
  loRect.X = 0 
  loRect.Y = ( loMainBmp.Height / 5 * 1) - loLogoBmp.Height

  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loGfx.DrawString("GdiPlusX Powered - 100% opaque", loFont, loBrush, lnXString, loRect.Y)
 
  * Step 2
  * Draw image and text 80% opaque
  lnOpaqueRatio = .80
  loClrMatrix.Matrix33 = lnOpaqueRatio
  loAttr.SetColorMatrix(loClrMatrix)
  loRect.X = 0 
  loRect.Y = ( loMainBmp.Height / 5 * 2) - loLogoBmp.Height
  loColor.A = lnOpaqueRatio * 255
  loBrush.Color = loColor

  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loGfx.DrawString("GdiPlusX Powered - 80% opaque", loFont, loBrush, lnXString, loRect.Y)
 
  * Step 3
  * Draw image and text 60% opaque
  lnOpaqueRatio = .60
  loClrMatrix.Matrix33 = lnOpaqueRatio
  loAttr.SetColorMatrix(loClrMatrix)
  loRect.X = 0 
  loRect.Y = ( loMainBmp.Height / 5 * 3) - loLogoBmp.Height

  loColor.A = lnOpaqueRatio * 255
  loBrush.Color = loColor

  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loGfx.DrawString("GdiPlusX Powered - 60% opaque", loFont, loBrush, lnXString, loRect.Y)
 
  * Step 4
  * Draw image and text 40% opaque
  lnOpaqueRatio = .40
  loClrMatrix.Matrix33 = lnOpaqueRatio
  loAttr.SetColorMatrix(loClrMatrix)
  loRect.X = 0 
  loRect.Y = ( loMainBmp.Height / 5 * 4) - loLogoBmp.Height

  loColor.A = lnOpaqueRatio * 255
  loBrush.Color = loColor

  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loGfx.DrawString("GdiPlusX Powered - 40% opaque", loFont, loBrush, lnXString, loRect.Y)
 
  * Step 4
  * Draw image and text 20% opaque
  lnOpaqueRatio = .20
  loClrMatrix.Matrix33 = lnOpaqueRatio
  loAttr.SetColorMatrix(loClrMatrix)
  loRect.X = 0 
  loRect.Y = ( loMainBmp.Height / 5 * 5) - loLogoBmp.Height

  loColor.A = lnOpaqueRatio * 255
  loBrush.Color = loColor

  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loGfx.DrawString("GdiPlusX Powered - 20% opaque", loFont, loBrush, lnXString, loRect.Y)
 
  loMainBmp.Save("c:\logo8.jpg", .Imaging.ImageFormat.Jpeg)
  RUN /N explorer.exe c:\logo8.jpg
ENDWITH 
RETURN

Ejemplo 9:

Como en los ejemplos anteriores, usando las técnicas ya vistas, dibujo logos y texto aplicando transparencias variables, usando un logo monocromático.

El siguiente código no está optimizado, y solo intenta mostrar algunas posibilidades.

_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx")))

WITH _SCREEN.System.Drawing as xfcDrawing

  LOCAL lcMainPict, lcLogoPict
  LOCAL loMainBmp as xfcBitmap
  LOCAL loLogoBmp as xfcBitmap
  LOCAL loGfx as xfcGraphics

  lcMainPict = GETPICT()
  lcLogoPict = GETPICT()
  loMainBmp = .Bitmap.FromFile(lcMainPict)
  loLogoBmp = .Bitmap.FromFile(lcLogoPict)
  loGfx = .Graphics.FromImage(loMainBmp)
 
  *!* Sample 9
  *!* Draw image and text in different transparencies
  LOCAL lcString
  LOCAL loFont as xfcFont
  loFont = .Font.New("Verdana", 30, .FontStyle.BoldItalic)
  LOCAL loColor as xfcColor
  loColor = .Color.White
  LOCAL loBrush as xfcSolidBrush
  loBrush = .SolidBrush.New(loColor)
 
  LOCAL lnXString
  lnXString = 0 + 10 + loLogoBmp.Width
 
  * First step: eliminate the white background
  loLogoBmp.MakeTransparent(.Color.White)

  * Define the transparency ratio that will be aplied
  * This parameter ranges from 0 (totally transparent) to 1 (totally opaque)
  LOCAL lnTranspRatio
  * Create a ColorMatrix that will have the transformations information
  * The position (4,4) of the matrix is responsible for the opacity 

  LOCAL loClrMatrix AS xfcColorMatrix
  loClrMatrix = .Imaging.ColorMatrix.New( ; 
     0.33, 0.33, 0.33, 0 , 0, ; 
     0.33, 0.33, 0.33, 0 , 0, ; 
     0.33, 0.33, 0.33, 0 , 0, ;
     0, 0, 0, 1 , 0, ; 
     0, 0, 0, 0 , 0)
 
  * Create an Image Attributes object to create the effects based in our ClrMatrix
  LOCAL loAttr AS xfcImageAttributes
  loAttr = .Imaging.ImageAttributes.New() 
  * We need to create a rectangle that will contain the coordinates and size of the transformed logo
  LOCAL loRect as xfcRectangle
  loRect = .Rectangle.New()
  loRect.Width = loLogoBmp.Width
  loRect.Height = loLogoBmp.Height
 
  * Step 1
  * Draw image and text 100% opaque
  lnOpaqueRatio = 1 && 100%
  loClrMatrix.Matrix33 = lnOpaqueRatio
  loAttr.SetColorMatrix(loClrMatrix)
  loColor.A = lnOpaqueRatio * 255
  loBrush.Color = loColor
  loRect.X = 0 
  loRect.Y = ( loMainBmp.Height / 5 * 1) - loLogoBmp.Height

  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loGfx.DrawString("GdiPlusX Powered", loFont, loBrush, lnXString, loRect.Y)
 
  * Step 2
  * Draw image and text 80% opaque
  lnOpaqueRatio = .80
  loClrMatrix.Matrix33 = lnOpaqueRatio
  loAttr.SetColorMatrix(loClrMatrix)
  loRect.X = 0 
  loRect.Y = ( loMainBmp.Height / 5 * 2) - loLogoBmp.Height
  loColor.A = lnOpaqueRatio * 255
  loBrush.Color = loColor

  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loGfx.DrawString("GdiPlusX Powered", loFont, loBrush, lnXString, loRect.Y)
  
  * Step 3
  * Draw image and text 60% opaque
  lnOpaqueRatio = .60
  loClrMatrix.Matrix33 = lnOpaqueRatio
  loAttr.SetColorMatrix(loClrMatrix)
  loRect.X = 0 
  loRect.Y = ( loMainBmp.Height / 5 * 3) - loLogoBmp.Height

  loColor.A = lnOpaqueRatio * 255
  loBrush.Color = loColor

  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loGfx.DrawString("GdiPlusX Powered", loFont, loBrush, lnXString, loRect.Y)
 
  * Step 4
  * Draw image and text 40% opaque
  lnOpaqueRatio = .40
  loClrMatrix.Matrix33 = lnOpaqueRatio
  loAttr.SetColorMatrix(loClrMatrix)
  loRect.X = 0 
  loRect.Y = ( loMainBmp.Height / 5 * 4) - loLogoBmp.Height

  loColor.A = lnOpaqueRatio * 255
  loBrush.Color = loColor

  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loGfx.DrawString("GdiPlusX Powered", loFont, loBrush, lnXString, loRect.Y)
 
  * Step 5
  * Draw image and text 20% opaque
  lnOpaqueRatio = .20
  loClrMatrix.Matrix33 = lnOpaqueRatio
  loAttr.SetColorMatrix(loClrMatrix)
  loRect.X = 0 
  loRect.Y = ( loMainBmp.Height / 5 * 5) - loLogoBmp.Height

  loColor.A = lnOpaqueRatio * 255
  loBrush.Color = loColor

  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loGfx.DrawString("GdiPlusX Powered", loFont, loBrush, lnXString, loRect.Y)
  
  * Finished Drawing, Now save the image and show it !
  loMainBmp.Save("c:\logo9.jpg", .Imaging.ImageFormat.Jpeg)
  RUN /N explorer.exe c:\logo9.jpg
ENDWITH 
RETURN

23 de junio de 2015

Dibujar Logos en sus imágenes con GdiPlusX

Artículo original: Draw logos in your images with GdiPlusX
http://weblogs.foxite.com/vfpimaging/archive/2007/07/11/4315.aspx
Autor: Cesar Ch.
Traducido por: Luis Maria Guayán


Otra pregunta común que encuentro siempre en algunos foros de VFP es de gente que desea dibujar algunas imágenes, generalmente logos de la compañía sobre algunas imágenes. Esto es realmente simple, como demostraré mas abajo.

Para todos los ejemplos que proporcionaré, el logo de VFPX será dibujado en algunas imágenes mas grandes. Para demostrar toda la flexibilidad que GDI+ puede ofrecernos, algunos efectos serán aplicados al logo.

IMPORTANTE

Requiere VFP9 y GdiPlusX para funcionar.

¡Por favor asegúrese que tiene la última versión!

http://www.codeplex.com/VFPX/Wiki/View.aspx?title=GDIPlusX&referringTitle=Home

EJEMPLO 1: Dibujo la imagen sin la transformación

_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx")))

WITH _SCREEN.System.Drawing as xfcDrawing

  LOCAL lcMainPict, lcLogoPict
  LOCAL loMainBmp as xfcBitmap
  LOCAL loLogoBmp as xfcBitmap
  LOCAL loGfx as xfcGraphics

  lcMainPict = GETPICT()
  lcLogoPict = GETPICT()

  loMainBmp = .Bitmap.FromFile(lcMainPict)
  loLogoBmp = .Bitmap.FromFile(lcLogoPict)
  loGfx = .Graphics.FromImage(loMainBmp)

  *!* Ejemplo 1 
  *!* Imagen Original
  *!* Posicion : Borde superior izquierdo 
  *!* Dibujo el logo sin ninguna transformación
  loGfx.DrawImage(loLogoBmp, 0, 0)
  loMainBmp.Save("c:\logo1.jpg", .Imaging.ImageFormat.Jpeg)

  * Muestro la imagen
  RUN /N explorer.exe c:\logo1.jpg
ENDWITH

EJEMPLO 2: Convierto el fondo blanco de nuestro logo a transparente usando la función Bitmap.MakeTransparent()

_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx")))

WITH _SCREEN.System.Drawing as xfcDrawing

  LOCAL lcMainPict, lcLogoPict
  LOCAL loMainBmp as xfcBitmap
  LOCAL loLogoBmp as xfcBitmap
  LOCAL loGfx as xfcGraphics

  lcMainPict = GETPICT()
  lcLogoPict = GETPICT()

  loMainBmp = .Bitmap.FromFile(lcMainPict)
  loLogoBmp = .Bitmap.FromFile(lcLogoPict)
  loGfx = .Graphics.FromImage(loMainBmp)
 
  *!* Ejemplo 2 
  *!* Convierto el color seleccionado del logo con ALPHA 255 (Opaco) a ALPHA 0 (Transparente) 
  *!* Posicion : Borde superior derecho 
  * Fuerzo al fondo blanco del logo a hacerce transparente
  loLogoBmp.MakeTransparent(.Color.White)

  * Dibujo el logo en el borde superior derecho de la imagen
  LOCAL x1, y1
  x1 = loMainBmp.Width - loLogoBmp.Width
  y1 = 0
  loGfx.DrawImage(loLogoBmp, x1, y1)
  loMainBmp.Save("c:\logo2.jpg", .Imaging.ImageFormat.Jpeg)

  RUN /N explorer.exe c:\logo2.jpg
ENDWITH

EJEMPLO 3: Dibujo el logo aplicando un 25% de transparencia a toda la imagen

La transparencia es aplicada a toda la imagen usando un ColorMatrix. La proporción de transparencia que es variedades de aplied de 0 (totalmente transparente) a 1 (totalmente opaca).

_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx")))

WITH _SCREEN.System.Drawing as xfcDrawing

  LOCAL lcMainPict, lcLogoPict
  LOCAL loMainBmp as xfcBitmap
  LOCAL loLogoBmp as xfcBitmap
  LOCAL loGfx as xfcGraphics

  lcMainPict = GETPICT()
  lcLogoPict = GETPICT()

  loMainBmp = .Bitmap.FromFile(lcMainPict)
  loLogoBmp = .Bitmap.FromFile(lcLogoPict)
  loGfx = .Graphics.FromImage(loMainBmp)

  *!* Ejemplo 3
  *!* Dibujo el logo aplicando 25% de transparencia a toda la imagen
  *!* Posicion: Borde inferior izquierdo
  * La transparencia se aplica a toda la imagen
  * Defino el porcentaje de transparencia que sera aplicado
  * Este parámetro va desde 0 (totalmente transparente) a 1 (totalmente opaco)
  LOCAL lnTranspRatio
  lnTranspRatio = 0.25 && 25%

  * Creo una matriz de color tendra la información de la transformación
  * La posición (4,4) de la matriz es la responsable de la opacidad 
  LOCAL loClrMatrix AS xfcColorMatrix
  loClrMatrix = .Imaging.ColorMatrix.New( ; 
     1, 0, 0, 0 , 0, ; 
     0, 1, 0, 0 , 0, ; 
     0, 0, 1, 0 , 0, ;
     0, 0, 0, lnTranspRatio, 0, ; 
     0, 0, 0, 0 , 0)

  * Creo un objeto de atributos de imagen para crear los efectos basados en nuestra martiz de color
  LOCAL loAttr AS xfcImageAttributes
  loAttr = .Imaging.ImageAttributes.New() 
  loAttr.SetColorMatrix(loClrMatrix)

  * Nececitamos crear un rectangulo que contendrá las coordenadas y el tamaño del logo transformado
  LOCAL loRect as xfcRectangle
  loRect = .Rectangle.New()
  loRect.X = 0 
  loRect.Y = loMainBmp.Height - loLogoBmp.Height
  loRect.Width = loLogoBmp.Width
  loRect.Height = loLogoBmp.Height 

  * Dibujo la imagen transformada usando el rectángulo y el objeto de atributos de la imagen
  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loMainBmp.Save("c:\logo3.jpg", .Imaging.ImageFormat.Jpeg)

  RUN /N explorer.exe c:\logo3.jpg
ENDWITH

EJEMPLO 4: Dibujo el logo con el fondo transparente, con una transparencia global del 50%.

Aplico 100% de transparencia al color blanco para eliminar el fondo y dibujo el logo aplicando 50% de transparencia a la imagen entera, igual que en el ejemplo anterior.

_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx")))

WITH _SCREEN.System.Drawing as xfcDrawing

  LOCAL lcMainPict, lcLogoPict
  LOCAL loMainBmp as xfcBitmap
  LOCAL loLogoBmp as xfcBitmap
  LOCAL loGfx as xfcGraphics

  lcMainPict = GETPICT()
  lcLogoPict = GETPICT()
  loMainBmp = .Bitmap.FromFile(lcMainPict)
  loLogoBmp = .Bitmap.FromFile(lcLogoPict)
  loGfx = .Graphics.FromImage(loMainBmp)
 
  *!* Ejemplo 4
  *!* Aplico 100% de transparencia a el color blanco para eliminar el fondo
  *!* Dibujo el logo aplicando 50% de transparencia a toda la imagen
  *!* Posicion: Borde superior izquierdo
  * Primer paso: Elimino el fondo blanco
  loLogoBmp.MakeTransparent(.Color.White)

  * Defino el porcentaje de transparencia que sera aplicado
  * Este parámetro va desde 0 (totalmente transparente) a 1 (totalmente opaco)
  LOCAL lnTranspRatio
  lnTranspRatio = 0.50 && 50%

  * Creo una matriz de color tendra la información de la transformación
  * La posición (4,4) de la matriz es la responsable de la opacidad 
  LOCAL loClrMatrix AS xfcColorMatrix
  loClrMatrix = .Imaging.ColorMatrix.New( ; 
     1, 0, 0, 0 , 0, ; 
     0, 1, 0, 0 , 0, ; 
     0, 0, 1, 0 , 0, ;
     0, 0, 0, lnTranspRatio, 0, ; 
     0, 0, 0, 0 , 0)

  * Creo un objeto de atributos de imagen para crear los efectos basados en nuestra martiz de color
  LOCAL loAttr AS xfcImageAttributes
  loAttr = .Imaging.ImageAttributes.New() 
  loAttr.SetColorMatrix(loClrMatrix)

  * Nececitamos crear un rectangulo que contendrá las coordenadas y el tamaño del logo transformado
  LOCAL loRect as xfcRectangle
  loRect = .Rectangle.New()
  loRect.X = 0 
  loRect.Y = 0
  loRect.Width = loLogoBmp.Width
  loRect.Height = loLogoBmp.Height 

  * Dibujo la imagen transformada usando el rectángulo y el objeto de atributos de la imagen
  loGfx.DrawImage(loLogoBmp, loRect, loLogoBmp.GetBounds(), .GraphicsUnit.Pixel, loAttr) 
  loMainBmp.Save("c:\logo4.jpg", .Imaging.ImageFormat.Jpeg)

  RUN /N explorer.exe c:\logo4.jpg
ENDWITH 

15 de junio de 2015

Funciones definidas por el usuario en las cadenas Transact-SQL

Autor: Igor Nikiforov (http://nikiforov.developpez.com)
Montréal, Québec


Señoras y Señores

Quisiera poner a su alcance, en forma gratuita, las siguientes funciones de Transact-SQL:

AT(): Devuelve la posición numérica inicial de la enésima aparición de una expresión de carácteres en otra expresión de carácteres; se cuenta desde el carácter situado más a la izquierda.

RAT(): Devuelve la posición numérica de la enésima aparición (más a la derecha) de una cadena de carácteres dentro de otra cadena de carácteres.

OCCURS(): Devuelve el número de veces que ocurre una expresión dentro de otra expresión de carácteres (incluye solapamientos).

OCCURS2():Devuelve el número de veces que ocurre una expresión dentro de otra expresión de carácteres (excluye solapamientos).

PADL(): Devuelve una cadena a partir de una expresión, rellenándola desde la izquierda hasta la longitud especificada.

PADR(): Devuelve una cadena a partir de una expresión, rellenándola desde la derecha hasta la longitud especificada.

PADC(): Devuelve una cadena a partir de una expresión, rellenándola por ambos lados hasta la longitud especificada.

CHRTRAN(): Cada carácter de una expresión de carácteres que coincida con un carácter de una segunda expresión de carácteres se reemplaza con el carácter correspondiente de una tercera expresión de carácteres.

STRTRAN(): Busca en una expresión de caracteres las apariciones de una segunda expresión de caracteres, y luego reemplaza cada aparición con una tercera expresión de caracteres (a distinción de la función incorporada replace, STRTRAN tiene tres parámetros adicionales).

STRFILTER(): Quita todos los carácteres de una cadena de carácteres excepto aquellos especificados.

GETWORDCOUNT(): Cuenta el número de palabras de una cadena.

GETWORDNUM(): Devuelve la palabra especificada de una cadena.

GETALLWORDS() : Inserta las palabras de una cadena en la tabla.

PROPER(): Devuelve, a partir de una expresión de tipo Carácter, una cadena con el modelo apropiado de mayúsculas/minúsculas para nombres propios.

RCHARINDEX(): Es similar a la función incorporada Transact-SQL charindex, pero la función comienza la búsqueda por la derecha.

ARABTOROMAN(): Devuelve el número romano equivalente de una expresión numérica especificada (de 1 a 3999).

ROMANTOARAB(): Devuelve la expresión numérica equivalente de un número romano especificado (de I a MMMCMXCIX).

AT, PADL, PADR, CHRTRAN, PROPER son semejantes a las funciones Oracle PL/SQL INSTR, LPAD, RPAD, TRANSLATE, INITCAP

Más de 4000 personas ya han descargado estas funciones. Ellas podrían ser útiles para usted.

Por favor, descargue el siguiente archivo:

http://www.universalthread.com/wconnect/wc.dll?LevelExtreme~2,2,27115

Quisiera agradecerles a Ustedes toda vuestra atención y enviarles mis mejores sentimientos.

AT()

Función definida por el Usuario. Devuelve la posición numérica inicial de la primera aparición de una expresión de caracteres en otra expresión de caracteres; se cuenta desde el carácter situado más a la izquierda.

AT( @cSearchExpression, @cExpressionSearched [, @nOccurrence])

Valores devueltos Smallint

Parámetros

;@cSearchExpression Especifica la expresión de caracteres que AT() busca en @cExpressionSearched.

;@cExpressionSearched Especifica la expresión de caracteres en que se busca la expresión indicada por @cSearchExpression.

;@nOccurrence Especifica qué aparición (primera, segunda, tercera, etc.) de @cSearchExpression se busca en @cExpressionSearched. De forma predeterminada, AT() busca la primera aparición de @cSearchExpression ( @nOccurrence = 1). Si incluye @nOccurrence, podrá buscar otras apariciones adicionales de @cSearchExpression en @cExpressionSearched. AT() devolverá 0 si @nOccurrence es mayor que el número de veces que @cSearchExpression aparece en @cExpressionSearched.

Observaciones

AT() busca en la segunda expresión de caracteres la primera aparición de la primera expresión de caracteres. Luego devuelve un valor entero que indica la posición del primer carácter de la expresión de caracteres encontrada. Si la expresión de caracteres no se encuentra,

AT() devolverá 0.

La búsqueda realizada por AT() distingue mayúsculas de minúsculas. Para realizar una búsqueda que no distinga entre ambas, utilice ATC().

Ejemplo

declare @gcString nvarchar(4000), @gcFindString nvarchar(4000)
select @gcString = N'Amor a la mexicana, de cumbia, huapango y son caballo, bota y sombrero, tequila, tabaco y ron',
@gcFindString = N'tequila'
select dbo.AT(@gcFindString, @gcString, default) -- Muestra 73
set @gcFindString = 'RON'
select dbo.AT(@gcFindString, @gcString, default) -- Muestra 0, case-sensitive

Vea también RAT()

RAT()

Devuelve la posición numérica de la última aparición (más a la derecha) de una cadena de caracteres dentro de otra cadena de caracteres.

RAT( @cSearchExpression, @cExpressionSearched [, @nOccurrence])

Valores devueltos Smallint

Parámetros

;@cSearchExpression Especifica la expresión de caracteres que RAT() busca en @cExpressionSearched.

;@cExpressionSearched Especifica la expresión de caracteres en la que busca RAT().

;@nOccurrence Especifica qué aparición, de derecha a izquierda, de @cSearchExpression busca RAT() en @cExpressionSearched. De forma predeterminada, RAT() busca la última vez que aparece @cSearchExpression ( @nOccurrence = 1). Si @nOccurrence es 2, RAT() buscará la penúltima aparición y así sucesivamente.

Observaciones

RAT(), que es la función inversa de AT(), busca en la expresión de caracteres @cExpressionSearched, de derecha a izquierda, la última aparición de la cadena especificada en @cSearchExpression.

RAT() devuelve un entero que indica la posición del primer carácter de @cSearchExpression en @cExpressionSearched. RAT() devuelve 0 si no se encuentra @cSearchExpression en @cExpressionSearched, o si @nOccurrence es mayor que el número de veces que @cSearchExpression aparece en @cExpressionSearched.

La búsqueda realizada por RAT() distingue entre mayúsculas y minúsculas.

Ejemplo

declare @gcString nvarchar(4000), @gcFindString nvarchar(4000)
select @gcString = N'Compasión no quiero lástima no quiero quiero un amor duro que me pueda hacer vibrar', 
@gcFindString = N'no' 
select dbo.RAT(@gcFindString , @gcString, default) -- Muestra 29
select dbo.RAT(@gcFindString , @gcString , 2) -- Muestra 11

Vea también AT()

ATC()

Devuelve la posición numérica inicial de la primera aparición de una expresión de caracteres en otra expresión de caracteres, sin distinguir entre mayúsculas y minúsculas en dichas dos expresiones.

ATC( @cSearchExpression, @cExpressionSearched [, @nOccurrence])

Valores devueltos Smallint

Parámetros

;@cSearchExpression Especifica la expresión de caracteres que ATC() busca en @cExpressionSearched.

;@cExpressionSearched Especifica la expresión de caracteres en que se busca la expresión indicada por @cSearchExpression.

;@nOccurrence Especifica qué aparición (primera, segunda, tercera, etc.) de @cSearchExpression se busca en @cExpressionSearched. De forma predeterminada, ATC() busca la primera aparición de @cSearchExpression ( @nOccurrence = 1). Si incluye @nOccurrence, podrá buscar otras apariciones adicionales de @cSearchExpression en @cExpressionSearched.

Observaciones

ATC() busca en la segunda expresión de caracteres la aparición de la primera expresión de caracteres, sin importar si las letras son mayúsculas o minúsculas en ninguna de las expresiones. Utilice AT() para realizar una búsqueda que sí distinga mayúsculas y minúsculas.

ATC() devuelve un valor entero correspondiente a la posición en que se encuentra el primer carácter de la expresión de caracteres. Si no se encuentra la expresión de caracteres, se devolverá 0.

Ejemplo

declare @gcString nvarchar(4000), @gcFindString nvarchar(4000)
select @gcString = N'Suavecito quiero bien rudo lo quiero quiero que me llegue hasta el fondo del corazón', 
@gcFindString = N'quiero'
select dbo.ATC(@gcFindString, @gcString, 3) -- Muestra 38
set @gcFindString = N'QUIERO'
select dbo.ATC(@gcFindString, @gcString, 2) -- Muestra 31, case-insensitive

Vea también AT(), RAT

OCCURS() , OCCURS2()

Devuelve el número de veces que ocurre una expresión dentro de otra expresión de caracteres.

OCCURS( @cSearchExpression, @cExpressionSearched)

Valores devueltos Smallint

Parámetros

;@cSearchExpression Especifica una expresión de caracteres que OCCURS() busca en @cExpressionSearched.

;@cExpressionSearched Especifica la expresión de caracteres donde OCCURS() busca @cSearchExpression.

Observaciones

OCCURS() devuelve 0 (cero) si @cSearchExpression no es encontrado en @cExpressionSearched.

Ejemplo

declare @gcString nvarchar(4000)
select @gcString = N'Amor a la mexicana... amor a la mexicana ay! quiero tu amor hasta el fondo 
del corazón amor a la mexicana y en tu locura quiero perder la razón amor a la mexicana'
select dbo.OCCURS('mexicana', @gcString ) -- Muestra 4

Cuenta las ocurrencias de los diferentes caracteres de una cadena @gcCaracters en la cadena @gcString

declare @gcString nvarchar(4000), @gcCaracters nvarchar(256), @i smallint, @counter smallint
select @i = 1, @counter = 0
select @gcString = N'El coronel no tiene quien lo escriba.', @gcCaracters = N'abcca'
while @i <= datalength(@gcCaracters)/2
  begin
    if charindex(substring(@gcCaracters,@i,1), left(@gcCaracters, @i - 1)) = 0
      select @counter = @counter + dbo.OCCURS2(substring(@gcCaracters,@i,1), @gcString) 
    select @i = @i + 1
  end
select @counter -- Muestra 4

¡Atención!, OCCURS incluye solapamientos

select dbo.OCCURS('ABCA', 'ABCABCABCA') -- Muestra 3

1 ocurrencia de la cadena 'ABCA .. BCABCA'

2 ocurrencia de la cadena 'ABC...ABCA...BCA'

3 ocurrencia de la cadena 'ABCABC...ABCA'

OCCURS2 excluye solapamientos

select dbo.OCCURS2('ABCA', 'ABCABCABCA') -- Muestra 2

1 ocurrencia de la cadena 'ABCA .. BCABCA'

2 ocurrencia de la cadena 'ABCABC... ABCA'

Vea también AT(), RAT()

PADL() | PADR() | PADC()

Devuelve una cadena a partir de una expresión, rellenándola por la izquierda, la derecha o por ambos lados hasta la longitud especificada.

PADL(@eExpression, @nResultSize [, @cPadCharacter]) 

O bien:

PADR(@eExpression, @nResultSize [, @cPadCharacter]) 

O bien:

PADC(@eExpression, @nResultSize [, @cPadCharacter])

Valores devueltos nvarchar(4000)

Parámetros

;@eExpression Especifica la expresión que se va a rellenar.

;@nResultSize Especifica el número total de caracteres que tendrá la expresión después de rellenarla.

;@cPadCharacter Especifica el valor que se va a utilizar para rellenar. Este valor se repite todas las veces necesarias para rellenar la expresión con el número especificado de caracteres.

Si se omite @cPadCharacter, se utilizan espacios (ASC(32)) para rellenar.

Observaciones

PADL() inserta los caracteres de relleno a la izquierda, PADR() los inserta a la derecha y PADC() los inserta a ambos lados.

Ejemplo

declare @gcString nvarchar(4000)
select @gcString = N'Amor a la Mexicana – Thalía' 
select dbo.PADL(@gcString, 40, default) -- Muestra ' Amor a la Mexicana – Thalía'
select dbo.PADL(@gcString, 40, '+=+') -- Muestra '+=++=++=++=++Amor a la Mexicana – Thalía'
select dbo.PADR(@gcString, 40, '=!!!=') -- Muestra 'Amor a la Mexicana – Thalía=!!!==!!!==!!'
select dbo.PADC(@gcString, 40, '=*=') -- Muestra '=*==*=Amor a la Mexicana – Thalía=*==*==' 

CHRTRAN()

Cada carácter de una expresión de carácteres que coincida con un carácter de una segunda expresión de carácteres se reemplaza con el carácter correspondiente de una tercera expresión de caracteres.

CHRTRAN( @cSearchedExpression, @cSearchExpression, @cReplacementExpression)

Valores devueltos nvarchar(4000)

Parámetros

;@cSearchedExpression Especifica la expresión donde CHRTRAN() reemplaza caráacteres.

;@cSearchExpression Especifica la expresión que contiene los carácteres buscados por CHRTRAN() en @cSearchedExpression.

;@cReplacementExpression Especifica la expresión que contiene los carácteres de reemplazo.

Si se encuentra en @cSearchedExpression un carácter de @cSearchExpression, el carácter de @cSearchedExpression se sustituirá por el carácter de @cReplacementExpression que esté en la misma posición en @cReplacementExpression que el carácter correspondiente en @cSearchExpression.

Si @cReplacementExpression tiene menos caráacteres que @cSearchExpression, los caracteres adicionales de @cSearchExpression se eliminan de @cSearchedExpression. Si @cReplacementExpression tiene más carácteres que @cSearchExpression, los carácteres adicionales de @cReplacementExpression se pasarán por alto.

Observaciones

CHRTRAN() convierte la expresión de carácteres @cSearchedExpression mediante las expresiones de conversión @cSearchExpression y @cReplacementExpression y devuelve la cadena de carácteres resultante.

Ejemplo

select dbo.CHRTRAN('ABCDEF', 'ACE', 'XYZ') -- Muestra 'XBYDZF'
select dbo.CHRTRAN('ABCDEF', 'ACE', 'XYZQRST') -- Muestra 'XBYDZF'

Vea también STRFILTER(), STRTRAN ()

STRTRAN ()

Busca en una expresión de caracteres las apariciones de una segunda expresión de caracteres , y luego reemplaza cada aparición con una tercera expresión de caracteres .

STRTRAN( @cSearched, @cExpressionSought [, @cReplacement] [, @nStartOccurrence] [, @nNumberOfOccurrences] [, @nFlags])

Valores devueltos nvarchar(4000)

Parámetros

;@cSearched Especifica la expresión de caracteres en la que hay que buscar.

;@cExpressionSought Especifica la expresión de caracteres que se busca en @cSearched. La búsqueda distingue entre mayúsculas y minúsculas.

;@cReplacement Especifica la expresión de caracteres que sustituye cada aparición de @cSearchFor en @cSearched. Si se omite @cReplacement, las instancias de @cExpressionSought se reemplazarán por una cadena vacía.

;@nStartOccurrence Especifica la instancia de @cExpressionSought que se reemplazará en primer lugar. Por ejemplo, si el valor de @nStartOccurrence es 4, se empezará a reemplazar a partir de la cuarta instancia de @cExpressionSought en @cSearched; las tres primeras instancias de @cExpressionSought permanecerán sin cambios. La instancia en la que se empieza a reemplazar será de manera predeterminada la primera instancia de @cExpressionSought (si se omite @nStartOccurrence).

;@nNumberOfOccurrences Especifica el número de instancias de @cExpressionSought que hay que reemplazar. Si omite @nNumberOfOccurrences, se reemplazarán todas las instancias @cExpressionSought (empezando por la especificada con @nStartOccurrence).

;@nFlags Especifica si en la búsqueda se distingue entre mayúsculas y minúsculas, de acuerdo con los siguientes valores:

Valor de @nFlag Descripción

0 (predeterminado) La búsqueda distingue entre mayúsculas y minúsculas, se reemplaza por la expresión exacta de @cReplacement.

1 La búsqueda no distingue entre mayúsculas y minúsculas, se reemplaza por la expresión exacta de @cReplacement .

2 La búsqueda distingue entre mayúsculas y minúsculas, se reemplaza por la expresión de @cReplacement en mayúsculas o minúsculas según el texto encontrado. En este caso @cReplacement, solo será reemplazado si la cadena encontrada está toda en mayúsculas, minúsculas o en el caso de ser un título (propiedad).

3 La búsqueda no distingue entre mayúsculas y minúsculas, se reemplaza por la expresión de @cReplacement en mayúsculas o minúsculas según el texto encontrado. En este caso @cReplacement, solo será reemplazado si la cadena encontrada esta toda en mayúsculas, minúsculas o en el caso de ser un título (propiedad).

Observaciones

También puede especificar dónde comienza la sustitución y cuántas sustituciones se harán. STRTRAN() devuelve la cadena de caracteres resultante. Especifique –1 en los parámetros opcionales que desee omitir si sólo tiene que especificar el valor de @nFlags.

Ejemplo

select dbo.STRTRAN('ABCDEF', 'ABC', 'XYZ',-1,-1,0) -- Muestra XYZDEF
select dbo.STRTRAN('ABCDEF', 'ABC', default,-1,-1,0) -- Muestra DEF
select dbo.STRTRAN('ABCDEFABCGHJabcQWE', 'ABC', default,2,-1,0) -- Muestra ABCDEFGHJabcQWE
select dbo.STRTRAN('ABCDEFABCGHJabcQWE', 'ABC', default,2,-1,1) -- Muestra ABCDEFGHJQWE
select dbo.STRTRAN('ABCDEFABCGHJabcQWE', 'ABC', 'XYZ', 2, 1, 1) -- Muestra ABCDEFXYZGHJabcQWE
select dbo.STRTRAN('ABCDEFABCGHJabcQWE', 'ABC', 'XYZ', 2, 3, 1) -- Muestra ABCDEFXYZGHJXYZQWE
select dbo.STRTRAN('ABCDEFABCGHJabcQWE', 'ABC', 'XYZ', 2, 1, 2) -- Muestra ABCDEFXYZGHJabcQWE
select dbo.STRTRAN('ABCDEFABCGHJabcQWE', 'ABC', 'XYZ', 2, 3, 2) -- Muestra ABCDEFXYZGHJabcQWE
select dbo.STRTRAN('ABCDEFABCGHJabcQWE', 'ABC', 'xyZ', 2, 1, 2) -- Muestra ABCDEFXYZGHJabcQWE
select dbo.STRTRAN('ABCDEFABCGHJabcQWE', 'ABC', 'xYz', 2, 3, 2) -- Muestra ABCDEFXYZGHJabcQWE
select dbo.STRTRAN('ABCDEFAbcCGHJAbcQWE', 'Aab', 'xyZ', 2, 1, 2) -- Muestra ABCDEFAbcCGHJAbcQWE
select dbo.STRTRAN('abcDEFabcGHJabcQWE', 'abc', 'xYz', 2, 3, 2) -- Muestra abcDEFxyzGHJxyzQWE
select dbo.STRTRAN('ABCDEFAbcCGHJAbcQWE', 'Aab', 'xyZ', 2, 1, 3) -- Muestra ABCDEFAbcCGHJAbcQWE
select dbo.STRTRAN('ABCDEFAbcGHJabcQWE', 'abc', 'xYz', 1, 3, 3) -- Muestra XYZDEFXyzGHJxyzQWE

Vea también replace(), CHRTRAN()

STRFILTER()

Quita todos los carácteres de una cadena de carácteres excepto aquellos especificados.

STRFILTER(@cExpressionSearched, @cSearchExpression)

Valor devuelto nvarchar(4000)

Parámetros

;@cExpressionSearched Especifica la cadena de caracteres para la búsqueda..

;@cSearchExpression Especifica los caracteres para buscar y para conservar dentro de @cExpressionSearched.

Observaciones

STRFILTER() quita todos los caracteres de @cExpressionSearched que no están en @cSearchExpression, después devuelve los caracteres que permanecen en la expresión

Ejemplo

select dbo.STRFILTER('asdfghh5hh1jk6f3b7mn8m3m0m6','0123456789') -- Muestra 516378306
select dbo.STRFILTER('ABCDABCDABCD', 'AB') -- Muestra ABABAB

Vea también CHRTRAN()

GETWORDCOUNT()

Cuenta el número de palabras de una cadena.

GetWordCount( @cString[, @cDelimiters])

Parámetros

;@cString Especifica la cadena de la que se va contar el número de palabras.

;@cDelimiters Opcional. Especifica el carácter que se utiliza para delimitar grupos de caracteres en @cString. Los delimitadores predeterminados son: espacio, tabulador, retorno de carro y avance de línea. Observe que GetWordCount( ) utiliza cada uno de los caracteres en @cDelimiters como delimitadores individuales, no para toda la cadena como un único delimitador.

Valor devuelto Smallint

Observaciones

GetWordCount() supone de manera predeterminada que las palabras están delimitadas por espacios o tabulaciones. Si especifica otro carácter como delimitador, esta función ignorará los espacios y las tabulaciones, y sólo utilizará el carácter especificado.

Ejemplo

declare @cString nvarchar(4000)
set @cString = N'Muchos años después, frente al pelotón de fusilamiento, el coronel 
Aureliano Buendía había de recordar aquella tarde remota en que su padre lo llevó a 
conocer el hielo. Macondo era entonces una aldea de 20 casas de barro y cañabrava 
construidas a la orilla de un río de aguas diáfanas que se precipitaban por un lecho de 
piedras pulidas, blancas y enormes como huevos prehistóricos. El mundo era tan reciente, 
que muchas cosas carecían de nombre, y para mencionarlas había que señalarlas con el dedo.'
-- Si utiliza @cString como cadena de destino para GetWordCount(), puede obtener todos los resultados siguientes.
select dbo.GETWORDCOUNT(@cString, default) -- Muestra 85 - grupos carácter, delimitados por ' '
select dbo.GETWORDCOUNT(@cString, ',') -- Muestra 6 - grupos carácter, delimitados por ','
select dbo.GETWORDCOUNT(@cString, '.') -- Muestra 3 - grupos carácter, delimitados por '.' 

Vea también

GETWORDNUM()

GETWORDNUM()

Devuelve la palabra especificada de una cadena.

GETWORDNUM( @cString, @nIndex[, @cDelimiters])

Parámetros

;@cString Especifica la cadena que hay que evaluar.

;@nIndex Especifica la posición del índice de la palabra que se va a devolver. Por ejemplo, si @nIndex es 3, GetWordNum() devuelve la tercera palabra (si @cString contiene tres o más palabras).

;@cDelimiters Opcional. Especifica uno o más caracteres especiales que se utilizan para separar las palabras de @cString. Los delimitadores predeterminados son espacio, tabulación, retorno de carro y avance de línea. Observe que GetWordNum() utiliza cada uno de los caracteres en @cDelimiters como delimitadores individuales, no como único delimitador de toda la cadena.

Valor devuelto nvarchar(4000)

Observaciones

Devuelve la palabra existente en la posición especificada por @nIndex en la cadena de destino, @cString. Si @cString contiene menos de @nIndex palabras, GetWordNum() devolverá una cadena vacía.

Ejemplo

declare @cString nvarchar(4000)
set @cString = N'"Cien años de soledad" Gabriel García Márquez'
select dbo.GETWORDNUM(@cString, 7, default) -- Display 'Márquez'

Vea también GETWORDCOUNT()

GETALLWORDS()

GETALLWORDS(@cString[, @cDelimiters])

Parámetros

;@cString Especifica la cadena cuyas palabras serán insertadas en la tabla.

;@cDelimiters Opcional. Especifica el carácter que se utiliza para delimitar grupos de caracteres en @cString. Los delimitadores predeterminados son: espacio, tabulador, retorno de carro y avance de línea. Observe que GetAllWord() utiliza cada uno de los caracteres en @cDelimiters como delimitadores individuales, no para toda la cadena como un único delimitador.

Valor devuelto una tabla @GETALLWORDS (WORDNUM smallint, WORD nvarchar(4000), STARTOFWORD smallint, LENGTHOFWORD smallint)

Observaciones

GetAllWord() supone de manera predeterminada que las palabras están delimitadas por espacios o tabulaciones. Si especifica otro carácter como delimitador, esta función ignorará los espacios y las tabulaciones, y sólo utilizará el carácter especificado.

Ejemplo

declare @cString nvarchar(4000)
set @cString = ' Los delimitadores predeterminados son espacio, tabulación, retorno de carro y avance de línea.'
select * from dbo.GETALLWORDS(@cString, default) 
select * from dbo.GETALLWORDS(@cString, ' ,.') 

Vea también GETWORDNUM() , GETWORDCOUNT()

PROPER()

p>Devuelve, a partir de una expresión de tipo Carácter, una cadena con el modelo apropiado de mayúsculas/minúsculas para nombres propios.

PROPER( @cExpression)

Valores devueltos nvarchar(4000)

Parámetros

;@cExpression Especifica la expresión de tipo carácter de la que PROPER() devuelve una cadena de caracteres con el modelo apropiado de mayúsculas / minúsculas.

Ejemplo

declare @gcExpr1 nvarchar(4000), @gcExpr2 nvarchar(4000)
select @gcExpr1 = 'Visual Basic.NET', @gcExpr2 = 'VISUAL BASIC.NET'
select dbo.PROPER(@gcExpr1) -- Muestra 'Visual Basic.net'
select dbo.PROPER(@gcExpr2) -- Muestra 'Visual Basic.net'

ARABTOROMAN()

Devuelve el número romano equivalente de una expresión numérica especificada

ARABTOROMAN(@tNum) Valores devueltos varchar(15) Parámetros @tNum una expresión numérica

Ejemplo

select dbo.ARABTOROMAN(3888) -- Muestra MMMDCCCLXXXVIII

ROMANTOARAB()

Devuelve la expresión numérica equivalente de un número romano especificado

ROMANTOARAB(@tcRomanNumber)

Valores devueltos smallint

Parámetros @tcRomanNumber varchar(15) un número romano

Ejemplo

select dbo.ROMANTOARAB('MDCCCLXXXVIII') -- Muestra 1888

Saludos,

Igor Nikiforov
Montréal, Québec
http://nikiforov.developpez.com 


12 de junio de 2015

Convertir BMP a ICONO - Parte 3

Artículo original: Convert BMP to ICO - Part 3
http://weblogs.foxite.com/vfpimaging/archive/2007/12/10/5448.aspx
Autor: Cesar Ch.
Traducido por: Luis María Guayán


A continuación tiene 4 sencillas maneras de convertir un BMP a ICONO, usando GdiPlusX.

Los 2 envios anteriores en mi blog, fueron antes de que actualicemos la biblioteca, agregandole el soporte de guardar Iconos con buena calidad.

Este ejemplo usa 4 técnicas, y crea 4 versiones de ICONOS desde el mismo archivo de imagen.

Antes de la conversión, se cambia el tamaño a la imagen original al tamaño de 16x16. Esto significa que con este ejemplo puede convertir cualquier archivo de imagen a ICONO.

En la próxima versión, también esperamos entregar una solución completa para archivos .ICO, con el código muy simplificado, ofreciendo un gran soporte para archivos ICO, que no está presente en la versión .NET, gracias a Carlos Alloatti.

IMPORTANTE

Requiere VFP9 y GdiPlusX para funcionar.

¡Por favor asegúrese que tiene la última versión!

http://www.codeplex.com/VFPX/Wiki/View.aspx?title=GDIPlusX&referringTitle=Home

Do Locfile("system.prg")

With _Screen.System.Drawing As xfcDrawing 
    * Convertir el bitmap original para garantizar una mejor calidad y compatibilidad
    loResized = .Bitmap.New(.Bitmap.FromFile(Getpict()), 16,16)

    * Crear el objeto Icon
    Local loIcon As xfcIcon
    loIcon = .Icon.FromHandle(loResized.GetHicon())

    *** ICONOS DE BAJA CALIDAD

    * Guardar el archivo
    loIcon.Save("c:\Icon_Save_FileName_LowQual.ico")

    * Guardar usando Stream
    Local loStream As xfcMemoryStream
    loStream = _Screen.System.IO.MemoryStream.New()

    loIcon.Save(loStream)
    Strtofile(loStream.GetBuffer(), "c:\Icon_Save_Stream_LowQual.Ico")


    *** ICONOS DE ALTA CALIDAD
    *** Configurar el parámetro tlQuality a .T.

    * Guardar el archivo
    loIcon.Save("c:\Icon_Save_FileName_HighQual.ico", .T.)

    * Guardar usando Stream
    Local loStream2 As xfcMemoryStream
    loStream2 = _Screen.System.IO.MemoryStream.New()

    loIcon.Save(loStream2, .T.)
    Strtofile(loStream2.GetBuffer(), "c:\Icon_Save_Stream_HighQual.Ico")

Endwith

9 de junio de 2015

Convertir BMP a ICONO - Parte 2

Artículo original: Convert BMP to ICON - Part 2
http://weblogs.foxite.com/vfpimaging/archive/2007/08/14/4528.aspx
Autor: Cesar Ch.
Traducido por: Luis María Guayán


Aquí está un código que convierte un Bitmap GDI u objeto imagen a un archivo de ícono .ICO, conservando la misma calidad que la imagen original.

En un envio anterior (Nota del traductor: Traducido en este Blog como Convertir BMP a ICONO - Parte 1), mostré el modo más fácil de convertir un Bitmap a ícono, usando la función API OleCreatePictureIndirect. Con muy poco código podríamos lograr archivos .ICO, pero lamentablemente, los resultados eran solo imágenes de 4bpp (bit por pixel), con 16 colores. Sospecho que Windows no proporciona apoyo a más de 16 colores. En una pequeña búsqueda en la web, encontré el siguiente tip de Cetin Basoz en FoxyClasses tip, que da una posible razón de los 16 colores de los iconos: "Aquí está el truco al hacer sus propios iconos: Las imágenes utilizadas deben ser solo de 16 colores. Si utiliza 256 colores, el ícono del logotipo de Fox será mostrado en lugar del suyo! También debe incluir el tamaño correcto de imágenes en el icono". Esto parece ser un antiguo consejo, ya que en mis pruebas en formularios de VFP trabajan muy bien con iconos de más de 16 colores.

Afortunadamente, VFP nos permite utilizar colores hasta 32bpp, de modo que podemos convertir cualquier imagen a un icono. La limitación es que VFP soporta sólo imágenes de iconos de 16x16 o 32x32 píxeles.

Agradecimiento especial a Sergey Karimov

Mi punto de partida fue un código de Sergey Karimov, que publicó en UT el año pasado. Su código original trata con BMPs físicos, convirtiéndolos a archivos .ICO. Pero mi verdadera necesidad era hacer éste sin acceso de disco adicional.

La fuente principal de la información sobre .ICO que encontré en la web fue un gran artículo de John Hornick, en MSDN, "Iconos en Win32". Para crear mis iconos, todo lo que tuve que debía hacer es seguir con cuidado todas las instrucciones proporcionadas allí, obviamente con una gran ayuda de Anatolyi Mogylevetz, en algunos de sus grandes artículos: "Retrieving information about the specified icon" y "Converting image file to .ICO file".

Abajo está mi función BMP2ICO, que crea archivos físicos .ICO de la alta calidad. En la primera parte del código de abajo encontrará el llamado al programa que cambia el tamaño a la imagen a 32x32 pixeles. El código llamado es muy fácil para entender, y puede adaptarlo según sus necesidades. Pero la parte principal es mucho más complicada, porque este tiene que crear muchas estructuras en C siguiendo las instrucciones de "Iconos en Win32".

IMPORTANTE

Requiere VFP9 y GdiPlusX para funcionar.

¡Por favor asegúrese que tiene la última versión!

http://www.codeplex.com/VFPX/Wiki/View.aspx?title=GDIPlusX&referringTitle=Home

LOCAL lcPict, lcIconFile
lcPict = GETPICT("bmp")
IF EMPTY(lcPict)
   RETURN
ENDIF
lcIconFile = "c:\_" + JUSTSTEM(JUSTFNAME(lcPict)) + ".ico"

* Make sure we have initialized the GDIPlusX library
* http://www.codeplex.com/VFPX/Wiki/View.aspx?title=GDIPlusX 
IF VARTYPE(_SCREEN.System) <> "O"
   ADDPROPERTY(_SCREEN,"System",NEWOBJECT("xfcSystem",LOCFILE("system.vcx")))
ENDIF

LOCAL loBmp as xfcBitmap
loBmp = _SCREEN.System.Drawing.Bitmap.FromFile(lcPict)

LOCAL loResized as xfcBitmap
loResized = loBmp.GetThumbnailImage(32,32)

=BMP2ICO(loResized, lcIconFile, .T.)
RETURN

 
* Function: BMP2ICO
* Parameters: toBmp (xfcImage), tcFileName
* Related Articles: 
* Icons in Win32 - by John Hornick http://msdn2.microsoft.com/en-us/library/ms997538.aspx 
* Retrieving information about the specified icon http://www.news2news.com/vfp/?example=206&function=331 
* Converting image file to .ICO file http://www.news2news.com/vfp/?example=503&function=331 
* Special Thanks:
* Sergey Karimov, Ontario, Canada
* Anatolyi Mogylevetz

FUNCTION BMP2ICO(toBmp AS xfcBitmap, tcFileName AS Character, tlChangePixFormat AS Boolean)

* Make sure we have initialized the GDIPlusX library
* http://www.codeplex.com/VFPX/Wiki/View.aspx?title=GDIPlusX 
IF VARTYPE(_SCREEN.System) <> "O"
   ADDPROPERTY(_SCREEN,"System",NEWOBJECT("xfcSystem",LOCFILE("system.vcx")))
ENDIF
 
LOCAL hIcon, lcBuffer, lnWidth, lnHeight, lnBitsPerPixel
LOCAL lhColorBitmap, lhMaskBitmap 
LOCAL loBmp as xfcBitmap
lnWidth = toBmp.Width
lnHeight = toBmp.Height

IF tlChangePixFormat
* Convert the original bitmap to ensure better quality and compatibility
   loBmp = _SCREEN.System.Drawing.Bitmap.New(toBmp, lnWidth, lnHeight) && This is to transform the Bitmap to 32bppARGB
   lnBitsPerPixel = 32 && 32bpp ARGB
ELSE
   loBmp = toBmp
   lnBitsPerPixel = loResized.GetPixelFormatSize(loResized.PixelFormat)
ENDIF
 
* Obtain hIcon from Bitmap
hIcon = loBmp.GetHicon()
 
* API Declarations needed
DECLARE SHORT DestroyIcon IN user32 INTEGER hIcon 
DECLARE INTEGER GetIconInfo IN user32 INTEGER hIcon, STRING @piconinfo 
DECLARE INTEGER GetDIBits IN gdi32; 
   INTEGER hdc, INTEGER hbmp, INTEGER uStartScan,; 
   INTEGER cScanLines, INTEGER lpvBits, STRING @lpbi, INTEGER uUsage 

DECLARE INTEGER CreateCompatibleDC IN gdi32 INTEGER hdc
DECLARE INTEGER DeleteDC IN gdi32 INTEGER hdc


DECLARE INTEGER ReleaseDC IN user32 INTEGER hwnd, INTEGER hdc
DECLARE INTEGER GetWindowDC IN user32 INTEGER hwnd
DECLARE RtlZeroMemory IN kernel32 As ZeroMemory INTEGER dest, INTEGER numBytes

DECLARE INTEGER SelectObject IN gdi32 INTEGER hdc, INTEGER hObject
DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject

DECLARE INTEGER GlobalFree IN kernel32 INTEGER hMem
DECLARE INTEGER GlobalAlloc IN kernel32 INTEGER wFlags, INTEGER dwBytes 



* ICONINFO structure
*| typedef struct _ICONINFO { 
*| BOOL fIcon; 0:4 
*| DWORD xHotspot; 4:4 
*| DWORD yHotspot; 8:4 
*| HBITMAP hbmMask; 12:4 
*| HBITMAP hbmColor; 16:4 
*| } ICONINFO; total bytes = 20

#DEFINE ICONINFO_SIZE 20 
lcBuffer = REPLICATE(CHR(0), ICONINFO_SIZE) 
= GetIconInfo(hIcon, @lcBuffer) 
lhColorBitmap = CTOBIN(SUBSTR(lcBuffer,17,4),"4rs")
lhMaskBitmap = CTOBIN(SUBSTR(lcBuffer,13,4),"4rs") 
= DestroyIcon(hIcon) 
 
 
* DIB BITMAPINFOHEADER. 
* Only the following members are used: biSize, biWidth, biHeight, biPlanes, biBitCount, biSizeImage
*!* typedef struct tagBITMAPINFOHEADER{
*!* DWORD biSize; 
*!* LONG biWidth; 
*!* LONG biHeight; 
*!* WORD biPlanes; 
*!* WORD biBitCount; 
*!* DWORD biCompression; 
*!* DWORD biSizeImage; 
*!* LONG biXPelsPerMeter; 
*!* LONG biYPelsPerMeter; 
*!* DWORD biClrUsed; 
*!* DWORD biClrImportant; 
*!* } BITMAPINFOHEADER, *PBITMAPINFOHEADER

#DEFINE DIB_RGB_COLORS 0 
#DEFINE RGBQUAD_SIZE 4
#DEFINE BHDR_SIZE 40
#DEFINE GMEM_FIXED 0
#DEFINE BI_RGB 0
LOCAL lcBIHdr, lcBInfo, lcRgbQuad, lnRgbQuadSize, lpBitsArray, lnBitsSize1, lnBitsSize2
LOCAL lnBytesPerScan
 
* Obtain the XOR Bitmap
m.lnBytesPerScan = INT((m.lnWidth * m.lnBitsPerPixel)/8)
IF MOD(m.lnBytesPerScan, 4) # 0
   m.lnBytesPerScan = m.lnBytesPerScan + 4 - MOD(m.lnBytesPerScan, 4)
ENDIF

m.lnBitsSize1 = m.lnHeight * m.lnBytesPerScan
m.lcBIHdr = BINTOC(BHDR_SIZE ,"4RS") + ; && biSize
   BINTOC(m.lnWidth,"4RS") + ; && biWidth
   BINTOC(m.lnHeight, "4RS") + ; && biHeight
   BINTOC(1, "2RS") + ; && biPlanes 
   BINTOC(lnBitsPerPixel, "2RS") + ; && biBitCount 
   BINTOC(BI_RGB, "4RS") + ; && biCompression
   BINTOC(lnBitsSize1, "4RS") + ; && biSizeImage
   REPLICATE(CHR(0), 16)

IF m.lnBitsPerPixel <= 8
   m.lnRgbQuadSize = (2^m.lnBitsPerPixel) * RGBQUAD_SIZE
   m.lcRgbQuad = REPLICATE(CHR(0), m.lnRgbQuadSize)
ELSE
   m.lcRgbQuad = ""
ENDIF

m.lcBInfo = m.lcBIHdr + m.lcRgbQuad
m.lpBitsArray = GlobalAlloc (GMEM_FIXED, m.lnBitsSize1)
= ZeroMemory (m.lpBitsArray, m.lnBitsSize1)
 
LOCAL lhdc, lhMemDC
m.lhDC = GetWindowDC(_screen.HWnd)
m.lhMemDC = CreateCompatibleDC(m.lhDC)
= ReleaseDC (_screen.HWnd, m.lhDC)
= SelectObject(lhMemDC, lhColorBitmap) 
= GetDIBits (m.lhMemDC, m.lhColorBitmap, 0, m.lnHeight, m.lpBitsArray , @lcBInfo, DIB_RGB_COLORS)
LOCAL lqColorBinary, lqMaskBinary
m.lqColorBinary = SYS(2600, m.lpBitsArray, m.lnBitsSize1)
= DeleteObject (m.lhColorBitmap)
= GlobalFree(m.lpBitsArray)
 
* Obtain the AND Mask
* The icAND member contains the bits for the monochrome AND mask. 
* The number of bytes in this array is determined by examining the icHeader member, and assuming 1bpp.
* The dimensions of this bitmap must be the same as the dimensions of the XOR mask.
* The AND mask is applied to the destination using the AND operation, to preserve or remove destination pixels before applying the XOR mask.

LOCAL lpBitsArray2, lcBInfo2
m.lnBitsSize2 = m.lnHeight * INT((m.lnWidth * 1)/8) && 1BPP
m.lpBitsArray2 = GlobalAlloc (GMEM_FIXED, m.lnBitsSize2)
= ZeroMemory (m.lpBitsArray2, m.lnBitsSize2)
= SelectObject(lhMemDC, lhMaskBitmap) 
m.lcBInfo2 = BINTOC(BHDR_SIZE ,"4RS") + ; && biSize
   BINTOC(m.lnWidth,"4RS") + ; && biWidth
   BINTOC(m.lnHeight, "4RS") + ; && biHeight
   BINTOC(1, "2RS") + ; && biPlanes 
   BINTOC(1, "2RS") + ; && CHR(INT(1/256))) + && biBitCount 
   BINTOC(BI_RGB, "4RS") + ; && biCompression
   BINTOC(lnBitsSize2, "4RS") + ; && biSizeImage
   REPLICATE(CHR(0), 16)

= GetDIBits (m.lhMemDC, m.lhMaskBitmap, 0, m.lnHeight, m.lpBitsArray2 , @lcBInfo2, DIB_RGB_COLORS)
m.lqMaskBinary = SYS(2600, m.lpBitsArray2, m.lnBitsSize2)
= DeleteObject (m.lhMaskBitmap)
= GlobalFree(m.lpBitsArray2)
= DeleteDC (m.lhMemDC)
 
LOCAL lcIconDir, lnOffset

*!* typedef struct
*!* {
*!* WORD idReserved; // Reserved (must be 0)
*!* WORD idType; // Resource Type (1 for icons)
*!* WORD idCount; // How many images?
*!* ICONDIRENTRY idEntries[1]; // An entry for each image (idCount of 'em)
*!* } ICONDIR, *LPICONDIR

lcIconDir = BINTOC(0, "2RS") + ; && 0 reserved
   BINTOC(1, "2RS") + ; && 2 type
   BINTOC(1, "2RS") && 4 Number of Icons in this file

lnOffset = LEN(lcIconDir)+16


*!* typedef struct
*!* {
*!* BYTE bWidth; // Width, in pixels, of the image
*!* BYTE bHeight; // Height, in pixels, of the image
*!* BYTE bColorCount; // Number of colors in image (0 if >=8bpp)
*!* BYTE bReserved; // Reserved ( must be 0)
*!* WORD wPlanes; // Color Planes
*!* WORD wBitCount; // Bits per pixel
*!* DWORD dwBytesInRes; // How many bytes in this resource?
*!* DWORD dwImageOffset; // Where in the file is this image?
*!* } ICONDIRENTRY, *LPICONDIRENTRY

LOCAL lnColors, lcIconDirEntry
lnColors = IIF(lnBitsPerPixel > 8, 0, 4*2^lnBitsPerPixel)
lcIconDirEntry = CHR(lnWidth) + ; && 0 width of the image, in pixels
   CHR(lnHeight) + ; && 1 height of image, in pixels (OR & AND bmps)
   CHR(lnColors) + ; && 2 Number of colors in image (0 if >=8bpp)
   CHR(0) + ; && 3 reserved
   BINTOC(1,"2RS") + ; && 4 Number of Planes
   BINTOC(lnBitsPerPixel,"2RS") && 6 Bits per pixel

lcBInfo = STUFF(lcBInfo,9,1,CHR(lnHeight*2)) && height of img, in pixels (OR & AND bmps)
&& The biHeight member of the icHeader structure represents the combined height of the XOR and AND masks
lcBInfo = STUFF(lcBInfo,21,4, BINTOC((lnBitsSize1 + lnBitsSize2), "4RS")) && Size of Image (OR & AND bitmaps)

*!* typdef struct
*!* {
*!* BITMAPINFOHEADER icHeader; // DIB header
*!* RGBQUAD icColors[1]; // Color table
*!* BYTE icXOR[1]; // DIB bits for XOR mask
*!* BYTE icAND[1]; // DIB bits for AND mask
*!* } ICONIMAGE, *LPICONIMAGE

lqBinary = lcBInfo + lqColorBinary + lqMaskBinary
lcIconDirEntry = lcIconDirEntry + BINTOC(LEN(lqBinary),"4RS") + ; && 8 Size of img area
   BINTOC(lnOffset,"4RS") && 12 offset to image area

* Finally, save the icon to the disk

* This still needs some error checking !
LOCAL lhFile
lhFile= FCREATE(tcFileName)
IF lhFile<1
   =MESSAGEBOX("Cannot create file " + tcFileName + " !")
   RETURN .F.
ENDIF

=FWRITE(lhFile, (lcIconDir + lcIconDirEntry))
=FWRITE(lhFile, lqBinary)
=FCLOSE(lhFile)
RETURN

6 de junio de 2015

Convertir BMP a ICONO - Parte 1

Artículo original: Convert BMP to ICON - Part 1
http://weblogs.foxite.com/vfpimaging/archive/2007/07/13/4346.aspx
Autor: Cesar Ch.
Traducido por: Luis María Guayán


Se sabe que GDI+ no trae soporte total para los archivos de iconos. Por lo tanto, no podemos hacer ninguna conversión sencilla para crear archivos .ICO directamente.

Pero hay algunos trucos fáciles que podemos utilizar para hacer esto. El primer paso es tomar el handle del icono de nuestro BITMAP, el "hIcon".

El planteamiento más sencillo es utilizar la API OleCreatePictureIndirect para obtener una referencia al objeto OLE de la imagen. El paso siguiente es enviar este objeto a la función SAVEPICTURE() para guardarla en el disco.

Pero el problema de esta técnica es que los iconos están generados en una mala calidad, 4bpp (4 bits por pixel). Esto significa que los iconos pueden tener como máximo 2^4 = 16 colores, esto trae resultados realmente feos y de mala calidad.

Abajo está el código:

IMPORTANTE

Requiere VFP9 y GdiPlusX para funcionar.

¡Por favor asegúrese que tiene la última versión!

http://www.codeplex.com/VFPX/Wiki/View.aspx?title=GDIPlusX&referringTitle=Home

* API Declarations
DECLARE SHORT DestroyIcon IN user32 INTEGER hIcon 
DECLARE LONG OleCreatePictureIndirect IN oleaut32 ;
   STRING @PictDesc , STRING @riid , LONG Own , OBJECT @Obj

* Initialize GdiPlusX
_SCREEN.AddProperty("System", NEWOBJECT("xfcSystem", LOCFILE("system.vcx")))

LOCAL lcPict, lcIconFile
lcPict = GETPICT("bmp")
lcIconFile = "c:\" + JUSTSTEM(lcPict) + ".ico"

WITH _SCREEN.System.Drawing
   LOCAL lhIcon
   LOCAL loBmp as xfcBitmap
   loBmp = .Bitmap.FromFile(lcPict)
   lhIcon = loBmp.GetHicon()
ENDWITH 
 
IF lhIcon # 0 
   *!* typedef struct tagPICTDESC 
   *!* { 
   *!* UINT cbSizeofstruct; 
   *!* UINT picType; 
   *!* HICON hicon; 
   *!* } icon; 
   *!* struct 
   *!* { 
   *!* HENHMETAFILE hemf; 
   *!* } emf; 
   *!* } ; 
   *!* } PICTDESC;

   #DEFINE PICTYPE_ICON 3
   #DEFINE GUID_Icon2 0h0004020000000000C000000000000046 && "{00020400-0000-0000-C000-000000000046}"
   #DEFINE GUID_Icon 0h8109F87B32BF1A108BBB00AA00300CAB && "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"

   LOCAL lcPictDesc, lqGuid, loIconObj
   lcPictDesc = BINTOC(16,"4RS") + ; && Size of Structure
      BINTOC(PICTYPE_ICON, "4RS") + ; && Type of Image
      BINTOC(lhIcon, "4RS") + ; && Image Handle
      BINTOC(0, "4RS")

   lqGuid = GUID_Icon
   loIconObj = 0 

   *!* http://msdn2.microsoft.com/en-us/library/ms694511.aspx
   *!* STDAPI OleCreatePictureIndirect( 
   *!* PICTDESC* pPictDesc, //Pointer to the structure of parameters for picture
   *!* REFIID riid, //Reference to the identifier of the interface
   *!* BOOL fOwn, //Whether the picture is to be destroyed
   *!* If TRUE, the picture object is to destroy its picture when the object is destroyed. 
   *!* If FALSE, the caller is responsible for destroying the picture.
   *!* VOID** ppvObj //Address of output variable that receives the 
   *!* // interface pointer requested in riid
   *!* );

   * Create the picture OLE object
   OleCreatePictureIndirect(@lcPictDesc, @lqGuid, 1, @loIconObj)

   IF VARTYPE(loIconObj) = 'O'
      * Save the picture using VFP native function 'savepicture()' 
      IF SAVEPICTURE(loIconObj, lcIconFile) 
         MESSAGEBOX('Icon created successfully !', 64) 
      ENDIF 
   ELSE 
   MESSAGEBOX('OleCreatePictureIndirect() Error', 16) 
ENDIF 

* Free the memory handle allocated for the hIcon
= DestroyIcon(lhIcon) 
ENDIF 
RETURN
Imagen original .BMPImagen .ICO (16 colores)

Puedes intentarlo sin ejecutar este código: Abrir MsPaint, y cargar una de las cuatro imágenes a la izquierda. Luego, seleccionar guardar la imagen como un bitmap de 16 colores, y obtendrás exactamente el mismo resultado que generó OLECreatePictureIndirect. Esta utilizará solamente la paleta de colores de abajo para convertir la imagen.

De manera, como el resultado no es tan bueno como deseamos, ¿por qué puse este códigos aquí?

Esto está porque la libreria original del .NET "System.Drawing" utiliza un planteamiento similar como el mostrado arriba, para crear iconos en el método Icon.Save().

En el siguiente artículo mostraré cómo podemos convertir nuestros BitMaps a iconos de alta calidad, pero utilizando algunas buenas y viejas técnicas de GDI (no Gdi+). ¡El código no será sencillo ni corto como el mostrado aquí, pero el funcionamiento será similar y la calidad será perfecta!


3 de junio de 2015

Carpetas Mis Documentos y Archivos de Programa

Como saber la ruta de las carpetas Mis Documentos y Archivos de Programa: Con la Foundation Class que trae VFP podemos saber la ruta de la carpetas Mis Documentos y Archivos de programa.

Ejemplo:
lo = NEWOBJECT("_CommonFolder",HOME(1)+"FFC\_System")
lcMD = lo.GetFolder(5)
lcAP = lo.GetFolder(38)
lo = .Null.
MESSAGEBOX(lcMD,64,"Mis Documentos")
MESSAGEBOX(lcAP,64,"Archivos de programa")
Luis María Guayán

1 de junio de 2015

Recorrer recursivamente un control TreeView

Amigos, humildemente, propongo una rutinita recursiva para recorrer un control TreeView, no es gran cosa, pero por ahí a alguien le puede venir bien.

Serán bienvenidas las mejoras del caso.
*-------------------------------------------------------*
*- CASO 1 - Le paso como NODO el primer Hijo del Nodo en el que estoy posicionado.
*- En este caso la rutina NO procesa el Nodo sobre el que estoy (LO EXCLUYE).
o=thisform.otree
o.selecteditem
primerhijo=o.selecteditem.child)
ver_rama(primerhijo)
*-------------------------------------------------------*
*- CASO 2 - Le paso como NODO áquel en el que estoy posicionado.
*- En este caso la rutina SI procesa el Nodo sobre el que estoy (LO
INCLUYE).
o=thisform.otree
o.selecteditem
ver_rama2(o.selecteditem)
*-------------------------------------------------------*
PROCEDURE ver_rama(onodo)
*--- Pasandole el Primer Hijo del Nodo que me Interesa
LOCAL hnodo,next_nodo,t,nhijos

IF ISNULL(onodo)
   RETURN
ENDIF
MESSAGEBOX(onodo.text)
nhijos=onodo.children
IF nhijos>0
 hnodo=onodo.child
 ver_rama(hnodo)
endif
next_nodo=onodo.next
IF ISNULL(next_nodo)
   RETURN
ELSE
   ver_rama(next_nodo)
ENDIF
RETURN
*-------------------------------------------------------*
PROCEDURE ver_rama2(onodo)
*--- Pasandole el NODO, lo muestra a él y todo lo que cuelga de él
LOCAL hnodo,next_nodo,t,nhijos

IF ISNULL(onodo)
   RETURN
ENDIF
MESSAGEBOX(onodo.text)
nhijos=onodo.children
IF nhijos>0
 hnodo=onodo.child
 ver_rama(hnodo)
endif
RETURN
*-------------------------------------------------------*
Nelson Rodriguez
Salto - Uruguay