-
UID:8
-
- 注册时间2005-10-30
- 最后登录2009-08-27
- 在线时间101小时
-
- 发帖369
- 搜Ta的帖子
- 精华
0
- 铜板3800
- 人品值215
- 贡献值0
- 交易币0
- 好评度305
- 信誉值0
- 金币0
-
访问TA的空间加好友用道具
- 发帖
- 369
- 铜板
- 3800
- 人品值
- 215
- 贡献值
- 0
- 交易币
- 0
- 好评度
- 305
- 信誉值
- 0
- 金币
- 0
- 所在楼道
|
还是很简单的.为了我的软件写的更完美先 )SGq[B6@I |CyE5i0 抄别人的..嘎嘎~~~~ 5$k:t 抓图如下拉: I!K6o.|1 3!]rmZ-W L!xi FORM代码如下: Gd85kY@w7 - 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
bk[!8-b/a NzvXN1_% - 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.
- '
i/Zd8+.n$ -iZ`Y? 注释倒是挺多滴!!呵呵....开心哦...
|