Attribute VB_Name = "rg"
'Ramon Guerrero
'ZoneCorp@dallas.net
'ZoneCorp@AOL.com
'ZoneCorp@Compuserve.com

Public Enum ZoomDirection
ZoomFormOpen = 0
ZoomFormClosed = 1
End Enum

Public ZoomedFromLast As ZoomFrom

Public Enum ZoomFrom
TopLeft = 0
TopCenter = 1
TopRight = 2
MidLeft = 3
MidCenter = 4
MidRight = 5
BtmLeft = 6
BtmCenter = 7
BtmRight = 8
ScreenCenter = 9
ToTaskBarTray = 10
FromTaskBarTray = 11
FromMousePointer = 12
ScreenActiveFrm = 13
End Enum

Public Enum ZoomEffects
FromCenter = 0
FromLeft = 1
FromRight = 2
FromTopRight = 3
FromBotRight = 4
FromBotLeft = 5
FromTopLeft = 6
Explode = 7
FromTop = 8
FromBottom = 9
End Enum

Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2

'Sound Functions
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Const SND_ASYNC = &H1         '  play asynchronously
Private Const SND_NODEFAULT = &H2     '  silence not default, if sound not found
Private Const SND_LOOP = &H8          '  loop the sound until next sndPlaySound
Private Const SND_RESOURCE = &H40004  '  name is a resource name or atom

'Window
Private Declare Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
  
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2

'Cursor
Private Type POINTAPI
        Y As Long
        X As Long
End Type
 
Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
 
Private Const rgRegSounds = "AppEvents\Schemes\Apps\.Default\"

'Zoom Window
Private Const IDANI_OPEN = &H1
Private Const IDANI_CLOSE = &H2
Private Const IDANI_CAPTION = &H3
 
Private Declare Function GetDesktopWindow Lib "User32" () As Long
Private Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function DrawAnimatedRects Lib "User32" (ByVal hWnd As Long, ByVal idAni As Long, lprcFrom As RECT, lprcTo As RECT) As Long

Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

'Registry API Declarations
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long

'Registry Security Constants
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SYNCHRONIZE = &H100000
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)

Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
                     
' Reg Key ROOT Types
Public Enum RegistryRoots
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_CURRENT_USER = &H80000001
HKEY_DYN_DATA = &H80000006
HKEY_LOCAL_MACHINE = &H80000002
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_USERS = &H80000003
End Enum

' Registry Data Type Constants
Private Const REG_SZ = 1

Private Const REG_OPTION_NON_VOLATILE = 0

' Error values
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_NO_MORE_ITEMS = 259&

Public Enum SystemSounds
rgBuddy_In = 0
rgBuddy_Out = 1
rgClose = 2
rgDrop = 3
rgFilesDone = 4
rgGoodBye = 5
rgMailBeep = 6
rgMaximize = 7
rgMenuCommand = 8
rgMenuPopup = 9
rgMinimize = 10
rgOpen = 11
rgRestoreDown = 12
rgRestoreUp = 13
rgSystemAsterisk = 14
rgSystemExclamation = 15
rgSystemExit = 16
rgSystemHand = 17
rgSystemQuestion = 18
rgSystemStart = 19
rgWelcome = 20
rgYouGotMain = 21
End Enum

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Sub SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Const WM_NCACTIVATE = &H86

Private Declare Function LoadIcon Lib "User32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
Private Declare Function LoadIconBynum& Lib "User32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long)
Private Declare Function DrawIcon Lib "User32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Private Declare Function DrawIconEx Lib "User32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
 
Public Enum SystemIcons
IDI_APPLICATION = 32512&
IDI_ASTERISK = 32516&
IDI_EXCLAMATION = 32515&
IDI_HAND = 32513&
IDI_QUESTION = 32514&
End Enum

 
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const COLOR_BTNFACE = 15
Private Const COLOR_ACTIVECAPTION = 2
Private Const COLOR_INACTIVECAPTION = 3
 
Public Declare Function CreateRectRgn& Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
Public Declare Function CreateRoundRectRgn& Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long)
Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function SetWindowRgn Lib "User32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

Private Declare Function GetSysColor Lib "User32" (ByVal nIndex As Long) As Long
Private Declare Function GetSysColorBrush Lib "User32" (ByVal nIndex As Long) As Long
Private Const COLOR_APPWORKSPACE = 12
Private Const COLOR_BACKGROUND = 1

Private Declare Function GetDC Lib "User32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "User32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
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

