VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "采用OLE實現(xiàn)文件拖放"
   ClientHeight    =   6630
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4875
   LinkTopic       =   "Form1"
   ScaleHeight     =   6630
   ScaleWidth      =   4875
   StartUpPosition =   3  'Windows Default
   Begin VB.ListBox List1 
      Height          =   2010
      Left            =   0
      TabIndex        =   3
      Top             =   4560
      Width           =   4815
   End
   Begin VB.PictureBox Picture1 
      Height          =   3255
      Left            =   0
      ScaleHeight     =   3195
      ScaleWidth      =   4755
      TabIndex        =   0
      Top             =   840
      Width           =   4815
   End
   Begin VB.Label Label3 
      Caption         =   "列表框中列出了所有放進圖片框中的文件路徑："
      BeginProperty Font 
         Name            =   "宋體"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   4200
      Width           =   4815
   End
   Begin VB.Label Label2 
      Caption         =   "試著從EXPLORE中拖放一個圖片文件到下面圖片框："
      BeginProperty Font 
         Name            =   "宋體"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   480
      Width           =   4815
   End
   Begin VB.Label Label1 
      Caption         =   "采用OLE實現(xiàn)文件拖放的例子："
      BeginProperty Font 
         Name            =   "宋體"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   4215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'------------------------------------------
'        采用OLE實現(xiàn)的文件的拖放
'------------------------------------------
'         洪恩在線 求知無限
'------------------------------------------
'程序說明：
'本例是實現(xiàn)文件從EXPLORE到VB應用程序拖放的又一種
'方法，與采用API函數(shù)實現(xiàn)的方法相比，這種方法更簡
'單易懂。
'OLE拖放是可在 Visual Basic 應用程序中添加的最強
'大、最有用的功能之一就是在控件和控件之間、在控件
'和其它 Windows 應用程序之間拖動文本和圖形。有了
'OLE，就可將這種功能引入到應用程序中。
'------------------------------------------

Option Explicit

Private Sub Form_Load()

'經(jīng)過聲明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

'--------------------------OLE拖放簡介-------------------------------------------------
'可在 Visual Basic 應用程序中添加的最強大、最有用的功能之一就是在控件和控件之
'間、在控件和其它 Windows 應用程序之間拖動文本和圖形。有了 OLE，就可將這種功能
'引入到應用程序中。
'使用 OLE 拖放時，并不是把一個控件拖動到另一個控件并調用代碼（象本章前面討論的
'拖放一樣）；而是將數(shù)據(jù)從一個控件或應用程序移動到另一個控件或應用程序。例如，用
'戶先選定并拖動 Excel 中的一列單元，然后將它們放到應用程序的 DBGrid 控件上。
'Visual Basic 的幾乎所有控件都在某種程度上支持 OLE 拖放。（由 Visual Basic 專
'業(yè)版和企業(yè)版提供的）下述的標準控件和 ActiveX 控件自動支持 OLE 拖放，這意味著無
'論是從控件拖出還是在控件內(nèi)放入都不需要編寫代碼:
'Apex       DBGrid      Picturebox     Richtextbox
'Image      Textbox     Maskededitbox
    
'為對這些控件啟動自動 OLE 拖放，應將 OLEDragMode 和 OLEDropMode 設置為“自動話”。
'---------------------------------------------------------------------------------------
'可用下列 OLE 拖放屬性、事件和方法指定已知控件響應拖放的方式。
'類別    項目           描述

