LISTVIEW COM ICONES DOS PROGRAMAS

Citação:

Option Explicit
Dim FSO As New FileSystemObject

[ô]====================================================================
[ô]AUTO RESIZE COLUNAS DO LIST VIEW
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SETCOLUMNWIDTH As Long = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE As Long = -1
Private Const LVSCW_AUTOSIZE_USEHEADER As Long = -2

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 Declare Function GetShortPathName Lib [Ô]kernel32[Ô] Alias [Ô]GetShortPathNameA[Ô] (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long





Private Sub Form_Load()

[ô]CARREGAR GRADE
Call Carregar_Grade

End Sub



Private Sub Carregar_Grade()

With ListView1
.ListItems.Clear
.ColumnHeaders.Clear
.ColumnHeaders.Add(, , [Ô]Status [Ô], , lvwColumnLeft).Tag = [Ô]STRING[Ô]
.ColumnHeaders.Add(, , [Ô]Arquivo [Ô], , lvwColumnLeft).Tag = [Ô]STRING[Ô]
.ColumnHeaders.Add(, , [Ô]Aplicativo [Ô], , lvwColumnLeft).Tag = [Ô]STRING[Ô]
.ColumnHeaders.Add(, , [Ô]Caminho [Ô], , lvwColumnLeft).Tag = [Ô]STRING[Ô]
.View = lvwReport
.Sorted = False
End With


Dim itmX As ListItem
[ô]STATUS
Set itmX = ListView1.ListItems.Add(, , [Ô] [Ô])
[ô]NOME DO ARQUIVO
itmX.SubItems(1) = [Ô] [Ô]
[ô]SOFTWARE
itmX.SubItems(2) = [Ô] [Ô]
[ô]PATH
itmX.SubItems(3) = [Ô] [Ô]

Call Auto_Resize_ListView
ListView1.ListItems.Remove ListView1.ListItems(1).Index

End Sub



Private Sub Auto_Resize_ListView()

Dim col2adjust As Long

For col2adjust = 0 To ListView1.ColumnHeaders.Count - 1
[ô]Call SendMessage(ListView1.hwnd, LVM_SETCOLUMNWIDTH, col2adjust, ByVal LVSCW_AUTOSIZE_USEHEADER)
Call SendMessage(ListView1.hWnd, LVM_SETCOLUMNWIDTH, col2adjust, ByVal LVSCW_AUTOSIZE)
Next

End Sub




Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)

On Error Resume Next
Dim itmX As ListItem
Dim extensao As String
Dim i As Integer



For i = 1 To Data.Files.Count

If GetAttr(Data.Files(i)) And vbDirectory = vbDirectory Then

extensao = Mid(Data.Files(i), InStrRev(Data.Files(i), [Ô].[Ô]), Len(Data.Files(i)))

If extensao = [Ô].doc[Ô] Or extensao = [Ô].docx[Ô] Or extensao = [Ô].xls[Ô] Or extensao = [Ô].xlsx[Ô] Or extensao = [Ô].ppt[Ô] Or extensao = [Ô].pptx[Ô] Or extensao = [Ô].vsd[Ô] Or extensao = [Ô].vsdx[Ô] Then
[ô]STATUS
Set itmX = ListView1.ListItems.Add(, , [Ô]Aguardando...[Ô])
[ô]NOME DO ARQUIVO
itmX.SubItems(1) = Dir(Data.Files(i), vbNormal)
[ô]SOFTWARE
itmX.SubItems(2) = FU_Traduzir_Extensao_Arquivo(extensao)
[ô]PATH
itmX.SubItems(3) = Data.Files(i)
End If

End If

Next

If ListView1.ListItems.Count > 0 Then
CmdConverter.Enabled = True
Else
CmdConverter.Enabled = False
Call Carregar_Grade
End If

Call Auto_Resize_ListView

End Sub




Private Function FU_Traduzir_Extensao_Arquivo(extensao As String)

Select Case (LCase(extensao))

Case [Ô].doc[Ô]
FU_Traduzir_Extensao_Arquivo = [Ô]Microsoft Word 2003[Ô]
Case [Ô].docx[Ô]
FU_Traduzir_Extensao_Arquivo = [Ô]Microsoft Word 2007/2010[Ô]

Case [Ô].xls[Ô]
FU_Traduzir_Extensao_Arquivo = [Ô]Microsoft Excel 2003[Ô]
Case [Ô].xlsx[Ô]
FU_Traduzir_Extensao_Arquivo = [Ô]Microsoft Excel 2007/2010[Ô]

Case [Ô].ppt[Ô]
FU_Traduzir_Extensao_Arquivo = [Ô]Microsoft Powerpoint 2003[Ô]
Case [Ô].pptx[Ô]
FU_Traduzir_Extensao_Arquivo = [Ô]Microsoft Powerpoint 2007/2010[Ô]

Case [Ô].vsd[Ô]
FU_Traduzir_Extensao_Arquivo = [Ô]Microsoft Vísio 2003[Ô]
Case [Ô].vsdx[Ô]
FU_Traduzir_Extensao_Arquivo = [Ô]Microsoft Vísio 2007/2010[Ô]

End Select

End Function