Option Compare Database
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassname As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function apiGetWindow Lib "user32" _
Alias "GetWindow" _
(ByVal hWnd As Long, _
ByVal wCmd As Long) _
As Long
Private Declare Function apiGetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hWnd As Long, _
ByVal lpClassname As String, _
ByVal nMaxCount As Long) _
As Long
'Mouse position type
Private Type POINTAPI
x As Long
y As Long
End Type
'Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
' handle identifies the child window at the top of the Z order,
' if the specified window is a parent window
Private Const GW_CHILD = 5
' Returns a handle to the window below the given window.
Private Const GW_HWNDNEXT = 2
Private Const MAX_LEN = 255
' class name for an Access form's client window
Private Const ACC_FORM_CLIENT_CLASS = "OFormSub"
' class name for the child window of an Access form's Client window
Private Const ACC_FORM_CLIENT_CHILD_CLAS
S = "OFEDT"
' Copies the source rectangle directly to the destination rectangle.
Private Const SRCCOPY = &HCC0020
' Maps pixels from the source rectangle into blocks of pixels in
' the destination rectangle. The average color over the destination block
' of pixels approximates the color of the source pixels.
Private Const STRETCH_HALFTONE& = 4
' Performs a Boolean AND operation using the color values for the
' eliminated and existing pixels. If the bitmap is a monochrome bitmap,
' this mode preserves black pixels at the expense of white pixels.
Private Const STRETCH_ORSCANS& = 2
Dim dsktp As Long, St As Long, PP As POINTAPI 'Some variables
Private Sub Detail_Click()
MsgBox Application.Forms("form1")
.hWnd
MsgBox Detail.Application.hWndAcc
essApp
End Sub
Private Sub Form_Load()
'this is modified code from "The Start Button Cam By Tomer Cohen:" & vbCrLf & vbCrLf & "
http://come.to/Tomer-C", vbInformation, "Tomer Cohen"
Dim Wind As Long 'Temporary hwnd holder
'Finding the SystemTray Window (hwnd)
Wind = FindWindow("Shell_TrayWnd"
, "")
'Finding the Start Button Window (hwnd)
Wind = FindWindowEx(Wind, 0, "Button", vbNullString)
'Getting Start Button DC
' St = GetDC(Application.Forms("f
orm1").hwn
d)
St = GetDC(fGetClientHandle(For
m_Form1))
'Getting the Desktop window hwnd
Wind = GetDesktopWindow()
'Getting the Desktop window DC
dsktp = GetDC(Wind)
'Timer1.Enabled = True
End Sub
Private Sub Form_Timer()
GetCursorPos PP
'Drawing the mouse's background on the Start Button
StretchBlt St, 0, 0, 480, 200, dsktp, PP.x - 30, PP.y - 12.5, 240, 100, SRCCOPY
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Relesing the Start Button DC
ReleaseDC hWnd, St
'Releasing the Desktop Window DC
ReleaseDC hWnd, dsktp
End Sub
Function fGetClientHandle(frm As Form) As Long
' Returns a handle to the client window of a form
' An Access form's hWnd is actually bound to the
' recordselector "window"
'
Dim hWnd As Long
' get the first child window of the form
hWnd = apiGetWindow(frm.hWnd, GW_CHILD)
' iterate through all child windows of the form
Do While hWnd
' if we locate the client area whose class name is "OFormSub"
If fGetClassName(hWnd) = ACC_FORM_CLIENT_CLASS Then
' the Client window's child is a window with the class
' name of OFEDT, so just verify that we're looking at the
' right window
If fGetClassName(apiGetWindow
( _
hWnd, GW_CHILD)) = _
ACC_FORM_CLIENT_CHILD_CLAS
S Then
' if we found a match, then return
' the handle and we're outta here.
fGetClientHandle = hWnd
Exit Do
End If
End If
' get a handle to the next child window
hWnd = apiGetWindow(hWnd, GW_HWNDNEXT)
Loop
End Function
Private Function fGetClassName(hWnd As Long) As String
Dim strBuffer As String
Dim lngCount As Long
strBuffer = String$(MAX_LEN - 1, 0)
lngCount = apiGetClassName(hWnd, strBuffer, MAX_LEN)
If lngCount > 0 Then
fGetClassName = Left$(strBuffer, lngCount)
End If
End Function