Dic 032009
 

Este es un Gadget para Taringa.net programado en Visual Basic 6 muestra todos los últimos post realizados. También ordena por categorías, si dan un clic en la lista mostrara una ventanita con la información del post, y con doble clic abre el navegador en dicho post.
También sirve para Poringa.net, tiene algunas opciones como elegir el tiempo de actualizado, poner un icono en la barra de tareas, controlar la opacidad de la ventana, contraerla a un mínimo o expandirla. Iniciar con Windows y otras más.

CapturaTaringa.png
CapturaPoringa.png
TaringaOpciones.png
MenuPoringa.png

Descargar .zip con el ejecutable.

Para programadores en Visual Basic 6 el código de fuente.

Nov 032009
 

Este es un pequeño módulo para convertir archivos de imágenes de un formato a otro. Es muy sencillo de usar, sólo basta con llamar a la función ConvertFileImage, donde pasamos como primer parámetro el Path de la imágen de origen y como segundo parámetro el Path de destino más el nombre y extensión. El tercer parámetro es opcional y es un valor de 0 a 100 en los caso que la extensión de destino sea .JPG, para elegir la calidad de conversión.
También cuenta con una función llamada IsGdiPlusInstaled que es para averiguar si el PC que ejecute el programa tiene instalado GDI Plus.
No tiene muchas opciones ya que el módulo intenta ser algo pequeño para pocas pretensiones.
Las extensiones de de lectura soportadas son: «BMP, DIB, JPG, JPEG, JPE, JFIF, GIF, PNG, TIF, TIFF, EMF, WMF, ICO, CUR».
y las extensiones de conversión soportadas son: «BMP, DIB, JPG, JPEG, JPE, JFIF, GIF, PNG, TIF, TIFF».

* Edit 06/02/2010, corrección en el código, me confundí en poner PGN, por PGN.

