Option Compare Database
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Const MatrasH = 0&
Const MatrasV = 1&
Const Solid = 2&
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 CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) 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 InvalidateRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Public Function SetStatusBackGround(Optional ByVal lBackColor As Long = -1, Optional lTextColor As Long = -1) As Boolean
Dim lRet As Long, rc As RECT
Dim hDC As Long, hWndStatus As Long
hWndStatus = FindWindowEx(Application.hWndAccessApp, 0&, "OStatbar", vbNullString)
lRet = GetWindowRect(hWndStatus, rc)
With rc
.Bottom = .Bottom - .Top
.Top = 0
.Right = .Right - .Left
.Left = 0
End With
hDC = GetDC(hWndStatus)
If lBackColor <> -1 Then lRet = SetBkColor(hDC, lBackColor)
If lTextColor <> -1 Then lRet = SetTextColor(hDC, lTextColor)
lRet = ReleaseDC(hWndStatus, hDC)
Call InvalidateRect(hWndStatus, rc, 1&)
End Function
Public Function DrawBackground(lColor As Long, Optional drawStyle As Long = Solid)
Dim rc As RECT, lRet As Long, hWndMDI As Long, hBrush As Long
If drawStyle = MatrasH Then
hBrush = CreateHatchBrush(0&, lColor)
ElseIf drawStyle = MatrasV Then
hBrush = CreateHatchBrush(1&, lColor)
ElseIf drawStyle = Solid Then
hBrush = CreateSolidBrush(lColor)
Else
Exit Function
End If
hWndMDI = FindWindowEx(Application.hWndAccessApp, 0&, "MDIClient", vbNullString)
lRet = GetWindowRect(hWndMDI, rc)
With rc
.Bottom = .Bottom - .Top
.Top = 0
.Right = .Right - .Left
.Left = 0
End With
lRet = SetClassLong(hWndMDI, (-10), hBrush)
Call InvalidateRect(hWndMDI, rc, 1&)
End Function
'Применение: можно в стартовой форме или отдельно запускать через autoexec
'Для стартовой формы:
'Private Sub Form_Load()
'DrawBackground 14927790 ' изменяет цвет окна Access
'SetStatusBackGround , 255 ' изменяет цвет текста строки состояния
'End Sub
|