Visual Basic Foro

Para un listview de postulantes tenia que mostrar datos de cada persona ademas de la fotografia
Aqui te dejo un ejemplo que pone la fotografia en la primera columna (izquierda) o en la ultima columna (derecha), hay que destacar que el listview reserva un espacio en blanco en la primera columna para poner las imagenes del imagelist igual al ancho de la imagen, por eso con la imagen a la derecha, en subitem(2), la primera columna se ve taaan ancha

http://www.4shared.com/file/24YW8JjZ/lvwpic.html


Fotografia Izquierda


Fotografia Derecha



Aqui hay mas ejemplos de listview con imagenes ademas de exportacion a HTML
http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/497-exportar-informacion-a-html-con-imagenes-.htm

Y si modificas un poco el sub UserControl_AsyncReadComplete, asi en el evento DownloadComplete del ucImage obtienes la url de la imagen, y eso guardarlo en alguna variable 
O en el mismo sub asignar a c_sFilename la url de la imagen asi con GetFileName tendrias la direccion de la imagen 

'Public Event DownloadComplete()
Public Event DownloadComplete(Url As String)

Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
    On Error GoTo PropErr
   
    c_sFilename = ""

    If LoadImageFromStream(AsyncProp.Value) Then
        'RaiseEvent DownloadComplete
        c_sFilename = AsyncProp.Target <--- Asi GetFileName devolveria la url de la imagen
        RaiseEvent DownloadComplete(AsyncProp.Target) <--- Asi en el evento estaria la url de la imagen
    Else
        RaiseEvent DownloadError
       
    End If
   
    Set c_AsyncProp = Nothing
   
    Exit Sub
PropErr:
    RaiseEvent DownloadError
End Sub


En este post resuelven un problema parecido al tuyo, en una celda hay texto en aleman y texto en ingles, la unica forma de diferenciar es que el texto en aleman esta bold

die Fuβgängerzone,-n –pedestrian zone
erleben-to experience
kräftig - strong

la solucion era hacer una funcion de usuario

Function BoldEnds(r As Range) As Long
    ' returns the character position of the first non-bold character
    ' in the first cell of r
 
    Dim iUB As Long
    Dim iLB As Long
    Dim iMid As Long
 
    With r(1)
        If .HasFormula Or VarType(.Value) <> vbString Then
            BoldEnds = -1
 
        ElseIf IsNull(.Font.Bold) Then  ' some bold, some not
            iUB = Len(.Value)
            iLB = 0
 
            Do While iUB - iLB > 1
                iMid = (iLB + iUB) \ 2
                If .Characters(iMid, 1).Font.Bold Then
                    iLB = iMid
                Else
                    iUB = iMid
                End If
            Loop
 
            BoldEnds = iUB
        ElseIf .Font.Bold Then
            BoldEnds = Len(.Value) + 1
        Else
            BoldEnds = 1
        End If
    End With
End Function
      ------------A------------     -------B--------       ----C-----
  1             Input                          Bold               Not Bold
  2   der Anwalt,-¨e –solicitor der Anwalt,-¨e       –solicitor
  3   der Fahrstuhl,-¨e –lift     der Fahrstuhl,-¨ e  –lift   
  4   fliehen-to escape            fliehen                  -to escape

La formula en B2 es
=LEFT(A2, BoldEnds(A2)-1)

y la formula en C2 es
=TRIM(MID(A2, BoldEnds(A2), LEN(A2)))

Ojala te sirva 

http://www.excelforum.com/excel-general/754022-split-cell-bold-text-and-non-bold-text.html

Al agregar un formulario nuevo al proyecto, lo primero que hago es cambiarle la fuente, asi cada control que agregue tendra la fuente del formulario

Y si usas listview 5, bueno, raul338 en su ucListView tiene una funcion ColumnFocused, pero esta pinta la columna con el color del tema de windows

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const LVM_FIRST                    As Long = &H1000
Private Const LVM_SETSELECTEDCOLUMN        As Long = (LVM_FIRST + 140)

