home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / ENTRPRIS / APE / INCLUDE / CLSPOSFM.CLS next >
Encoding:
Visual Basic class definition  |  1996-12-06  |  11.0 KB  |  226 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "clsPositionForm"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11. '-------------------------------------------------------------------------
  12. 'This class must be used with modPositionForm which supplys
  13. 'declarations, and types
  14. 'This class is intended to be used with any Automation Explorer application
  15. 'for saving form positions in the registry
  16. 'and moving forms back to that position when loaded again
  17. 'If more than one form of the same name is loaded, cascading
  18. 'will occur only in relationship with each other.
  19. 'Use Move method on form_load event
  20. 'Use Save method on form_unload event
  21. 'To use this class with a application that is not
  22. 'apart of the Automation Explorer project change the
  23. 'constant msPROJECT_NAME
  24. '-------------------------------------------------------------------------
  25.  
  26. #If UNICODE Then
  27.     Private Declare Function GetClassName Lib "user32" Alias "GetClassNameW" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  28.     Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextW" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  29. #Else
  30.     Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  31.     Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  32. #End If
  33. Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
  34. Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
  35. Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  36.  
  37. 'Types
  38. Private Type RECT
  39.         Left As Long
  40.         Top As Long
  41.         Right As Long
  42.         Bottom As Long
  43. End Type
  44.  
  45. 'Public Constants
  46. Private Const GW_HWNDNEXT As Integer = 2
  47. Private Const SM_CYBORDER As Integer = 6
  48. Private Const SM_CYCAPTION As Integer = 4
  49. Private Const msPROJECT_NAME As String = "Application Performance Explorer"
  50. Private Const msSECTION_NAME As String = "Form Positions"
  51.  
  52. Public Sub Move(frmNew As Form, bSize As Boolean, Optional sComparableCharacters As String = "", Optional sngDefaultWidth As Single = 0, Optional sngDefaultHeight As Single = 0)
  53.     '-------------------------------------------------------------------------
  54.     'Purpose:   This method moves the passed form to the position saved
  55.     '           in the registry.  It also cascades the forms position from
  56.     '           the first form it finds with the same caption or that contains
  57.     '           vComparableCharachters at the beginning of the caption.
  58.     'IN:
  59.     '   [frmNew]
  60.     '           Form to position
  61.     '   [bSize] If true also size the passed form
  62.     '   [sComparableCharacters]
  63.     '           String to compare to other form captions for cascading instead
  64.     '           of passed forms captions.  If "Client" was passed, forms with
  65.     '           captions "Client - 1", "Client - 2", "Client - N" would be compared
  66.     '-------------------------------------------------------------------------
  67.     Dim sWinName As String  'Window caption
  68.     Dim sWinClass As String 'Window class
  69.     Dim sDefault As String  'Default position of form in string format
  70.     Dim sReturn As String   'Saved positon of form in string format
  71.     Dim lResult As Long
  72.     Dim lHwnd As Long
  73.     Dim tRect As RECT
  74.     Dim lFactor As Long     'Factor for cascading form
  75.     Dim iPos1 As Integer    'Position one in string
  76.     Dim iPos2 As Integer    'Position two in string
  77.     Dim lState As Long      'Window state
  78.     Dim sngLeft As Single
  79.     Dim sngTop As Single
  80.     Dim sngWidth As Single
  81.     Dim sngHeight As Single
  82.     Dim lDefaultX As Long
  83.     Dim lDefaultY As Long
  84.     Dim sngScreenWidth As Single
  85.     On Error Resume Next
  86.     If sComparableCharacters = "" Then sComparableCharacters = Len(frmNew.Caption)
  87.     'Create the default string
  88.     If Not (sngDefaultWidth = 0) Then lDefaultX = sngDefaultWidth Else lDefaultX = giDEFAULT_FORM_WIDTH
  89.     If Not (sngDefaultHeight = 0) Then lDefaultY = sngDefaultHeight Else lDefaultY = giDEFAULT_FORM_HEIGHT
  90.     sDefault = CStr(-1) & "," & CStr(-1) & "," & CStr(lDefaultX) & "," & CStr(lDefaultY) & "," & CStr(vbNormal) & ",1"
  91.     sReturn = GetSetting(msPROJECT_NAME, msSECTION_NAME, frmNew.Name, sDefault)
  92.     'Parse values from returned string "left, top, width, height, state"
  93.     iPos1 = InStr(sReturn, ",")
  94.     sngLeft = CSng(Left$(sReturn, (iPos1 - 1)))
  95.     iPos2 = InStr((iPos1 + 1), sReturn, ",")
  96.     sngTop = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
  97.     iPos1 = iPos2
  98.     iPos2 = InStr((iPos1 + 1), sReturn, ",")
  99.     sngWidth = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
  100.     iPos1 = iPos2
  101.     iPos2 = InStr((iPos1 + 1), sReturn, ",")
  102.     sngHeight = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
  103.     iPos1 = iPos2
  104.     iPos2 = InStr((iPos1 + 1), sReturn, ",")
  105.     lState = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
  106.     sngScreenWidth = CLng(Right$(sReturn, Len(sReturn) - iPos2))
  107.     'If this is not the first instance or if more than one form
  108.     'is loaded find a handle to the next window
  109.     'in the z-order with the same class name and window text
  110.     'move the change the coordinates to one's that represent
  111.     'a cascaded position in relation
  112.     'ship to the next window
  113.     If App.PrevInstance Or Forms.Count > 1 Then
  114.         sWinName = frmNew.Caption
  115.         lHwnd = frmNew.hWnd
  116.         sWinClass = Space$(255)
  117.         lResult = GetClassName(lHwnd, sWinClass, 255)
  118.         sWinClass = Left$(sWinClass, lResult)
  119.         'Perform a loop checking previous windows in z-order
  120.         'until window with same title and class name is found
  121.         'or hwnd = 0
  122.         Do Until lHwnd = 0
  123.             lHwnd = GetWindow(lHwnd, GW_HWNDNEXT)
  124.             'check the window's class name
  125.             sReturn = Space$(255)
  126.             lResult = GetClassName(lHwnd, sReturn, 255)
  127.             sReturn = Left$(sReturn, lResult)
  128.             If sReturn = sWinClass Then
  129.                 'check the window's title
  130.                 sReturn = Space$(255)
  131.                 lResult = GetWindowText(lHwnd, sReturn, 255)
  132.                 sReturn = Left$(sReturn, lResult)
  133.                 If Left$(sReturn, sComparableCharacters) = Left$(sWinName, sComparableCharacters) Then
  134.                     'Get the windows position and calculate
  135.                     'the position for the new window
  136.                     lResult = GetWindowRect(lHwnd, tRect)
  137.                     'Get the system size of title bar and border
  138.                     lFactor = GetSystemMetrics(SM_CYBORDER) + GetSystemMetrics(SM_CYCAPTION)
  139.                     'If cascaded position will not put the form
  140.                     'off the screen change the left and top position
  141.                     'to represent a cascaded position
  142.                     'else leave the coordinates equal to what
  143.                     'was retrieved from the registry
  144.                     If Not ((tRect.Left + lFactor) * Screen.TwipsPerPixelX) + sngWidth > Screen.Width Then sngLeft = (tRect.Left + lFactor) * Screen.TwipsPerPixelX
  145.                     If Not ((tRect.Top + lFactor) * Screen.TwipsPerPixelY) + sngHeight > Screen.Height Then sngTop = (tRect.Top + lFactor) * Screen.TwipsPerPixelY
  146.                     Exit Do
  147.                 End If
  148.             End If
  149.         Loop
  150.     End If
  151.     'If the screen width is less than
  152.     'when form position was saved, do not
  153.     'position form according to saved position,
  154.     'because the saved position and size may be off
  155.     'the screen.  Instead, let form be positioned to windows
  156.     'default.
  157.     If sngScreenWidth <= Screen.Width Then
  158.         'If the passed bSize flag is true
  159.         'size and move, else just move
  160.         If sngTop <> -1 Then frmNew.Top = sngTop
  161.         If sngLeft <> -1 Then frmNew.Left = sngLeft
  162.         If bSize Then
  163.             frmNew.Width = sngWidth
  164.             frmNew.Height = sngHeight
  165.         End If
  166.     Else
  167.         'Apply default width and height
  168.         If bSize Then
  169.             If sngDefaultWidth <> 0 Then frmNew.Width = sngDefaultWidth
  170.             If sngDefaultHeight <> 0 Then frmNew.Height = sngDefaultHeight
  171.         End If
  172.     End If
  173.     frmNew.WindowState = lState
  174. End Sub
  175.  
  176.  
  177. Public Sub Save(frmSave As Form)
  178.     '-------------------------------------------------------------------------
  179.     'Purpose:   This method saves the forms size and position in the registry
  180.     '           using the form name as the label and string format
  181.     '           "left, top, width, height
  182.     'IN:
  183.     '   [frmSave]
  184.     '           Form to save position of
  185.     'Effects:   The Forms position is saved to the registry
  186.     '-------------------------------------------------------------------------
  187.     Dim iPos1 As Integer    'Position one in string
  188.     Dim iPos2 As Integer    'Position two in string
  189.     Dim sngLeft As Single
  190.     Dim sngTop As Single
  191.     Dim sngWidth As Single
  192.     Dim sngHeight As Single
  193.     Dim sDefault As String  'Default position of form in string format
  194.     Dim sReturn As String   'Saved positon of form in string format
  195.     Dim lState As Long
  196.     Dim sngScreenWidth As Single
  197.     If frmSave.WindowState = vbNormal Then
  198.         sReturn = CStr(frmSave.Left) & "," & CStr(frmSave.Top) & "," & CStr(frmSave.Width) & "," & CStr(frmSave.Height) & "," & CStr(frmSave.WindowState) & "," & CStr(Screen.Width)
  199.     Else
  200.         'Read the current settings and then only change the Widowstate value
  201.         'and the screen width
  202.         'Create the default string
  203.         sDefault = CStr(-1) & "," & CStr(-1) & "," & CStr(giDEFAULT_FORM_WIDTH) & "," & CStr(giDEFAULT_FORM_HEIGHT) & "," & CStr(vbNormal) & ",1"
  204.         sReturn = GetSetting(msPROJECT_NAME, msSECTION_NAME, frmSave.Name, sDefault)
  205.         'Parse values from returned string "left, top, width, height, state"
  206.         iPos1 = InStr(sReturn, ",")
  207.         sngLeft = CSng(Left$(sReturn, (iPos1 - 1)))
  208.         iPos2 = InStr((iPos1 + 1), sReturn, ",")
  209.         sngTop = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
  210.         iPos1 = iPos2
  211.         iPos2 = InStr((iPos1 + 1), sReturn, ",")
  212.         sngWidth = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
  213.         iPos1 = iPos2
  214.         iPos2 = InStr((iPos1 + 1), sReturn, ",")
  215.         sngHeight = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
  216.         iPos1 = iPos2
  217.         iPos2 = InStr((iPos1 + 1), sReturn, ",")
  218.         lState = CSng(Mid$(sReturn, (iPos1 + 1), (iPos2 - 1 - iPos1)))
  219.         sngScreenWidth = CLng(Right$(sReturn, Len(sReturn) - iPos2))
  220.         sReturn = CStr(sngLeft) & "," & CStr(sngTop) & "," & CStr(sngWidth) & "," & CStr(sngHeight) & "," & CStr(frmSave.WindowState) & "," & CStr(sngScreenWidth)
  221.     End If
  222.     SaveSetting msPROJECT_NAME, msSECTION_NAME, frmSave.Name, sReturn
  223.     
  224. End Sub
  225.  
  226.