aaaaaaaaa
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function CreateBitmapIndirect Lib "gdi32" (lpBitmap As BITMAP) As Long
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Const PATINVERT = &H5A0049 ' (DWORD) dest = pattern XOR dest
Private Const DSTINVERT = &H550009 ' (DWORD) dest = (NOT dest)
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function WindowFromPoint Lib "user32.dll" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private dist As Integer
Private m_lPattern(0 To 3) As Long
Private m_hBrush As Long
Private Type BITMAP '24 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Dim cHookMouse As cHookCallback
Private Sub Form_Unload(Cancel As Integer)
Set cHookMouse = Nothing
End Sub
Private Sub Form_Load()
Dim tbm As BITMAP
Dim hBm As Long
Set cHookMouse = New cHookCallback
Call cHookMouse.shk_SetHook(WH_MOUSE, , eMsgWhen.MSG_AFTER, , 1, Me)
For i = 0 To 3
m_lPattern(i) = &HAAAA5555
Next i
DestroyBrush
' Create a monochrome bitmap containing the desired pattern:
tbm.bmType = 0
tbm.bmWidth = 16
tbm.bmHeight = 8
tbm.bmWidthBytes = 2
tbm.bmPlanes = 1
tbm.bmBitsPixel = 1
tbm.bmBits = VarPtr(m_lPattern(0))
hBm = CreateBitmapIndirect(tbm)
' Make a brush from the bitmap bits
m_hBrush = CreatePatternBrush(hBm)
'// Delete the useless bitmap
DeleteObject hBm
dist = (pic2.top - pic1.Height)
End Sub
Private Sub DestroyBrush()
If Not (m_hBrush = 0) Then
DeleteObject m_hBrush
m_hBrush = 0
End If
End Sub
Private Sub PicContainer_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Dim rc As RECT
Dim rc2 As RECT
GetWindowRect PicContainer.hwnd, rc
GetWindowRect pic1.hwnd, rc2
lhDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
hOldBrush = SelectObject(lhDC, m_hBrush)
PicContainer.Refresh
PatBlt lhDC, rc.left, rc2.bottom, rc2.right - rc.left, dist, PATINVERT
SelectObject lhDC, hOldBrush
DeleteDC lhDC
End If
End Sub
Private Sub PicContainer_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Dim rc As RECT
Dim rc2 As RECT
GetWindowRect PicContainer.hwnd, rc
GetWindowRect pic1.hwnd, rc2
lhDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
hOldBrush = SelectObject(lhDC, m_hBrush)
PicContainer.Refresh
PatBlt lhDC, rc.left, rc2.bottom, rc2.right - rc.left, dist, PATINVERT
SelectObject lhDC, hOldBrush
DeleteDC lhDC
mouse_y = y
If y < 10 Then Exit Sub
If y >= PicContainer.Height - 10 Then Exit Sub
pic1.Height = y
pic2.top = pic1.Height + dist
pic2.Height = PicContainer.Height - pic1.Height - dist
End If
End Sub
Private Sub PicContainer_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Dim rc As RECT
Dim rc2 As RECT
GetWindowRect PicContainer.hwnd, rc
GetWindowRect pic1.hwnd, rc2
lhDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
hOldBrush = SelectObject(lhDC, m_hBrush)
PicContainer.Refresh
PatBlt lhDC, rc.left, rc2.bottom, rc2.right - rc.left, dist, PATINVERT 'doppio si riazzera
PatBlt lhDC, rc.left, rc2.bottom, rc2.right - rc.left, dist, PATINVERT
SelectObject lhDC, hOldBrush
DeleteDC lhDC
End If
End Sub
' ordinal #1 from vtable function VB (subclassing shellcode)
Private Sub HookProcMouse(ByVal bBefore As Boolean, _
ByRef bHandled As Boolean, _
ByRef lReturn As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long, _
ByVal lHookType As eHookType, _
ByRef lParamUser As Long)
If nCode > 0 Then
Dim hwnd As Long
Dim pt As POINTAPI
GetCursorPos pt
hwnd = WindowFromPoint(pt.x, pt.y)
If hwnd = frm.PicContainer.hwnd Then
MousePointer = 99
MouseIcon = imgCursorSplitterHorizontal.Picture
Else
MousePointer = 0
End If
End If
End Sub
