|
но толком на языке Visual Basic никто не подсказал
Странный ты человек..., не обижайся 
Вот я, например, знаю как реализовать это.
Но для полноценного примера надо накорябать на вскидку 500-600 строк кода.
Написать длл с хуком, сделать корректный вызов ее сервисов из exe, предусмотреть прорисовку при разных темах винды.
Масса мышиной возни с неклиентской областью окон.
И все это ради примера на VB.
Ну разве что побаловаться c одним:
-
- Option Explicit
- Private Sub Form_Load()
- Call SetProp(hwnd, "Father", GetWindowLong(hwnd, GWL_WNDPROC))
- Call SetWindowLong(hwnd, GWL_WNDPROC, AddressOf myProc)
- End Sub
-
-
- Option Explicit
- Public Type POINTAPI
- x As Long
- y As Long
- End Type
- Public Type RECT
- Left As Long
- Top As Long
- Right As Long
- Bottom As Long
- End Type
- Public 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
- 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
- Public Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
- Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
- Public Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As Long
- Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
- Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
- Public Declare Function UpdateWindow Lib "user32" (ByVal hwnd 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 Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
- Public Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
- Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
- Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
-
- Public Const VK_LBUTTON = &H1
- Public Const SWP_FRAMECHANGED = &H20
- Public Const SWP_NOMOVE = &H2
- Public Const SWP_NOSIZE = &H1
- Public Const SWP_NOACTIVATE = &H10
- Public Const SWP_NOZORDER = &H4
-
- Public Const WM_NCLBUTTONDBLCLK = &HA3
- Public Const WM_NCLBUTTONDOWN = &HA1
- Public Const WM_NCLBUTTONUP = &HA2
- Public Const WM_NCPAINT = &H85
- Public Const GWL_WNDPROC = (-4)
-
-
- Public Function myProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
-
- Dim hdc As Long
- Dim rc As RECT, rcwnd As RECT
- Dim pt As POINTAPI
- Dim inrect As Boolean
-
- rc.Left = 150
- rc.Right = 180
- rc.Top = 7
- rc.Bottom = 20
-
- Select Case Msg
- Case WM_NCLBUTTONDOWN, WM_NCLBUTTONUP, WM_NCLBUTTONDBLCLK
- pt.x = LWORD(lParam)
- pt.y = HWORD(lParam)
- Call GetWindowRect(hwnd, rcwnd)
- pt.x = pt.x - rcwnd.Left
- pt.y = pt.y - rcwnd.Top
- inrect = PtInRect(rc, pt.x, pt.y)
- End Select
-
- If inrect Then
- Select Case Msg
- Case WM_NCLBUTTONDBLCLK
- Form1.Caption = "WM_LBUTTONDOWN"
- updateframe hwnd
- Case WM_NCLBUTTONDOWN
- Form1.Caption = "WM_LBUTTONDOWN"
- updateframe hwnd
- Case WM_NCLBUTTONUP
- Form1.Caption = "WM_LBUTTONUP"
- updateframe hwnd
- End Select
- Exit Function
- End If
-
- myProc = CallWindowProc(GetProp(hwnd, "Father"), hwnd, Msg, wParam, lParam)
-
- Select Case Msg
- Case WM_NCPAINT
- hdc = GetWindowDC(hwnd)
- Call GetCursorPos(pt)
- Call GetWindowRect(hwnd, rcwnd)
- pt.x = pt.x - rcwnd.Left
- pt.y = pt.y - rcwnd.Top
- inrect = PtInRect(rc, pt.x, pt.y)
- Call DrawFrameControl(hdc, rc, 4, IIf(GetAsyncKeyState(VK_LBUTTON) And inrect, 528, 16))
- Call ReleaseDC(hwnd, hdc)
- End Select
-
- End Function
-
- Sub updateframe(hwnd As Long)
- Call SetWindowPos(hwnd, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOACTIVATE)
- End Sub
-
- Public Function LWORD(param As Long) As Long
- LWORD = param And &HFFFF&
- End Function
-
- Public Function HWORD(param As Long) As Long
- HWORD = param \ &H10000 And &HFFFF&
- End Function
Не спалось.........
Ответить
|
Mc.WOLF
VerhoLom
