拖动文件到图标,使其被打开

Question

如何拖动文件到程序图标或程序快捷方式时,使程序能打开被拖动的文件?

Answer 1

参考这段话:
http://www.it8g.com/RuanJian/200811/3570p3.htm

Answer 2

工程里添加以下模块:http://www.m5home.com/bbs/dispbbs.asp?boardid=28&Id=301&page=3然后把某窗体的OLEDropMode设置为1,复制以下代码到那个窗体:Option ExplicitPrivate Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    
    Dim I As Long
    
    Debug.Print "DataOK"
    Effect = vbDropEffectCopy
    
    For I = 1 To Data.Files.Count
        OpenFile Data.Files(I)      '打开所有文件列表.
    Next
End Sub没有判断拖入的玩意是什么,所以如果你要是拖个奥特曼进去肯定...............

Answer 3

还有一种方法，要用＃commant，可以得到程序运行的参数，是一个字符串。具体我记不清了。
好像是在sub main()这里写代码。

Answer 4

老马,你说的怎么我运行没效果,我想应用到下面的代码上
Private Sub Pic1_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
    
        '将图片显示在图片框中
        Pic1.Picture = LoadPicture(sFileName)
        BackGround Me, Pic1
        Shape1.Width = Pic1.Width
        Shape1.Height = Pic1.Height
    End If
  
    Exit Sub
  
invalidPicture:    '显示错误信息
    DisplayPic1Message
  
End Sub
Private Sub DisplayPic1Message()    '清除图片框中的图片
    Pic1.Picture = LoadPicture()
  
    Const Msg As String = "无效图片！"
  
    ' 在图片框中显示错误信息，这个用法很少见
    Pic1.CurrentX = (Pic1.ScaleWidth \ 2) - (Pic1.TextWidth(Msg) \ 2)
    Pic1.CurrentY = (Pic1.ScaleHeight \ 2) - (Pic1.TextHeight(Msg) \ 2)
   Pic1.Print Msg
   
End Sub'当鼠标拖着东西移过图片框时
Private Sub Pic1_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 IfEnd SubPrivate Sub BackGround(f As Form, pic As PictureBox)
    For i = 0 To (f.ScaleWidth \ pic.Width)
        For j = 0 To (f.ScaleHeight \ pic.Height)
            PaintPicture pic.Picture, i * pic.Width, j * pic.Height
        Next
    Next
'将pic中的图片铺满整个窗口作为窗口背景花纹
End SubPrivate Sub Form_Load()
    
    '经过声明Pic1成为接受文件拖放的一个OLE容器
    Pic1.OLEDropMode = 1    Me.AutoRedraw = True
    Pic1.AutoSize = True
    BackGround Me, Pic1  '调用子过程BackGround将Pic1中的图片充满窗口
        
        Shape1.Width = Pic1.Width
        Shape1.Height = Pic1.HeightEnd Sub
Private Sub Form_Resize()
   BackGround Me, Pic1
End Sub

Answer 5

我汗!!!!!!原来是这样!!都没看清楚!!那就简单多了:sub Main()
    if command$<>"" then call OpenFile(Command$)
end sub

Answer 6

怎么我运行提示"Call OpenFile"子程序或函数未定义.