form1.frm

不用API或外部控件

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "采用OLE实现文件拖放"
   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实现文件拖放的例子："
      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实现的文件的拖放
'------------------------------------------
'         洪恩在线 求知无限
'------------------------------------------
'程序说明：
'本例是实现文件从EXPLORE到VB应用程序拖放的又一种
'方法，与采用API函数实现的方法相比，这种方法更简
'单易懂。
'OLE拖放是可在 Visual Basic 应用程序中添加的最强
'大、最有用的功能之一就是在控件和控件之间、在控件
'和其它 Windows 应用程序之间拖动文本和图形。有了
'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

'--------------------------OLE拖放简介-------------------------------------------------
'可在 Visual Basic 应用程序中添加的最强大、最有用的功能之一就是在控件和控件之
'间、在控件和其它 Windows 应用程序之间拖动文本和图形。有了 OLE，就可将这种功能
'引入到应用程序中。
'使用 OLE 拖放时，并不是把一个控件拖动到另一个控件并调用代码（象本章前面讨论的
'拖放一样）；而是将数据从一个控件或应用程序移动到另一个控件或应用程序。例如，用
'户先选定并拖动 Excel 中的一列单元，然后将它们放到应用程序的 DBGrid 控件上。
'Visual Basic 的几乎所有控件都在某种程度上支持 OLE 拖放。（由 Visual Basic 专
'业版和企业版提供的）下述的标准控件和 ActiveX 控件自动支持 OLE 拖放，这意味着无
'论是从控件拖出还是在控件内放入都不需要编写代码:
'Apex       DBGrid      Picturebox     Richtextbox
'Image      Textbox     Maskededitbox
    
'为对这些控件启动自动 OLE 拖放，应将 OLEDragMode 和 OLEDropMode 设置为“自动话”。
'---------------------------------------------------------------------------------------
'可用下列 OLE 拖放属性、事件和方法指定已知控件响应拖放的方式。
'类别    项目           描述

'属性    OLEDragMode    启动控件的自动拖动或手工拖动（若控件支持手工拖动但不支持自动 OLE 拖动，则它不具有此属性，但支持 OLEDrag 方法和 OLE 拖放事件）。
'        OLEDropMode    指定控件如何响应放操作。
'事件    OLEDragDrop    识别源对象何时被放到控件上。
'        OLEDragOver    识别源对象何时被拖动经过控件。
'        OLEGiveFeedback 以源对象为基础向用户提供自定义拖动图标反馈。
'        OLEStartDrag    在启动拖动时，源支持哪种数据格式和放效果（复制、移动或拒绝数据）。
'        OLESetData     在放源对象时提供数据。
'        OLECompleteDrag 当把对象放到目标时通知被执行的操作的源。
'方法    OLEDrag        启动手工拖动。
'----------------------------------------------------------------------------------------
'本例中用到的属性和方法：
'OLEDragMode  -------返回或设置是由部件还是由程序员来处理 OLE 拖放操作。
'属性：              0 表示为手工拖放   1 表示为自动拖放
'我们设为 1 是自动拖放模式，这时我们要用OLEDragDrop，OLEDragOver事件来控制拖放操作
'
'OLEDragDrop  -------当源部件决定放操作能发生，且源部件被放到目标部件时，此事件发生。
'语法：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 对象，包含源提供的格式，另外也可能包含这些格式的数据。若 DataObject 不包含数据，则当控件调用 GetData 方法时提供数据。SetData 和 Clear 方法不能用在这里。
'effect  源对象设置的长整型数，用来识别执行的动作，这样当部件被移动后允许源采取适当的动作（例如，如果源被从一个部件移到另一个部件，则执行删除数据操作）。可能的取值列于“设置值”中。
'button  整数，当按下鼠标键时，与鼠标状态相对应。左键为位 0，右键为位 1，中键为位 2。这些位相应的值分别为 1，2 和 4，它代表了鼠标键的状态。可设置三个位中的部分、全部或根本不设置，相应地表明部分、全部按键被按下或没有按键按下。
'shift   整数，当按下 SHIFT、CTRL 和 ALT 键时，与这些键状态相对应。
'        SHIFT 键为位 0，CTRL 键为位 1，ALT 键为位 2。这些位相应的值分别为 1，2 和 4，shift 参数代表了这些键的状态。可设置三个位中的部分、全部或根本不设置，相应地表明部分、全部按键被按下或没有按键按下。例如，同时按下 CTRL 和 ALT 键，shift 值为 6。CTRL
'x,y     确定鼠标指针当前位置的数值。x 和 y 值由对象的 ScaleHeight、ScaleWidth、ScaleLeft 和 ScaleTop 属性设置的坐标系统的格式来表示。
'--------------------------------------------------------------------------------------
'其中 effect 参数的设置如下：
'常数                值  描述

'vbDropEffectNone    0   放目标不接受数据。
'VbDropEffectCopy    1   放结果保存于从源到目标的数据拷贝中。初始数据没有被拖放操作改变。
'VbDropEffectMove    2   放结果保存于要从拖放源移到放源的数据中。移动后，拖放源要删除数据。
'---------------------------------------------------------------------------------------
'OLEDragOver -----------当一个部件在另一个部件上拖动时发生。
'其参数与OLEDragDrop的参数类似。
'---------------------------------------------------------------------------------------