OLE

Option Explicit

Private Sub Form_Load()

'经过声明Picture1成为接受文件拖放的一个OLE容器
Picture1.OLEDropMode = 1
End Sub

Private Sub Picture1_OLEDragDrop(data As DataObject, effect As Long, button As Integer, shift As Integer, x As Single, y As Single)
Dim i As Integer
'检查放下的东西是不是文件名
If data.GetFormat(vbCFFiles) = True Then

Dim sFileName$

'只读取第一条记录的信息
sFileName = data.Files(1)

'如果不是图片文件则转向错误处理
On Error GoTo invalidPicture

'依次读取各条记录，并把文件名添加在列表框中
For i = 1 To data.Files.Count
List1.AddItem data.Files(i)
Next i

'将图片显示在图片框中
Picture1.Picture = LoadPicture(sFileName)
End If

Exit Sub

invalidPicture:

'显示错误信息
DisplayPicture1Message

End Sub
Private Sub DisplayPicture1Message()

'清除图片框中的图片
Picture1.Picture = LoadPicture()

Const Msg As String = "Invalid Picture Format! "

' 在图片框中显示错误信息，这个用法很少见
Picture1.CurrentX = (Picture1.ScaleWidth \ 2) - (Picture1.TextWidth(Msg) \ 2)
Picture1.CurrentY = (Picture1.ScaleHeight \ 2) - (Picture1.TextHeight(Msg) \ 2)
Picture1.Print Msg
End Sub

'当鼠标拖着东西移过图片框时
Private Sub Picture1_OLEDragOver(data As DataObject, effect As Long, button As Integer, shift As Integer, x As Single, y As Single, State As Integer)

'检查移过图片框的是不是文件（象“回收站”就不是文件）
If data.GetFormat(vbCFFiles) Then

'显示可以放下的图标，是带小加号的那种
effect = vbDropEffectCopy And effect
Else

'否则显示不可放下的图标，是圆圈加斜线那种
effect = vbDropEffectNone
End If

End Sub