'屬性    OLEDragMode    啟動控件的自動拖動或手工拖動（若控件支持手工拖動但不支持自動 OLE 拖動，則它不具有此屬性，但支持 OLEDrag 方法和 OLE 拖放事件）。
'        OLEDropMode    指定控件如何響應放操作。
'事件    OLEDragDrop    識別源對象何時被放到控件上。
'        OLEDragOver    識別源對象何時被拖動經(jīng)過控件。
'        OLEGiveFeedback 以源對象為基礎向用戶提供自定義拖動圖標反饋。
'        OLEStartDrag    在啟動拖動時，源支持哪種數(shù)據(jù)格式和放效果（復制、移動或拒絕數(shù)據(jù)）。
'        OLESetData     在放源對象時提供數(shù)據(jù)。
'        OLECompleteDrag 當把對象放到目標時通知被執(zhí)行的操作的源。
'方法    OLEDrag        啟動手工拖動。
'----------------------------------------------------------------------------------------
'本例中用到的屬性和方法：
'OLEDragMode  -------返回或設置是由部件還是由程序員來處理 OLE 拖放操作。
'屬性：              0 表示為手工拖放   1 表示為自動拖放
'我們設為 1 是自動拖放模式，這時我們要用OLEDragDrop，OLEDragOver事件來控制拖放操作
'
'OLEDragDrop  -------當源部件決定放操作能發(fā)生，且源部件被放到目標部件時，此事件發(fā)生。
'語法：Private Sub object_OLEDragDrop(data As DataObject, effect As Long, button As Integer, shift As Integer, x As Single, y As Single)
'OLEDragDrop 事件語法包含下面部分:
'部分    描述
'object  對象表達式，其值是“應用于”列表中的一個對象。
'data    DataObject 對象，包含源提供的格式，另外也可能包含這些格式的數(shù)據(jù)。若 DataObject 不包含數(shù)據(jù)，則當控件調用 GetData 方法時提供數(shù)據(jù)。SetData 和 Clear 方法不能用在這里。
'effect  源對象設置的長整型數(shù)，用來識別執(zhí)行的動作，這樣當部件被移動后允許源采取適當?shù)膭幼鳎ɡ纾绻幢粡囊粋€部件移到另一個部件，則執(zhí)行刪除數(shù)據(jù)操作）。可能的取值列于“設置值”中。
'button  整數(shù)，當按下鼠標鍵時，與鼠標狀態(tài)相對應。左鍵為位 0，右鍵為位 1，中鍵為位 2。這些位相應的值分別為 1，2 和 4，它代表了鼠標鍵的狀態(tài)。可設置三個位中的部分、全部或根本不設置，相應地表明部分、全部按鍵被按下或沒有按鍵按下。
'shift   整數(shù)，當按下 SHIFT、CTRL 和 ALT 鍵時，與這些鍵狀態(tài)相對應。
'        SHIFT 鍵為位 0，CTRL 鍵為位 1，ALT 鍵為位 2。這些位相應的值分別為 1，2 和 4，shift 參數(shù)代表了這些鍵的狀態(tài)。可設置三個位中的部分、全部或根本不設置，相應地表明部分、全部按鍵被按下或沒有按鍵按下。例如，同時按下 CTRL 和 ALT 鍵，shift 值為 6。CTRL
'x,y     確定鼠標指針當前位置的數(shù)值。x 和 y 值由對象的 ScaleHeight、ScaleWidth、ScaleLeft 和 ScaleTop 屬性設置的坐標系統(tǒng)的格式來表示。
'--------------------------------------------------------------------------------------
'其中 effect 參數(shù)的設置如下：
'常數(shù)                值  描述

'vbDropEffectNone    0   放目標不接受數(shù)據(jù)。
'VbDropEffectCopy    1   放結果保存于從源到目標的數(shù)據(jù)拷貝中。初始數(shù)據(jù)沒有被拖放操作改變。
'VbDropEffectMove    2   放結果保存于要從拖放源移到放源的數(shù)據(jù)中。移動后，拖放源要刪除數(shù)據(jù)。
'---------------------------------------------------------------------------------------
'OLEDragOver -----------當一個部件在另一個部件上拖動時發(fā)生。
'其參數(shù)與OLEDragDrop的參數(shù)類似。
'---------------------------------------------------------------------------------------