Download and run it or compile (VB 5).
Not for distribution or sale
Place on form three buttons:
bOk (default=true) ' it sets work area
bGet ' it gets current work area
bMin (cancel=true) ' hides form when ESC pressed
timer named 'tmr',
check box 'ch' ' always
and labels:
lblX() ' 0,1
lblY() ' 0,1
lblW() ' 0,1
lblH() ' 0,1
which represents coordinates of work area
' Form Code -----------------------------------
Option Explicit
Dim v As Long, a As RECT, g As RECT
Private Sub bGet_Click()
RememberArea
End Sub
Private Sub bMin_Click()
WindowState = vbMinimized
End Sub
Private Sub bOk_Click()
SetArea
End Sub
Private Sub ch_Click()
tmr.Enabled = ch.Value
bOk.Enabled = 1 - ch.Value
End Sub
Private Sub Form_Load()
g.Left = 0
g.Top = 0
g.Bottom = Screen.Height / Screen.TwipsPerPixelY
g.Right = Screen.Width / Screen.TwipsPerPixelX
Center Me
If CheckArea Then
GetArea 1
bOk.Caption = "All is OK"
bOk.Enabled = False
ch.Enabled = False
End If
End Sub
Sub GetArea(ByVal Index As Integer)
v = SystemParametersInfo(SPI_GETWORKAREA, vbNull, a, 0)
lblX(Index).Caption = a.Left
lblY(Index).Caption = a.Top
lblW(Index).Caption = a.Right - a.Left
lblH(Index).Caption = a.Bottom - a.Top
End Sub
Sub SetArea()
a = g
v = SystemParametersInfo(SPI_SETWORKAREA, vbNull, a, SPIF_change)
GetArea 1
End Sub
Function CheckArea() As Integer
GetArea 0
If a.Left = g.Left And a.Top = g.Top And a.Right = g.Right And a.Bottom = g.Bottom Then CheckArea = True Else CheckArea = False
End Function
Sub RememberArea()
v = SystemParametersInfo(SPI_GETWORKAREA, vbNull, g, 0)
End Sub
Private Sub Form_Resize()
If WindowState = vbMinimized Then
If CheckArea Then
Caption = "Work Area OK"
Else
Caption = "Work Area Small"
End If
Else
Caption = "Set Work Area"
End If
End Sub
Private Sub tmr_Timer()
If CheckArea Then
Form_Resize
Exit Sub
Else
SetArea
End If
End Sub
' Module Code ------------------------
Option Explicit
Public Const SPIF_SENDWININICHANGE = &H2
Public Const SPIF_UPDATEINIFILE = &H1
Public Const SPIF_change = SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE
Public Const SPI_GETWORKAREA = 48
Public Const SPI_GETNONCLIENTMETRICS = 41
Public Const SPI_SETWORKAREA = 47
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Sub Center(f As Form) ' center on screen
Dim w As Integer
If Screen.Width > Screen.Height * 2 Then w = Screen.Width / 2 Else w = Screen.Width
f.Move (w - f.Width) / 2, (Screen.Height - f.Height) / 2
End Sub
Comments