m_hListView = ListView1.hWnd

Public Function ColumnFocused(ByVal Column As Integer)
    If m_hListView Then
        Call SendMessage(m_hListView, LVM_SETSELECTEDCOLUMN, Column, 0)
    End If
End Function


Aqui encontre una clase
http://www.recursosvisualbasic.com.ar/htm/listado-api/api-57-formulario-degradado.htm

En mis programas ocupo esto, debo haberlo sacado del apiviewer, ya no recuerdo

'////////////////////////////////////////////////////////////////////////////////////////
Private Type TRIVERTEX
    x As Long
    y As Long
    Red As Integer    'ushort value
    Green As Integer  'ushort value
    Blue As Integer   'ushort value
    Alpha As Integer  'ushort value
End Type

Private Type GRADIENT_RECT
    UpperLeft As Long
    LowerRight As Long
End Type

Private Declare Function GradientFillRect Lib "msimg32" Alias "GradientFill" (ByVal hdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function GradientFill Lib "msimg32" (ByVal hdc As Long, pVertex As Any, ByVal dwNumVertex As Long, pMesh As Any, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Const GRADIENT_FILL_RECT_H As Long = 0
Private Const GRADIENT_FILL_RECT_V As Long = 1
'////////////////////////////////////////////////////////////////////////////////////////

Private Sub DrawGradient( _
            ByVal hdc As Long, _
            ByVal LeftX As Long, _
            ByVal TopY As Long, _
            ByVal RightX As Long, _
            ByVal BottomY As Long, _
            ByVal StartColor As Long, _
            ByVal EndColor As Long, _
            Optional ByVal bVertical As Boolean)

Dim udtVert(1) As TRIVERTEX
Dim udtGRect   As GRADIENT_RECT

With udtVert(0)
     .x = LeftX
     .y = TopY
     .Red = pvLongToSignedShort(CLng((StartColor And &HFF&) * 256))
     .Green = pvLongToSignedShort(CLng(((StartColor And &HFF00&) \ &H100&) * 256))
     .Blue = pvLongToSignedShort(CLng(((StartColor And &HFF0000) \ &H10000) * 256))
     .Alpha = 0&
End With

With udtVert(1)
     .x = RightX
     .y = BottomY
     .Red = pvLongToSignedShort(CLng((EndColor And &HFF&) * 256))
     .Green = pvLongToSignedShort(CLng(((EndColor And &HFF00&) \ &H100&) * 256))
     .Blue = pvLongToSignedShort(CLng(((EndColor And &HFF0000) \ &H10000) * 256))
     .Alpha = 0&
End With

With udtGRect
     .UpperLeft = 0
     .LowerRight = 1
End With

Call GradientFill(hdc, udtVert(0), 2, udtGRect, 1, _
                  IIf(Not bVertical, GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V))

End Sub


Private Function pvLongToSignedShort(ByVal Unsigned As Long) As Integer

If (Unsigned < 32768) Then
   pvLongToSignedShort = CInt(Unsigned)
Else
   pvLongToSignedShort = CInt(Unsigned - &H10000)
End If

End Function


No olvidar antes de usar poner el Scalemode=vbPixels y AutoRedraw=True

Encontre esto para FireFox

http://webcache.googleusercontent.com/search?q=cache:GmV1aI73Jk0J:www.hackforums.net/archive/index.php/thread-712511.html+vb6+clear+mozilla+cookie&cd=10&hl=es&ct=clnk&gl=cl&source=www.google.cl

Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
 Private Declare Function FindFirstFileA Lib "kernel32.dll" (ByVal lpFileName As String, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
 Private Declare Function FindNextFileA Lib "kernel32.dll" (ByVal hFindFile As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
 
Private Type FILETIME
     dwLowDateTime As Long
     dwHighDateTime As Long
 End Type
 Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * 255
    cAlternate As String * 14
 End Type
 
Private Sub Form_Load()
 'Credits to marjinz
 'as well as this: http://social.msdn.microsoft.com/Forums/en-US/ieextensiondevelopment/thread/ce81943b-32b8-437b-b620-171c3d5893e7
 
Call ClearFireFoxData(Environ$("appdata") & "\Mozilla\FireFox\Profiles\")
 Call ClearIEData
 End Sub
 
Private Function ClearIEData()
 Call Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 1", vbHide) 'History
 Call Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 2", vbHide) 'Cookies
 Call Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 8", vbHide) 'Temporary Internet Files
 Call Shell("rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 16", vbHide) 'Form Data
 End Function
 
Public Function ClearFireFoxData(ByVal Path As String)
   On Error Resume Next
     Dim WFD As WIN32_FIND_DATA, hFile As Long, strPath As String, tmpString As String, Directory As String, File As String
     hFile = FindFirstFileA(Path & "*.*", WFD)
     If hFile <> -1 Then
   Do
     tmpString = StripNull(WFD.cFileName)
     If (WFD.dwFileAttributes And vbDirectory) Then
     If AscW(WFD.cFileName) <> 46 Then
     TerminateProcessName ("firefox.exe")
     strPath = Path & Directory & tmpString
     SecureDeleteFile strPath & "\" & "cookies.sqlite", 3
     SecureDeleteFile strPath & "\" & "places.sqlite", 3
     End If
     End If
     DoEvents
   Loop While FindNextFileA(hFile, WFD)
     End If
 End Function
 
Public Sub SecureDeleteFile(sFileName As String, times As Integer)
     On Error GoTo err
     Dim i, x As Long, BlockSize As Long
     Dim ff As Long
     Dim LastData As Boolean
     ff = FreeFile
     BlockSize = 4096
 
    Open sFileName For Binary As #ff
   For x = 1 To times 'loop until satisfied
     Do While Not EOF(ff) 'to length of file in characters
     If LOF(ff) - Loc(ff) <= BlockSize Then
     BlockSize = LOF(ff) - Loc(ff)
     LastData = True
     End If
 
    Put #ff, , RandomChar(BlockSize) 'overwrite file (length of random data = 1)
     DoEvents
     FlushFileBuffers (ff) 'clear buffers
     If LastData = True Then Exit Do
     Loop
   Next x
     Close #ff
     Kill sFileName
 Exit Sub
 err:
     Exit Sub
 End Sub
 
Public Function RandomChar(Length As Long) As String
     Randomize
     Dim i As Long
     For i = 1 To Length
   RandomChar = RandomChar & Int(5 * Rnd) + 1
     Next i
 End Function
 
Private Function TerminateProcessName(EXEname As String)
     Dim Process As Object
     For Each Process In GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process Where Name = '" & EXEname & "'")
   Process.Terminate
     Next
 End Function
 
Private Function StripNull(ByVal OriginalStr As String) As String
    On Error Resume Next
     StripNull = Left$(OriginalStr, InStr(OriginalStr, vbNullChar) - 1)
 End Function
 


Que bien funciona tu codigo, es como magia, frente a nuestros ojos la linda zebra, detras nuestro el feo mapache, por cierto la funcion Ordenar_Columna_Flexgrid no esta, pero esta aqui

http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/150-ordenar-columna-flexgrid.htm

' esto en las delaraciones del form
Public sCol As Integer, Orden As SortSettings

Function Ordenar_Columna_FlexGrid( _
                FlexGrid As Object, _
                ByVal columna As Integer) As SortSettings

    FlexGrid.Visible = False
    FlexGrid.Refresh
   
    If sCol <> columna Then
        Orden = 1
    ElseIf Orden = 1 Then
        Orden = 2
    Else
        Orden = 1
    End If
   
    'Ordena la columna del FlexGRid según _
     el valor de la variable Orden
    FlexGrid.Sort = Orden

    sCol = columna
   
    'Devuelve a la función el tipo de orden
    Ordenar_Columna_FlexGrid = Orden
   
    FlexGrid.Visible = True

End Function