vb6 像文件夹一样显示图片的图标
比如打开一个文件夹后,看到的图片是这样显示的如下图
我想在VB的窗体上也是这样显示,然后我把鼠标按住这个图标就可以拖放这种图片到其他地方。
或者用其他方法载入这张图片,然后可以在VB上想资源管理器一样拖放这种图片
我刚学VB不久,求教。
谢谢各位大侠不吝赐教。
[最优解释]
你现在要解决的,首先是如何得到某个文件类型的图标才对.不然后面的都没办法做了,嘿嘿.
给你个例子,显示指定文件的关联图标:
Option Explicit
'获取文件图标的例子
'窗体上添加一个按钮Command1
'
'By 嗷嗷叫的老马
'http://www.m5home.com
Private Const MAX_PATH As Long = 260
Private Const SHGFI_LARGEICON As Long = &H0
Private Const SHGFI_SMALLICON As Long = &H1
Private Const SHGFI_TYPENAME As Long = &H400
Private Const SHGFI_SHELLICONSIZE As Long = &H4
Private Const SHGFI_SYSICONINDEX As Long = &H4000
Private Const SHGFI_DISPLAYNAME As Long = &H200
Private Const SHGFI_EXETYPE As Long = &H2000
Private Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
Private Const ILD_TRANSPARENT As Long = &H1
Private Type SHFILEINFO
hIcon As Long ' : icon
iIcon As Long ' : icondex
dwAttributes As Long ' : SFGAO_ flags
szDisplayName As String * MAX_PATH ' : display name (or path)
szTypeName As String * 80 ' : type name
End Type
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" ( _
ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
ByRef psfi As SHFILEINFO, _
ByVal cbFileInfo As Long, _
ByVal uFlags As Long) As Long
Private Declare Function ImageList_Draw Lib "comctl32.dll" ( _
ByVal himl As Long, _
ByVal i As Long, _
ByVal hdcDst As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal fStyle As Long) As Long
Private Sub Command1_Click()
Dim hIcon As Long, shInfo As SHFILEINFO
hIcon = SHGetFileInfo("D:\Drawing1.stl", 0&, shInfo, Len(shInfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON) 'SHGFI_SMALLICON就是小图标
If hIcon <> 0 Then
Call ImageList_Draw(hIcon, shInfo.iIcon, Me.hdc, 0, 0, ILD_TRANSPARENT)
End If
End Sub
Private Sub ListBoxFileList_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListBoxFileList.MouseMove
'在ListBox中加入图片文件的路径。鼠标拖放里面的项,拖放到PhotoShop里面,可以打开那个图片文件。
'加入Txt文本文件,拖放到支持文本文件格式的另外一个程序,也可以打开。
If e.Button = Windows.Forms.MouseButtons.Left Then
If Me.ListBoxFileList.SelectedItem IsNot Nothing Then
Dim data As DataObject = New DataObject(DataFormats.FileDrop, Me.ListBoxFileList.SelectedItems(0).ToString)
'//data.SetData(DataFormats.StringFormat, files)
'//Do DragDrop
Dim sc As New System.Collections.Specialized.StringCollection
sc.Add(Me.ListBoxFileList.SelectedItems(0).ToString)
'MsgBox(sc.Item(0).ToString)
data.SetFileDropList(sc)
DoDragDrop(data, DragDropEffects.All)
End If
End If
End Sub
Option Explicit
'先添加一个ListView,命名为lv
'只要目标程序支持,拖到哪都行
Private Sub Form_Load()
'加载d盘下文件列表
Dim fn As String, path As String
path = "d:"
fn = Dir(path & "*.*")
While fn <> ""
lv.ListItems.Add , , path & fn
fn = Dir()
Wend
End Sub
Private Sub lv_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
lv.OLEDrag '开始拖动
End If
End Sub
Private Sub lv_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
Data.Files.Add lv.SelectedItem.Text '将选中的文件添加到拖动文件列表中
Data.SetData , vbCFFiles '发送数据,格式为文件列表
AllowedEffects = AllowedEffects Or vbDropEffectCopy '只复制,不删除
End Sub