home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dump_s1r / clsborde.cls < prev    next >
Encoding:
Visual Basic class definition  |  1998-12-19  |  2.7 KB  |  81 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "clsBorder"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Dim initBoxStyle As Long
  11. Dim initLeft As Integer
  12. Dim initTop As Integer
  13. Dim initWidth As Integer
  14. Dim initHeight As Integer
  15. '     'windows constants
  16. Const SWP_DRAWFRAME = &H20
  17. Const SWP_NOMOVE = &H2
  18. Const SWP_NOSIZE = &H1
  19. Const SWP_NOZORDER = &H4
  20. Const SWP_FLAGS = SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME
  21. Const GWL_STYLE = (-16)
  22. Const WS_THICKFRAME = &H40000
  23.  
  24. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
  25.        (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  26.  
  27. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  28.        (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  29.  
  30. Private Declare Function SetWindowPos Lib "user32" _
  31.        (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
  32.         ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
  33.         ByVal cy As Long, ByVal wFlags As Long) As Long
  34.         Private Properties As New clsProperties
  35. Public Sub AddResizerToObject(Object As Object)
  36.         Dim style As Long
  37.         Dim SysMenuKillFlag As Integer
  38.         style& = GetWindowLong(Object.hwnd, GWL_STYLE)
  39.         Properties.AddProperty "Style", CStr(Object.Name), style&, Object
  40.         Properties.AddProperty "HasBorder", CStr(Object.Name), "Yes", Object
  41.         style& = style& Or WS_THICKFRAME
  42.         SetControlStyle style&, Object.hwnd, Object.Container.hwnd
  43. End Sub
  44.  
  45. Public Sub RemoveResize(Object As Object)
  46.     If Properties.ReturnProperty(Object.Name, "Style") Is Nothing Then
  47.     Exit Sub
  48.     End If
  49.     SetControlStyle Properties.ReturnProperty(Object.Name, "Style").PValue, Object.hwnd, Object.Parent.hwnd
  50.     Properties.DeleteProperty Object.Name, "Style"
  51.     Properties.DeleteProperty Object.Name, "HasBorder"
  52. End Sub
  53.  
  54. Private Sub SetControlStyle(style&, ObjecthWnd As Long, ParentHwnd As Long)
  55.         Dim r&
  56.         If style& Then
  57.        r& = SetWindowLong(ObjecthWnd, GWL_STYLE, style&)
  58.        r& = SetWindowPos(ObjecthWnd, ParentHwnd, 0, 0, 0, 0, SWP_FLAGS)
  59.         End If
  60. End Sub
  61.  
  62. Public Sub ToggleBorder(Object As Object)
  63. If Properties.ReturnProperty(Object.Name, "HasBorder") Is Nothing Then
  64. AddResizerToObject Object
  65. Else
  66. RemoveResize Object
  67. End If
  68. End Sub
  69.  
  70.  
  71. Public Sub KillAllBorders()
  72. Dim I As Long
  73. For I = 1 To Properties.Count
  74. If Properties.ReturnPByIdx(I) Is Nothing Then Exit For
  75. If Properties.ReturnPByIdx(I).PName = "Style" Then
  76. RemoveResize Properties.ReturnPByIdx(I).ObjectReferense
  77. I = I - 1
  78. End If
  79. Next
  80. End Sub
  81.