rgassistant.bas

山西旅游酒店预定商务软件

Case 10, 11
frmZoomToFromTray f, Direction, ZoomEffect, ShowMsgForm
Exit Sub
 
 
End Select
 
xFrom.Bottom = xFrom.Top + 1
xFrom.Right = xFrom.Left + 1
 
 
Call GetWindowRect(f.hWnd, xTo)
 
If Direction = ZoomFormOpen Then

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

If Cycles > 0 Then
ZoomOpen f, Cycles, ZoomEffect, ShowMsgForm
Else
ZoomOpen f, 900, ZoomEffect, ShowMsgForm
End If
DoEvents
Call regGetSystemWave("", rgRestoreUp)
DoEvents

Else

Call DrawAnimatedRects(f.hWnd, IDANI_CLOSE Or IDANI_CAPTION, xTo, xFrom)
Call regGetSystemWave("", rgRestoreDown)
DoEvents
f.Hide
DoEvents
Unload f

End If
End Sub


Public Sub frmZoomToObj(frmParent As Object, f As Form)
 
Dim xFrom As RECT
Dim xTo As RECT
Dim ptApi As POINTAPI
 
If f.Visible = False Then Exit Sub
 
Call GetWindowRect(frmParent.hWnd, xTo)
 
Call GetWindowRect(f.hWnd, xFrom)
 
Call DrawAnimatedRects(f.hWnd, IDANI_CLOSE Or IDANI_CAPTION, xFrom, xTo)

Call regGetSystemWave("", rgRestoreDown)

DoEvents

f.Hide
Unload f
End Sub

Public Sub frmZoomToFromTray(f As Form, Direction As ZoomDirection, Optional ZoomEffect As ZoomEffects = 7, _
                             Optional ShowMsgForm As Boolean = True)

Dim TrayhWnd As Long
Dim hWnd As Long
Dim r
Dim sClassName As String * 100

 

hWnd = FindWindow("Shell_TrayWnd", 0&)

hWnd = GetWindow(hWnd, GW_CHILD)

 Do
   r = GetClassName(hWnd, sClassName, 100)
   
   If Left(sClassName, r) = "TrayNotifyWnd" Then
   Exit Do
   End If

   hWnd = GetWindow(hWnd, GW_HWNDNEXT)
 Loop While hWnd <> 0
    
Dim xFrom As RECT
Dim xTo As RECT

Select Case Direction

Case ZoomFormOpen

Call GetWindowRect(hWnd, xFrom)

xFrom.Left = (xFrom.Right - (xFrom.Right - xFrom.Left) / 2)
xFrom.Right = xFrom.Left + 1

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
 

Case ZoomFormClosed

Call GetWindowRect(f.hWnd, xFrom)
Call GetWindowRect(hWnd, xTo)
 
xTo.Left = (xTo.Right - (xTo.Right - xTo.Left) / 2)
xTo.Right = xTo.Left + 1

Call DrawAnimatedRects(f.hWnd, IDANI_CLOSE Or IDANI_CAPTION, xFrom, xTo)
Call regGetSystemWave("", rgRestoreDown)
DoEvents
f.Hide
DoEvents
Unload f

End Select

End Sub


Public Function picGetSysMsgBoxIcon(Pic As Object, SysIcon As SystemIcons)
Dim hIcon As Long, r As Long

hIcon = LoadIconBynum&(0, SysIcon)
 
r = DrawIcon(Pic.hDC, 0, 0, hIcon)
Pic.Refresh
End Function
Public Sub regGetSystemWave(Optional WaveFile As String, Optional SystemSound As SystemSounds)

Dim SoundToGet As String
 
If Len(WaveFile) > 0 Then
 
Call sndPlaySound(WaveFile, SND_ASYNC Or SND_NODEFAULT)
 
Else 'Get From System
 
Select Case SystemSound

