谁有VB6.0循序渐进教程的源代码？

[chenggongkou]

请给小弟一份，或者能提供下载地址。谢谢。

[e-mail]

[dongge2000]

我最喜欢的代码。
Option Explicit

Public Declare Function WindowFromPoint Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Public Type POINTAPI
X As Long
Y As Long
End Type

Public Type DGfor3
ponX As Long
ponY As Long
MDC As Long
End Type

Public Function MouseDC() As DGfor3
On Error Resume Next
Dim Cur As POINTAPI
GetCursorPos Cur
MouseDC.MDC = WindowFromPoint(Cur.X, Cur.Y)
MouseDC.ponX = Cur.X
MouseDC.ponY = Cur.Y
End Function

[dongge2000]

Option Explicit

Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Public Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 260
End Type

Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const TH32CS_SNAPPROCESS = &H2&
Public Const hNull = 0

Public Function GetPath(ByVal hWnd As Long) As String
Dim hProcess As Long
Dim ProcID As Long
Dim mModules(1 To 200) As Long
Dim cbNeed As Long
Dim ModuleName As String
Dim nSize As Long
Dim lRet As Long

GetWindowThreadProcessId hWnd, ProcID
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, ProcID)
lRet = EnumProcessModules(hProcess, mModules(1), 200, cbNeed)
If lRet <> 0 Then
ModuleName = Space(MAX_PATH)
nSize = 500
lRet = GetModuleFileNameExA(hProcess, mModules(1), ModuleName, nSize)
GetPath = Left(ModuleName, lRet)
End If
lRet = CloseHandle(hProcess)
End Function
'代码我在原来贴子的基础上改写了一下，效率比贴子中的会高一些！
'调用如下：
'Text1.Text=GetPath(hWnd)<hWnd>是你要查的句柄

[dongge2000]

Option Explicit

Public Const GWL_WNDPROC = (-4)


Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public WinProc As Long
Public Const WM_GETTEXT = &HD
Public Sub rNoGetText(ByVal TextWnd As Long)
WinProc = GetWindowLong(TextWnd, GWL_WNDPROC)
SetWindowLong TextWnd, GWL_WNDPROC, AddressOf WndProc
End Sub

Public Sub nNoGetText(ByVal TextWnd As Long)
SetWindowLong TextWnd, GWL_WNDPROC, WinProc
WinProc = 0
End Sub

Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_GETTEXT Then
Else
WndProc = CallWindowProc(WinProc, hWnd, Msg, wParam, lParam)
End If
End Function

[chenggongkou]

没事儿吧您？

[MY2000]

本马甲来看看。

[dongge2000]

Option Explicit

Public Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Public Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)
Public Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT)
Public Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long)
Public Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Public Type POINT
x As Long
y As Long
End Type
Dim client As RECT
Dim Cur As POINT
Public Function SetMouseRect(ByVal hWnd As Long, ByVal Install As Boolean) As Long
If Not Install Then ClipCursor ByVal 0&: Exit Function
GetClientRect Me.hWnd, client
Cur.x = client.left
Cur.y = client.top
ClientToScreen Me.hWnd, Cur
OffsetRect client, Cur.x, Cur.y
ClipCursor client
End Function

[dongge2000]

'SetMouseIn 窗体的句柄,透明度（可选）,是否置顶（可选）,是否鼠标穿透（可选）
Option Explicit
Public Const LWA_ALPHA = &H2
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const WS_EX_TRANSPARENT As Long = &H20&
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const HWND_TOPMOST = -1

Public Function SetMouseIn(ByVal hwnd As Long, Optional TouMing As Long = 200, Optional Top As Boolean = True, Optional cMouse As Boolean = True) As Long
Dim Ret As Long
Ret = GetWindowLong(hwnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
If cMouse Then Ret = Ret Or WS_EX_TRANSPARENT
SetWindowLong hwnd, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes hwnd, 0, TouMing, LWA_ALPHA
If Top Then SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Function

[dongge2000]

Option Explicit

Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Const GCL_HCURSOR = (-12)

Dim CurSor As Long
Dim OldCur As Long

Public Sub SetAni(ByVal hWnd As Long, ByVal PathAni As String)
Dim ret As Long
OldCur = GetClassLong(hWnd, GCL_HCURSOR)
CurSor = LoadCursorFromFile(PathAni)
ret = SetClassLong(hWnd, GCL_HCURSOR, CurSor)

End Sub

Public Sub UnSetAni(ByVal hWnd As Long)
Dim ret As Long
ret = SetClassLong(hWnd, GCL_HCURSOR, OldCur)
End Sub

[chenggongkou]

UUUUUPPPPP.

[wxf0204]

我也是菜鸟,你这太深奥了!

[chenggongkou]

......