Option Explicit
'--------------------------------------------
'Autor: Leandro Ascierto
'Web: www.leandroascierto.com.ar
'Date: 01/11/2009
'--------------------------------------------
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipLoadImageFromFile Lib "GdiPlus.dll" (ByVal mFilename As Long, ByRef mImage As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal image As Long, ByVal FileName As Long, ByRef clsidEncoder As GUID, ByRef encoderParams As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
 
Private Type GUID
    Data1           As Long
    Data2           As Integer
    Data3           As Integer
    Data4(0 To 7)   As Byte
End Type
 
Private Type EncoderParameter
    GUID            As GUID
    NumberOfValues  As Long
    type            As Long
    Value           As Long
End Type
 
Private Type EncoderParameters
    Count           As Long
    Parameter(15)   As EncoderParameter
End Type
 
Private Type GdiplusStartupInput
    GdiplusVersion           As Long
    DebugEventCallback       As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs   As Long
End Type 
 
Const ImageCodecBMP = "{557CF400-1A04-11D3-9A73-0000F81EF32E}"
Const ImageCodecJPG = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
Const ImageCodecGIF = "{557CF402-1A04-11D3-9A73-0000F81EF32E}"
Const ImageCodecTIF = "{557CF405-1A04-11D3-9A73-0000F81EF32E}"
Const ImageCodecPNG = "{557CF406-1A04-11D3-9A73-0000F81EF32E}"
 
Const EncoderQuality = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
Const EncoderCompression = "{E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58}"
 
Const TiffCompressionNone = 6
Const EncoderParameterValueTypeLong = 4
 
Public Function ConvertFileImage(ByVal SrcPath As String, ByVal DestPath As String, Optional ByVal JPG_Quality As Long = 85) As Boolean
 
    On Error Resume Next
    Dim GDIsi As GdiplusStartupInput, gToken As Long, hBitmap As Long
    Dim tEncoder  As GUID
    Dim tParams     As EncoderParameters
    Dim sExt        As String
    Dim lPos        As Long
 
    DestPath = Trim(DestPath)
 
    lPos = InStrRev(DestPath, ".")
    If lPos Then
        sExt = UCase(Right(DestPath, Len(DestPath) - lPos))
    End If
 
    Select Case sExt
        Case "PNG"
            CLSIDFromString StrPtr(ImageCodecPNG), tEncoder 
        Case "TIF", "TIFF"
            CLSIDFromString StrPtr(ImageCodecTIF), tEncoder
 
            With tParams
                .Count = 1
                .Parameter(0).NumberOfValues = 1
                .Parameter(0).type = EncoderParameterValueTypeLong
                .Parameter(0).Value = VarPtr(TiffCompressionNone)
                CLSIDFromString StrPtr(EncoderCompression), .Parameter(0).GUID
            End With
 
        Case "BMP", "DIB"
            CLSIDFromString StrPtr(ImageCodecBMP), tEncoder
 
        Case "GIF"
            CLSIDFromString StrPtr(ImageCodecGIF), tEncoder
 
        Case "JPG", "JPEG", "JPE", "JFIF" 
            If JPG_Quality > 100 Then JPG_Quality = 100
            If JPG_Quality < 0 Then JPG_Quality = 0
 
            CLSIDFromString StrPtr(ImageCodecJPG), tEncoder
 
            With tParams
                .Count = 1
                .Parameter(0).NumberOfValues = 1
                .Parameter(0).type = EncoderParameterValueTypeLong
                .Parameter(0).Value = VarPtr(JPG_Quality)
                CLSIDFromString StrPtr(EncoderQuality), .Parameter(0).GUID
            End With
 
        Case Else
            Exit Function
 
    End Select
 
    GDIsi.GdiplusVersion = 1& 
    GdiplusStartup gToken, GDIsi
 
    If gToken Then
        If GdipLoadImageFromFile(StrPtr(SrcPath), hBitmap) = 0 Then 
            If GdipSaveImageToFile(hBitmap, StrPtr(DestPath), tEncoder,ByVal  tParams) = 0 Then
                ConvertFileImage = True
            End If 
            GdipDisposeImage hBitmap 
        End If 
        GdiplusShutdown gToken
    End If
 
End Function 
 
Public Function IsGdiPlusInstaled() As Boolean
    Dim hLib As Long
 
    hLib = LoadLibrary("gdiplus.dll")
    If hLib Then
        If GetProcAddress(hLib, "GdiplusStartup") Then
            IsGdiPlusInstaled = True
        End If
        FreeLibrary hLib
    End If
 
End Function

Oct 292009
 

Este es un módulo con una función para poder insertar imágenes de todo tipo en un ImageList de los Microsoft Common Controls, tanto para la versión 5.0 o 6.0.
El módulo sólo tiene la función para leer desde archivos, faltaría agregarle la opción para leer desde recursos, si a alguien le interesa pueden comunicarlo.
Para la versión 6.0, a quienes no le funcione, les recomiendo descargarse la última actualización aquí.

Insertar imágenes png en un ImageList

Oct 262009
 

Se trata de dos controles de usuario realizados por Cobein los cuales me han gustado mucho y con su permiso los publico aquí, como sus nombres bien lo dicen uno es para mostrar imágenes de todo tipo PNG, ICO, GIF, JPG, Etc. inclusive darle efectos de brillo, rotación en todos los sentidos, transparencia, escala de grises, contraste. Y el otro es un ImageList (para los que no saben de que se tratan los ImageList, son controles donde se almacenan una lista de imágenes para luego poder aplicarlas en otro control), este también tiene soporte para todos los tipos de imágenes antes mencionadas.
Para los que ya conocían este control se ha solucionado el problema que tenía en el incremento progresivo del uso de la memoria. También le he agregado una propiedad para reconocer las regiones de la imágen (Créditos a LaVolpe) y una función para poder mostrar imágenes desde la web (incluye progreso de carga).

ucImage y ucImageList

Oct 212009
 

Este es un Control de Usuario que permite listar todas las imágenes dentro de una carpeta o subcarpetas con un parecido al que utiliza Windows pero con algunas opciones extras para poder personalizarlo a gusto.
Las imágenes no las carga en la memoria sino que las va leyendo cada vez que se desliza hacia otra imágen, esto tiene como ventaja ahorrar el uso de la memoria y como desventaja más consumo del procesador (sólo en el momento en que carga las imágenes).
Algunas propiedades de este control nos permite elegir una selección personalizada, un marco personalizado, color de borde, texto con sombra, entre otras.
También cuenta con un ToolTip con la información de la imágen (este requiere que estén habilitados los temas de Windows en el proyecto).

ImageSlide

Ago 012009
 

Igual que la función superior esta sirve para pintar una imágen de forma ampliada pero manteniendo su contorno original utilizando GDI PLUS, esto nos da como ventaja poder utilizar gráficos .PNG entre otros. Nótese que si ponemos el form con AutoRedraw = True la función trabaja más rápido.

RenderStrechtPlus

Option Explicit

' ----------------------------------------
' Autor Leandro Ascierto
' Web   www.leandroascierto.com.ar
' ----------------------------------------
Private Declare Function GdipDrawImageRectRectI Lib "gdiplus" (ByVal hGraphics As Long, ByVal hImage As Long, ByVal dstX As Long, ByVal dstY As Long, ByVal dstWidth As Long, ByVal dstHeight As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal SrcWidth As Long, ByVal SrcHeight As Long, ByVal srcUnit As Long, Optional ByVal imageAttributes As Long = 0, Optional ByVal Callback As Long = 0, Optional ByVal CallbackData As Long = 0) As Long
Private Declare Function GdipSetInterpolationMode Lib "gdiplus" (ByVal graphics As Long, ByVal InterpolationMode As Long) As Long
Private Declare Function GdipSetPixelOffsetMode Lib "gdiplus" (ByVal graphics As Long, ByVal PixelOffsetMode As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, ByRef graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal FileName As Long, ByRef image As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, Optional ByRef lpOutput As Any) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
 
Private Type GDIPlusStartupInput
    GdiPlusVersion                      As Long
    DebugEventCallback                  As Long
    SuppressBackgroundThread            As Long
    SuppressExternalCodecs              As Long
End Type
 
Private Const GdiPlusVersion                        As Long = 1&
Private Const QualityModeHigh                       As Long = 2&
Private Const InterpolationModeNearestNeighbor      As Long = QualityModeHigh + 3
Private Const PixelOffsetModeHalf                   As Long = QualityModeHigh + 2
 
Dim GdipToken As Long
Dim m_hImage As Long
  
Private Sub RenderStretchPlus(ByVal DestHdc As Long, _
                    ByVal DestX As Long, _
                    ByVal DestY As Long, _
                    ByVal DestW As Long, _
                    ByVal DestH As Long, _
                    ByVal hImage As Long, _
                    ByVal x As Long, _
                    ByVal y As Long, _
                    ByVal Width As Long, _
                    ByVal Height As Long, _
                    ByVal Size As Long)
 
 
    Dim hGraphics As Long
    Dim Sx2 As Long
 
    Sx2 = Size * 2
 
    If GdipCreateFromHDC(DestHdc, hGraphics) = 0 Then
        Call GdipSetInterpolationMode(hGraphics, InterpolationModeNearestNeighbor)
        Call GdipSetPixelOffsetMode(hGraphics, PixelOffsetModeHalf)
 
        GdipDrawImageRectRectI hGraphics, hImage, DestX, DestY, Size, Size, x, y, Size, Size, &H2, 0&, 0&, 0& 'TOP_LEFT
        GdipDrawImageRectRectI hGraphics, hImage, DestX + Size, DestY, DestW - Sx2, Size, x + Size, y, Width - Sx2, Size, &H2, 0&, 0&, 0& 'TOP_CENTER
        GdipDrawImageRectRectI hGraphics, hImage, DestX + DestW - Size, DestY, Size, Size, x + Width - Size, y, Size, Size, &H2, 0&, 0&, 0& 'TOP_RIGHT
        GdipDrawImageRectRectI hGraphics, hImage, DestX, DestY + Size, Size, DestH - Sx2, x, y + Size, Size, Height - Sx2, &H2, 0&, 0&, 0& 'MID_LEFT
        GdipDrawImageRectRectI hGraphics, hImage, DestX + Size, DestY + Size, DestW - Sx2, DestH - Sx2, x + Size, y + Size, Width - Sx2, Height - Sx2, &H2, 0&, 0&, 0& 'MID_CENTER
        GdipDrawImageRectRectI hGraphics, hImage, DestX + DestW - Size, DestY + Size, Size, DestH - Sx2, x + Width - Size, y + Size, Size, Height - Sx2, &H2, 0&, 0&, 0& 'MID_RIGHT
        GdipDrawImageRectRectI hGraphics, hImage, DestX, DestY + DestH - Size, Size, Size, x, y + Height - Size, Size, Size, &H2, 0&, 0&, 0& 'BOTTOM_LEFT
        GdipDrawImageRectRectI hGraphics, hImage, DestX + Size, DestY + DestH - Size, DestW - Sx2, Size, x + Size, y + Height - Size, Width - Sx2, Size, &H2, 0&, 0&, 0& 'BOTTOM_CENTER
        GdipDrawImageRectRectI hGraphics, hImage, DestX + DestW - Size, DestY + DestH - Size, Size, Size, x + Width - Size, y + Height - Size, Size, Size, &H2, 0&, 0&, 0& 'BOTTOM_RIGHT

        Call GdipDeleteGraphics(hGraphics)
    End If
 
End Sub
 
Private Sub RenderPlusFromFile(ByVal DestHdc As Long, _
                    ByVal DestX As Long, _
                    ByVal DestY As Long, _
                    ByVal DestW As Long, _
                    ByVal DestH As Long, _
                    ByVal FileName As String, _
                    ByVal x As Long, _
                    ByVal y As Long, _
                    ByVal Width As Long, _
                    ByVal Height As Long, _
                    ByVal Size As Long)
Dim hImg As Long
 
Call GdipLoadImageFromFile(StrPtr(FileName), hImg)
Call RenderStretchPlus(DestHdc, DestX, DestY, DestW, DestH, hImg, x, y, Width, Height, Size)
Call GdipDisposeImage(hImg)
End Sub
  
Private Sub InitGDI()
    Dim GdipStartupInput As GDIPlusStartupInput
    GdipStartupInput.GdiPlusVersion = GdiPlusVersion
    Call GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)
End Sub
 
Private Sub TerminateGDI()
    Call GdiplusShutdown(GdipToken)
End Sub
 
Private Sub Command1_Click()
    Cls
    RenderPlusFromFile Me.hdc, 5, 5, 230, 230, App.Path & "\Image2.png", 0, 0, 158, 93, 26
End Sub
 
Private Sub Form_Load()
    Call InitGDI
    Call GdipLoadImageFromFile(StrPtr(App.Path & "\BotonesVista.png"), m_hImage)
    Me.AutoRedraw = True 'Utilizando GDIPlus + AutoRedraw = True, es mas rapido
End Sub
 
Private Sub Form_Terminate()
    Call GdipDisposeImage(m_hImage)
    Call TerminateGDI
End Sub
 
Private Sub Option1_Click(Index As Integer)
    Cls
    RenderStretchPlus Me.hdc, 10, 10, 120, 80, m_hImage, 0, 21 * Index, 11, 21, 3
End Sub