Case 0
SoundToGet = "Buddy In"
Case 1
SoundToGet = "Buddy Out"
Case 2
SoundToGet = "Close"
Case 3
SoundToGet = "Drop"
Case 4
SoundToGet = "File's Done"
Case 5
SoundToGet = "Goodbye"
Case 6
SoundToGet = "MailBeep"
Case 7
SoundToGet = "Maximize"
Case 8
SoundToGet = "MenuCommand"
Case 9
SoundToGet = "MenuPopup"
Case 10
SoundToGet = "Minimize"
Case 11
SoundToGet = "Open"
Case 12
SoundToGet = "RestoreDown"
Case 13
SoundToGet = "RestoreUp"
Case 14
SoundToGet = "SystemAsterisk"
Case 15
SoundToGet = "SystemExclamation"
Case 16
SoundToGet = "SystemExit"
Case 17
SoundToGet = "SystemHand"
Case 18
SoundToGet = "SystemQuestion"
Case 19
SoundToGet = "SystemStart"
Case 20
SoundToGet = "Welcome"
Case 21
SoundToGet = "You've Got Mail"
End Select

WaveFile = regGetRegistrySetting(HKEY_CURRENT_USER, rgRegSounds & SoundToGet & "\.Current", "", "")
 
Call sndPlaySound(WaveFile, SND_ASYNC Or SND_NODEFAULT)
End If

End Sub

Public Function regGetRegistrySetting(ByVal root As RegistryRoots, ByVal KeyPath As String, ByVal ValueName As String, Optional DefaultData)
 
  Dim RegReturnValue As Long
  Dim hKey As Long
  Dim RegValType As Long
  Dim RegTempValue As String
  Dim RegValueSize As Long
 
 
  RegReturnValue = RegOpenKeyEx(root, KeyPath, 0, KEY_READ, hKey)
  If (RegReturnValue <> ERROR_SUCCESS) Then GoTo error_handler
    
 
  RegReturnValue = RegQueryValueEx(hKey, ValueName, 0, RegValType, RegTempValue, RegValueSize)

  If ((RegReturnValue = ERROR_SUCCESS) And (RegValueSize > 0)) Then
    RegTempValue = Space(RegValueSize - 1)
  Else
    RegTempValue = Space(1)
  End If
    
 
  RegReturnValue = RegQueryValueEx(hKey, ValueName, 0, RegValType, RegTempValue, LenB(RegTempValue))
  If (RegReturnValue <> ERROR_SUCCESS) Or (RegValType <> REG_SZ) Then GoTo error_handler
    
   regGetRegistrySetting = RegTempValue
  RegReturnValue = RegCloseKey(hKey)
  Exit Function
    
 
error_handler:
  If Not IsMissing(DefaultData) Then
    regGetRegistrySetting = DefaultData
  Else
    regGetRegistrySetting = ""
  End If
    RegReturnValue = RegCloseKey(hKey)
    
