« 返回列表上一主题下一主题

3612阅读
3回复

又有点小收获了..VB拖放操作

级别: 经院高中

发帖: 369

铜板: 3800

人品值: 215

贡献值: 0

交易币: 0

好评度: 305

信誉值: 0

金币: 0

所在楼道

只看楼主更多操作楼层直达

楼层直达

0 发表于: 2006-06-12

还是很简单的.为了我的软件写的更完美先

抄别人的..嘎嘎~~~~
抓图如下拉:

FORM代码如下:

Option Explicit
' A demo project of DragDrop file routines. This demo shows the difference
' between using a subclassed dragdrop routine and an OLE dragdrop routine.
' written by Bryan Stafford of New Vision Software?
' this demo is released into the public domain "as is" without
' warranty or guaranty of any kind. In other words, use at
' your own risk.
Private Const GWL_WNDPROC As Long = (-4&)
' API call to alter the class data for this window
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hWnd&, _
ByVal nIndex&, ByVal dwNewLong&)
Private Sub Form_Load()
' register picture1 as a window that accepts dragdrop files
DragAcceptFiles qqq.hWnd, 1&
' take control of message processing by installing our message handling
' routine into the chain of message routines for picture1
procOld = SetWindowLong(qqq.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
' give message processing control back to VB
' if you don't do this you WILL crash!!!
Call SetWindowLong(qqq.hWnd, GWL_WNDPROC, procOld)
End Sub
Public Sub DropFiles(ByVal hDrop&)
Dim sFileName$, nCharsCopied&
' make some space for the file name
sFileName = String$(MAX_PATH, vbNullChar)
' pass the file handle (hDrop), the index of the file if more than 1 was passed (we
' still use index zero since we only care about the first file in the list), the variable
' that will accept the file name and the amount of space that that variable is dimentioned for.
nCharsCopied = DragQueryFile(hDrop, 0&, sFileName, MAX_PATH)
' clean up after ourselves bu closing the file handle
DragFinish hDrop
' if there were chars copied, get the file name and try to load it into the picturbox
If nCharsCopied Then
sFileName = Left$(sFileName, nCharsCopied)
' incase it's not a valid picture display the error message
qqq.Text = sFileName
End If
Exit Sub
End Sub

Option Explicit
' A demo project of DragDrop file routines. This demo shows the difference
' between using a subclassed dragdrop routine and an OLE dragdrop routine.
' written by Bryan Stafford of New Vision Software?
' this demo is released into the public domain "as is" without
' warranty or guaranty of any kind. In other words, use at
' your own risk.
' See the comments at the end of this module for a brief explaination of
' what subclassing is.
' max length of a path string on the system
Public Const MAX_PATH As Long = 260&
' the messages that we want to catch
Public Const WM_DROPFILES As Long = &H233&
' this var will hold a pointer to the original message handler so we MUST
' save it so that it can be restored before we exit the app. if we don't
' restore it.... CRASH!!!!
Public procOld As Long
'
Public Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, _
ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
' drag and drop files APIs
Public Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hWnd&, ByVal fAccept&)
Public Declare Function DragQueryFile& Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop&, ByVal iFile&, _
ByVal lpszFile$, ByVal cch&)
Public Declare Sub DragFinish Lib "shell32.dll" (ByVal hDrop&)
'WARNING!!!! WARNING!!!! WARNING!!!! WARNING!!!! WARNING!!!! WARNING!!!!
'
' Do NOT try to step through this function in debug mode!!!!
' You WILL crash!!! Also, do NOT set any break points in this function!!!
' You WILL crash!!! Subclassing is non-trivial and should be handled with
' EXTREAME care!!!
'
' There are ways to use a "Debug" dll to allow you to set breakpoints in
' subclassed code in the IDE but this was not implimented for this demo.
'
'WARNING!!!! WARNING!!!! WARNING!!!! WARNING!!!! WARNING!!!! WARNING!!!!
Public Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
' this is *our* implimentation of the message handling routine
' determine which message was recieved
Select Case iMsg
' grab the message that tells us when a file was dropped on the picturebox
Case WM_DROPFILES
' call the sup that we defined in the form module passing wParam which is the handle to the file
frmDragDropFiles.DropFiles wParam
' return zero to windows and get out
WindowProc = False
Exit Function
End Select
' pass all messages on to VB and then return the value to windows
WindowProc = CallWindowProc(procOld, hWnd, iMsg, wParam, lParam)
End Function
' What is subclassing anyway?
'
' Windows runs on "messages". A message is a unique value that, when
' recieved by a window or the operating system, tells either that
' something has happened and that an action of some sort needs to be
' taken. Sort of like your nervous system passing feeling messages
' to your brain and the brain passing movement messages to your body.
'
' So, each window has what's called a message handler. This is a
' function where all of the messages FROM Windows are recieved. Every
' window has one. I mean EVERY window. That means every button, textbox,
' picturebox, form, etc... Windows keeps track of where the message
' handler (called a WindowProc [short for PROCedure]) in a "Class"
' structure associated with each window handle (otherwise known as hWnd).
'
' What happens when a window is subclassed is that you insert a new
' window procedure in line with the original window procedure. In other
' words, Windows sends the messages for the given window to YOUR WindowProc
' FIRST where you are responsible for handling any messages you want to
' handle. Then you MUST pass the remaining messages on to the default
' WindoProc. So it looks like this:
'
' Windows Message Sender --> Your WindowProc --> Default WindowProc
'
' A window can be subclassed MANY times so it could look like this:
'
' Windows Message Sender --> Your WindowProc --> Another WindowProc _
' --> Yet Another WindowProc --> Default WindowProc
'
' You can also change the order of when you respond to a message by
' where in your routine you pass the message on to the default WindowProc.
' Let's say that you want to draw something on the window AFTER the
' default WindowProc handles the WM_PAINT message. This is easily done
' by calling the default proc before you do your drawing. Like so:
'
' Public Function WindowProc(Byval hWnd, Byval etc....)
'
' Select Case iMsg
' Case SOME_MESSAGE
' DoSomeStuff
'
' Case WM_PAINT
' ' pass the message to the defproc FIRST
' WindowProc = CallWindowProc(procOld, hWnd, iMsg, wParam, lParam)
'
' DoDrawingStuff ' <- do your drawing
'
' Exit Function ' <- exit since we already passed the
' ' measage to the defproc
'
' End Select
'
' ' pass all messages on to VB and then return the value to windows
' WindowProc = CallWindowProc(procOld, hWnd, iMsg, wParam, lParam)
'
' End Function
'
'
' This is just a basic overview of subclassing but I hope it helps if
' you were fuzzy about the subject before reading this.
'

