GFSkinEngine/GFSkinEngine_UserMoveInfofrm.frm
VERSION 5.00
Begin VB.Form GFSkinEngine_UserMoveInfofrm
BackColor = &H80000018&
BorderStyle = 0 'Kein
Caption = "SE UserMoveInfo"
ClientHeight = 270
ClientLeft = 0
ClientTop = 0
ClientWidth = 2010
Enabled = 0 'False
LinkTopic = "Form1"
ScaleHeight = 270
ScaleWidth = 2010
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows‑Standard
Visible = 0 'False
Begin VB.Timer UMI_Timer
Enabled = 0 'False
Left = 1625
Top = 0
End
Begin VB.Shape UMI_Shape
Height = 273
Left = 0
Top = 0
Width = 1573
End
Begin VB.Label UMI_Label
AutoSize = ‑1 'True
BackStyle = 0 'Transparent
Caption = "[...]"
ForeColor = &H80000017&
Height = 169
Left = 65
TabIndex = 0
Top = 65
Width = 1430
End
End
Attribute VB_Name = "GFSkinEngine_UserMoveInfofrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001 by Louis. Displays a ToolTipText‑like window near the mouse pointer,
'providing information about the current control's name, position and size.
'
'GFSetWindowOnTop
Private 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
'ProgramGetMousePos[X, Y]
Private Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
'GFSetWindowOnTop
Private Const HWND_TOPMOST As Long = ‑1
Private Const HWND_NOTOPMOST As Long = ‑2
Private Const SWP_NOSIZE As Long = &H1
Private Const SWP_NOMOVE As Long = &H2
'ProgramGetMousePos[X, Y]
Private Type POINTAPI
x As Long
y As Long
End Type
'UMI_Struct
Private Type UMI_Struct
UMI_VisibleFlag As Boolean
UMI_SEControlStructIndex As Integer
End Type
Dim UMI_StructVar As UMI_Struct
'***************************************UMI CODE****************************************
'NOTE: call UMI_Show() to display the UserMoveInfo window. Its control‑specific content
'will be updated every 100 ms and in this interval it will also be moved near the mouse pointer.
'Call UMI_Hide() to hide UMIfrm again.
'The UMI code should be used by the UserMove system code only, do not display
'this window when the left mouse button is pressed, etc., tests showed that then there
'could be problems with hiding UMIfrm.
Public Sub UMI_Show(ByVal SEControlStructIndex As Integer)
'on error resume next
Dim Ignore_WM_LBUTTONUP_FlagUnchanged As Boolean
Dim Ignore_WM_RBUTTONUP_FlagUnchanged As Boolean
'verify
If UserMoveStructVar.ControlInfoEnabledFlag = False Then Exit Sub
'begin
If Not ((SEControlStructIndex < 1) Or (SEControlStructIndex > SEControlStructNumber)) Then 'verify
'
'NOTE: when using the UserMove on a control of a form that contains
'combo boxes Win98 SE sends WM_LBUTTONUP messages
'as soon as GFSkinEngine_UserMoveInfofrm is shown.
'The reason therefore could not be found, maybe another Windows bug.
'We must use some of the Skin Engine message ignore flags to avoid errors (tested).
'
Ignore_WM_LBUTTONUP_FlagUnchanged = SESystemStructVar.SystemIgnore_WM_LBUTTONUP_Flag
Ignore_WM_RBUTTONUP_FlagUnchanged = SESystemStructVar.SystemIgnore_WM_RBUTTONUP_Flag
SESystemStructVar.SystemIgnore_WM_LBUTTONUP_Flag = True
SESystemStructVar.SystemIgnore_WM_RBUTTONUP_Flag = True
'
UMI_StructVar.UMI_VisibleFlag = True
UMI_Timer.Interval = 100
UMI_Timer.Enabled = True
UMI_StructVar.UMI_SEControlStructIndex = SEControlStructIndex
'UMI_Label.Font.Name = SESystemStructVar.SystemFont.Name
'UMI_Label.Font.Size = SESystemStructVar.SystemFont.Size
'UMI_Label.Font.Bold = SESystemStructVar.SystemFont.Bold
'UMI_Label.Font.Italic = SESystemStructVar.SystemFont.Italic
'UMI_Label.Font.Underline = SESystemStructVar.SystemFont.Underline
'UMI_Label.Font.StrikeThrough = SESystemStructVar.SystemFont.StrikeThrough
Call UMI_Timer_Timer 'display text and size window
Me.Enabled = True
Me.Visible = True
'Me.Refresh
Call GFSetWindowOnTop(Me)
'
SESystemStructVar.SystemIgnore_WM_LBUTTONUP_Flag = Ignore_WM_LBUTTONUP_FlagUnchanged 'reset
SESystemStructVar.SystemIgnore_WM_RBUTTONUP_Flag = Ignore_WM_RBUTTONUP_FlagUnchanged 'reset
'
Else
MsgBox "internal error in UMI_Show() (GFSkinEngine): passed value invalid !", vbOKOnly + vbExclamation
End If
End Sub
Private Sub UMI_Timer_Timer()
'on error resume next
Dim Tempstr$
Dim XPos As Long
Dim YPos As Long
'begin
If Not ((UMI_StructVar.UMI_SEControlStructIndex < 1) Or (UMI_StructVar.UMI_SEControlStructIndex > SEControlStructNumber)) Then 'verify
Tempstr$ = _
"control name : " + Left$(SEControlStructArray(UMI_StructVar.UMI_SEControlStructIndex).SEControlName, 1024) + Chr$(13) + Chr$(10) + _
"position : " + LTrim$(Str$(GetSEControlXPos(UMI_StructVar.UMI_SEControlStructIndex))) + ", " + LTrim$(Str$(GetSEControlYPos(UMI_StructVar.UMI_SEControlStructIndex))) + Chr$(13) + Chr$(10) + _
"size : " + LTrim$(Str$(GetSEControlXSize(UMI_StructVar.UMI_SEControlStructIndex))) + ", " + LTrim$(Str$(GetSEControlYSize(UMI_StructVar.UMI_SEControlStructIndex)))
If Not (UMI_Label.Caption = Tempstr$) Then 'verify to increase speed
UMI_Label.Caption = Tempstr$
End If
If Not ((Me.Width = (UMI_Label.Width + 10 * Screen.TwipsPerPixelX)) And (Me.Height = (UMI_Label.Height + 10 * Screen.TwipsPerPixelY))) Then 'verify to increase speed
Me.Width = UMI_Label.Width + 10 * Screen.TwipsPerPixelX
Me.Height = UMI_Label.Height + 10 * Screen.TwipsPerPixelY
UMI_Shape.Width = Me.Width
UMI_Shape.Height = Me.Height
End If
XPos = (ProgramGetMousePosX + 32) * Screen.TwipsPerPixelX
YPos = (ProgramGetMousePosY + 32) * Screen.TwipsPerPixelY
If (XPos + Me.Width ‑ Screen.TwipsPerPixelX) > Screen.Width Then
XPos = (ProgramGetMousePosX ‑ 32) * Screen.TwipsPerPixelX ‑ Me.Width
End If
If (YPos + Me.Height ‑ Screen.TwipsPerPixelY) > Screen.Height Then
YPos = (ProgramGetMousePosY ‑ 32) * Screen.TwipsPerPixelY ‑ Me.Height
End If
If Not ((Me.Left = XPos) And (Me.Top = YPos)) Then 'check to increase speed
Call Me.Move(XPos, YPos)
End If
End If
End Sub
Public Sub UMI_Hide()
'on error resume next
If UMI_StructVar.UMI_VisibleFlag = True Then
UMI_StructVar.UMI_VisibleFlag = False 'reset
Me.Visible = False
Me.Enabled = False
Me.Refresh
Call GFRemoveWindowFromTop(Me)
UMI_StructVar.UMI_SEControlStructIndex = 0 'reset
UMI_Timer.Enabled = False
End If
End Sub
'************************************END OF UMI CODE************************************
'***********************************GENERAL FUNCTIONS***********************************
Private Function GFSetWindowOnTop(ByVal WindowOrFormName As Form) As Long
'on error resume next
GFSetWindowOnTop = SetWindowPos(WindowOrFormName.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
WindowOrFormName.Refresh
End Function
Private Function GFRemoveWindowFromTop(ByVal WindowOrFormName As Form) As Long
'on error resume next
GFRemoveWindowFromTop = SetWindowPos(WindowOrFormName.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
WindowOrFormName.Refresh
End Function
Private Function ProgramGetMousePosX() As Long
'On Error Resume Next 'the format is: pixels
Dim ProgramGetMousePosXTemp As Long
Dim CurrentMousePos As POINTAPI
ProgramGetMousePosXTemp = GetCursorPos(CurrentMousePos)
ProgramGetMousePosX = CurrentMousePos.x
End Function
Private Function ProgramGetMousePosY() As Long
'On Error Resume Next 'the format is: pixels
Dim ProgramGetMousePosYTemp As Long
Dim CurrentMousePos As POINTAPI
ProgramGetMousePosYTemp = GetCursorPos(CurrentMousePos)
ProgramGetMousePosY = CurrentMousePos.y
End Function
[END OF FILE]