End Function
Sub ZoomOpen(f As Form, Cycles As Integer, Optional ZoomEffect As ZoomEffects = 7, _
             Optional ShowMsgForm As Boolean = True)
    
    Dim f_Rect As RECT
    Dim f_Width As Integer
    Dim f_Height As Integer
    Dim I As Integer
    Dim Left As Integer
    Dim Top As Integer
    Dim GrowWidth  As Integer
    Dim GrowHeight As Integer
    Dim Desktop As Long
    Dim Brush As Long
     
    GetWindowRect f.hWnd, f_Rect
    
    f_Width = (f_Rect.Right - f_Rect.Left)
    f_Height = f_Rect.Bottom - f_Rect.Top
    
    Desktop = GetDC(0)
    
    Brush = CreateSolidBrush(GetSysColor(COLOR_ACTIVECAPTION))
    
    Call SelectObject(Desktop, CLng(Brush))
     
    
    For I = 1 To Cycles
    
    
    Select Case ZoomEffect
 

    Case 0 'From Middle
        GrowWidth = f_Width
        GrowHeight = f_Height * (I / Cycles)
        Left = f_Rect.Left
        Top = f_Rect.Top + (f_Height - GrowHeight) / 2
        Rectangle Desktop, Left, Top, Left + GrowWidth, Top + GrowHeight
        
    Case 1 'From Left
        GrowWidth = f_Width * (I / Cycles)
        GrowHeight = f_Height
        Left = f_Rect.Left
        Top = f_Rect.Top + (f_Height - GrowHeight) / 2
        Rectangle Desktop, Left, Top, Left + GrowWidth, Top + GrowHeight
    
    
    Case 2 'From Right
        GrowWidth = f_Width * (I / Cycles)
        GrowHeight = f_Height
        Left = f_Rect.Right
        Top = f_Rect.Top
        Rectangle Desktop, Left, Top, Left - GrowWidth, Top + GrowHeight
      
    Case 3 'From Top Right
        GrowWidth = f_Width * (I / Cycles)
        GrowHeight = f_Height * (I / Cycles)
        Left = f_Rect.Right
        Top = f_Rect.Top
        Rectangle Desktop, Left, Top, Left - GrowWidth, Top + GrowHeight
      
      
    Case 4 'From Bottom Right
        GrowWidth = f_Width * (I / Cycles)
        GrowHeight = f_Height * (I / Cycles)
        Left = f_Rect.Right
        Top = f_Rect.Top + (f_Height - GrowHeight) / 2
        Rectangle Desktop, Left, Top, Left - GrowWidth, Top + GrowHeight
    
    Case 5 'From Bottom Left
    
        GrowWidth = f_Width * (I / Cycles)
        GrowHeight = f_Height * (I / Cycles)
        Left = f_Rect.Left
        Top = f_Rect.Top + (f_Height - GrowHeight) / 2
        Rectangle Desktop, Left, Top, Left + GrowWidth, Top + GrowHeight
    
    Case 6 'From Top Left
        GrowWidth = f_Width * (I / Cycles)
        GrowHeight = f_Height * (I / Cycles)
        Left = f_Rect.Left
        Top = f_Rect.Top
        Rectangle Desktop, Left, Top, Left + GrowWidth, Top + GrowHeight
    
    Case 7 'Explode
        GrowWidth = f_Width * (I / Cycles)
        GrowHeight = f_Height * (I / Cycles)
        Left = f_Rect.Left + (f_Width - GrowWidth) / 2
        Top = f_Rect.Top + (f_Height - GrowHeight) / 2
        Rectangle Desktop, Left, Top, Left + GrowWidth, Top + GrowHeight
            
    Case 8 'From Top
        GrowWidth = f_Width
        GrowHeight = f_Height * (I / Cycles)
        Left = f_Rect.Left
        Top = f_Rect.Top
        Rectangle Desktop, Left, Top, Left + GrowWidth, Top + GrowHeight
    
    Case 9 'From bottom
         GrowWidth = f_Width
         GrowHeight = f_Height * (I / Cycles)
         Left = f_Rect.Left
         Top = f_Rect.Bottom - (f_Height - GrowHeight) / 2
         Rectangle Desktop, Left, Top, Left + GrowWidth, f_Rect.Bottom - GrowHeight
    End Select
    
    Next I
    
    Call ReleaseDC(0, Desktop)
    DeleteObject (Brush)
    DoEvents
    
   
    f.Show
    
    DoEvents
   
    
    If ShowMsgForm = True Then
    'Normal Position
    MsgForm.Top = f.Top - MsgForm.Height - 200
    MsgForm.Left = f.Left + 100
    
    'If Top is less than Screen top
    If MsgForm.Top < 0 Then MsgForm.Top = 0
    
    'If Right side is beyond screen width
    If MsgForm.Left + MsgForm.Width > Screen.Width Then MsgForm.Left = Screen.Width - MsgForm.Width
    
    'If Over the Calling Form
    If MsgForm.Top + MsgForm.Height > f.Top Then
    
    'If Calling form is on the Left half of screen
    If f.Left < Screen.Width / 2 Then
    
    'Move to Right
    MsgForm.Left = f.Left + f.Width + 10
    Else
    
    'Move to left
    MsgForm.Left = f.Left - MsgForm.Width - 10
    
    End If
       
    End If
    
    If MsgForm.Left < 0 Then MsgForm.Left = 0
    
    If MsgForm.Left + MsgForm.Width > Screen.Width Then MsgForm.Left = f.Left - MsgForm.Width - 200
    
    MsgForm.Show
    
    DoEvents
    End If
    
    
 
   
   'Make Assistant Window Look like it has focus
   Call SendMessage(f.hWnd, WM_NCACTIVATE, 1, 1)
 
End Sub