注释倒是挺多滴!!呵呵....开心哦...

评价一下你浏览此帖子的感受

级别: 终身会员

发帖: 3743

铜板: 8

人品值: 493

贡献值: 9

交易币: 0

好评度: 3746

信誉值: 0

金币: 0

所在楼道

只看该作者 3 发表于: 2006-06-12

学习~~~
看代码不是要问他干吗用
是用来学习的
只有多看看代码才能编出好的代码~
就是不懂VB
还是顶一下~

级别: 经院高中

发帖: 369

铜板: 3800

人品值: 215

贡献值: 0

交易币: 0

好评度: 305

信誉值: 0

金币: 0

所在楼道

只看该作者 2 发表于: 2006-06-12

就是拖放用的嘛。。。。

把一个文件拖进去，然后就能显示文件的路径啊。。

别的没有了。

级别: 经院博士

发帖: 3975

铜板: 4727

人品值: 1147

贡献值: 565

交易币: 0

好评度: 3833

信誉值: 0

金币: 0

所在楼道: 学一楼

只看该作者 1 发表于: 2006-06-12

深奥

这个是干傻用的？

引用

我的身体给了一个连畜生都不如的男人【连载】

引用
想找我？如果我即不在石家庄经济学院论坛www.uebbs.net，也不在宿舍，那，我肯定是在去的路上

引用

30元/月这个地方的签名广告位就是你的保证点击效果

« 返回列表上一主题下一主题