'DrawEdge Routine
 Private Const BDR_RAISEDOUTER = &H1
 Private Const BDR_SUNKENOUTER = &H2
 Private Const BDR_RAISEDINNER = &H4
 Private Const BDR_SUNKENINNER = &H8

 Private Const BDR_OUTER = &H3
 Private Const BDR_INNER = &HC
 Private Const BDR_RAISED = &H5
 
 Private Const BDR_SUNKEN = &HA

 Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
 Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
 Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
 Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
 
 Private Const BF_LEFT = &H1
 Private Const BF_TOP = &H2
 Private Const BF_RIGHT = &H4
 
 Private Const BF_BOTTOM = &H8

 Private Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
 Private Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
 Private Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
 Private Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
 Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
 Private Const BF_DIAGONAL = &H10

 ' For diagonal lines, the BF_RECT flags specify the end point of the
 ' vector bounded by the rectangle parameter.
 Private Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP Or BF_RIGHT)
 Private Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)
 Private Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM Or BF_LEFT)
 Private Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM Or BF_RIGHT)

 Private Const BF_MIDDLE = &H800   ' Fill in the middle
 Private Const BF_SOFT = &H1000    ' For softer buttons
 Private Const BF_ADJUST = &H2000  ' Calculate the space left over
 Private Const BF_FLAT = &H4000    ' For flat rather than 3D borders
 Private Const BF_MONO = &H8000    ' For monochrome borders

 Private Declare Function DrawEdge Lib "User32" (ByVal hDC As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Boolean

 
 Public Sub Draw3dUp(picBox As PictureBox, strCaption As String)
  Dim PicRect As RECT
  
  
  With picBox
  '.ForeColor = picbox.forecolor
    .Cls
    .ScaleMode = 3
    .BorderStyle = 0
    .AutoRedraw = True
    PicRect.Left = .ScaleLeft
    PicRect.Top = .ScaleTop
    PicRect.Right = .ScaleWidth
    PicRect.Bottom = .ScaleHeight
    .CurrentX = (.ScaleWidth - .TextWidth(strCaption)) / 2
    .CurrentY = (.ScaleHeight - .TextHeight(strCaption)) / 2
  End With
  
  picBox.Print strCaption
  DrawEdge picBox.hDC, PicRect, CLng(BDR_RAISEDINNER Or BF_SOFT), BF_RECT
  If picBox.AutoRedraw Then picBox.Refresh
 End Sub

Public Sub Draw3dDown(picBox As PictureBox, strCaption As String)
  Dim PicRect As RECT
  
  
  With picBox
  '.ForeColor = picbox.forecolor
    .Cls
    .ScaleMode = 3
    .BorderStyle = 0
    .AutoRedraw = True
    PicRect.Left = .ScaleLeft
    PicRect.Top = .ScaleTop
    PicRect.Right = .ScaleWidth
    PicRect.Bottom = .ScaleHeight
    .CurrentX = (.ScaleWidth - .TextWidth(strCaption)) / 2
    .CurrentY = (.ScaleHeight - .TextHeight(strCaption)) / 2
  End With
  
  picBox.Print strCaption
  DrawEdge picBox.hDC, PicRect, CLng(BDR_SUNKENOUTER Or BF_SOFT), BF_RECT
  If picBox.AutoRedraw Then picBox.Refresh
  End Sub
  

 
Public Sub frmZoomFromObj(frmParent As Object, f As Form, Optional ZoomEffect As ZoomEffects = 7, _
                          Optional ShowMsgForm As Boolean = True)
 
Dim xFrom As RECT
Dim xTo As RECT
Dim ptApi As POINTAPI
 
 
ZoomedFromLast = -1

Call GetWindowRect(frmParent.hWnd, xFrom)
 
 
Call GetWindowRect(f.hWnd, xTo)
 


Call DrawAnimatedRects(f.hWnd, IDANI_OPEN Or IDANI_CAPTION, xFrom, xTo)

ZoomOpen f, 900, ZoomEffect, ShowMsgForm
DoEvents
Call regGetSystemWave("", rgRestoreUp)
DoEvents
End Sub

Public Sub frmZoom(f As Form, ScreenPosition As ZoomFrom, Direction As ZoomDirection, _
                   Optional Cycles As Integer, Optional ZoomEffect As ZoomEffects = 7, _
                   Optional ShowMsgForm As Boolean = True)
 
Dim xFrom As RECT
Dim xTo As RECT
Dim ptApi As POINTAPI
 
If Direction = ZoomFormClosed And f.Visible = False Then Exit Sub

'Use the FromMousePointer options for Toolbar Buttons
If ScreenPosition = FromMousePointer Then

Call GetCursorPos(ptApi)

xFrom.Top = ptApi.X
xFrom.Left = ptApi.Y
xFrom.Right = ptApi.X
xFrom.Bottom = ptApi.Y
 
ElseIf ScreenPosition = ScreenActiveFrm Then

Call GetWindowRect(Screen.ActiveForm.hWnd, xFrom)
xFrom.Right = 1
xFrom.Bottom = 1

Else

Call GetWindowRect(GetDesktopWindow(), xFrom)

End If

ZoomedFromLast = ScreenPosition

Select Case ScreenPosition

Case 0 'TopLeft = 0
xFrom.Left = 0
xFrom.Top = 0

Case 1 'TopCenter = 1
xFrom.Left = (xFrom.Right - xFrom.Left) / 2
xFrom.Top = 0

Case 2 'TopRight = 2
xFrom.Left = xFrom.Right - 1
xFrom.Top = 0

Case 3 'MidLeft = 3
xFrom.Left = 0
xFrom.Top = (xFrom.Bottom - xFrom.Top) / 2

Case 4 'MidCenter = 4
xFrom.Left = (xFrom.Right - xFrom.Left) / 2
xFrom.Top = (xFrom.Bottom - xFrom.Top) / 2

Case 5 'MidRight = 5
xFrom.Left = xFrom.Right - 1
xFrom.Top = (xFrom.Bottom - xFrom.Top) / 2

Case 6 'BtmLeft = 6
xFrom.Left = 0
xFrom.Top = xFrom.Bottom - 1

Case 7 'BtmCenter = 7
xFrom.Left = (xFrom.Right - xFrom.Left) / 2
xFrom.Top = xFrom.Bottom - 1

Case 8 'BtmRight = 8
xFrom.Left = xFrom.Right - 1
xFrom.Top = xFrom.Bottom - 1

Case 9 'ScreenCenter = 9
xFrom.Left = (xFrom.Right - xFrom.Left) / 2
xFrom.Top = (xFrom.Bottom - xFrom.Top) / 2