home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD138641172001.psc / SplitBox.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-01-17  |  15.4 KB  |  357 lines
  1. VERSION 5.00
  2. Begin VB.UserControl SplitBox 
  3.    Alignable       =   -1  'True
  4.    ClientHeight    =   3600
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   4800
  8.    ControlContainer=   -1  'True
  9.    ScaleHeight     =   240
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   320
  12.    Begin VB.Timer timResize 
  13.       Enabled         =   0   'False
  14.       Interval        =   10
  15.       Left            =   3660
  16.       Top             =   2985
  17.    End
  18.    Begin VB.Timer timCheck 
  19.       Interval        =   100
  20.       Left            =   4155
  21.       Top             =   2985
  22.    End
  23.    Begin VB.PictureBox picHandle 
  24.       AutoRedraw      =   -1  'True
  25.       BorderStyle     =   0  'None
  26.       Height          =   165
  27.       Left            =   780
  28.       MousePointer    =   9  'Size W E
  29.       ScaleHeight     =   165
  30.       ScaleWidth      =   1590
  31.       TabIndex        =   0
  32.       Top             =   75
  33.       Width           =   1590
  34.    End
  35. Attribute VB_Name = "SplitBox"
  36. Attribute VB_GlobalNameSpace = False
  37. Attribute VB_Creatable = True
  38. Attribute VB_PredeclaredId = False
  39. Attribute VB_Exposed = True
  40. Private pMinWidth As Long
  41. Private pMaxWidth As Long
  42. 'Event Declarations:
  43. Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
  44. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  45. Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
  46. Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
  47. Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown
  48. Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
  49. Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress
  50. Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
  51. Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
  52. Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
  53. Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
  54. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
  55. Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
  56. Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
  57. Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
  58. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
  59. Event Resize() 'MappingInfo=UserControl,UserControl,-1,Resize
  60. Attribute Resize.VB_Description = "Occurs when a form is first displayed or the size of an object changes."
  61. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  62. 'MappingInfo=UserControl,UserControl,-1,BackColor
  63. Public Property Get BackColor() As OLE_COLOR
  64. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  65.     BackColor = UserControl.BackColor
  66. End Property
  67. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  68.     UserControl.BackColor() = New_BackColor
  69.     PropertyChanged "BackColor"
  70. End Property
  71. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  72. 'MappingInfo=UserControl,UserControl,-1,Enabled
  73. Public Property Get Enabled() As Boolean
  74. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  75.     Enabled = UserControl.Enabled
  76. End Property
  77. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  78.     UserControl.Enabled() = New_Enabled
  79.     PropertyChanged "Enabled"
  80. End Property
  81. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  82. 'MappingInfo=UserControl,UserControl,-1,BorderStyle
  83. Public Property Get BorderStyle() As Integer
  84. Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
  85.     BorderStyle = UserControl.BorderStyle
  86. End Property
  87. Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
  88.     UserControl.BorderStyle() = New_BorderStyle
  89.     PropertyChanged "BorderStyle"
  90. End Property
  91. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  92. 'MappingInfo=UserControl,UserControl,-1,Refresh
  93. Public Sub Refresh()
  94. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  95.     UserControl.Refresh
  96. End Sub
  97. Private Sub timCheck_Timer()
  98. '*' Check the current alignment state of the Control Instance.
  99. Static LastState As Integer     '*' Static to check last value in this Sub
  100. '*' Only evaluate if the alinment has changed.
  101. If LastState = UserControl.Extender.Align Then
  102.     Exit Sub
  103.     LastState = UserControl.Extender.Align
  104. End If
  105. '*' Display based upon the current alignment.
  106. Select Case UserControl.Extender.Align
  107. Case 0      '*' None
  108.     SetUpNone
  109. Case 1      '*' Top
  110.     SetUpTop
  111. Case 2      '*' Bottom
  112.     SetUpBottom
  113. Case 3      '*' Left
  114.     SetUpLeft
  115. Case 4      '*' Right
  116.     SetUpRight
  117. End Select
  118. End Sub
  119. Private Sub UserControl_Click()
  120.     RaiseEvent Click
  121. End Sub
  122. Private Sub UserControl_DblClick()
  123.     RaiseEvent DblClick
  124. End Sub
  125. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  126.     RaiseEvent KeyDown(KeyCode, Shift)
  127. End Sub
  128. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  129.     RaiseEvent KeyPress(KeyAscii)
  130. End Sub
  131. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  132.     RaiseEvent KeyUp(KeyCode, Shift)
  133. End Sub
  134. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  135.     RaiseEvent MouseDown(Button, Shift, x, y)
  136. End Sub
  137. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  138.     RaiseEvent MouseMove(Button, Shift, x, y)
  139. End Sub
  140. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  141.     RaiseEvent MouseUp(Button, Shift, x, y)
  142. End Sub
  143. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  144. 'MappingInfo=UserControl,UserControl,-1,AutoRedraw
  145. Public Property Get AutoRedraw() As Boolean
  146. Attribute AutoRedraw.VB_Description = "Returns/sets the output from a graphics method to a persistent bitmap."
  147.     AutoRedraw = UserControl.AutoRedraw
  148. End Property
  149. Public Property Let AutoRedraw(ByVal New_AutoRedraw As Boolean)
  150.     UserControl.AutoRedraw() = New_AutoRedraw
  151.     PropertyChanged "AutoRedraw"
  152. End Property
  153. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  154. 'MappingInfo=UserControl,UserControl,-1,hWnd
  155. Public Property Get hwnd() As Long
  156. Attribute hwnd.VB_Description = "Returns a handle (from Microsoft Windows) to an object's window."
  157.     hwnd = UserControl.hwnd
  158. End Property
  159. Private Sub UserControl_Resize()
  160.     RaiseEvent Resize
  161. timCheck.Enabled = UserControl.Ambient.UserMode
  162. '*' Once again, resizing is dependant upon the alignment of the Control.
  163. Select Case UserControl.Extender.Align
  164. Case 0      '*' None
  165.     SetUpNone
  166. Case 1      '*' Top
  167.     SetUpTop
  168. Case 2      '*' Bottom
  169.     SetUpBottom
  170. Case 3      '*' Left
  171.     SetUpLeft
  172. Case 4      '*' Right
  173.     SetUpRight
  174. End Select
  175. End Sub
  176. 'Load property values from storage
  177. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  178.     UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
  179.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  180.     UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
  181.     UserControl.AutoRedraw = PropBag.ReadProperty("AutoRedraw", False)
  182. End Sub
  183. 'Write property values to storage
  184. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  185.     Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
  186.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  187.     Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
  188.     Call PropBag.WriteProperty("AutoRedraw", UserControl.AutoRedraw, False)
  189. End Sub
  190. Private Sub SetUpTop()
  191.     '*' Arrange control if it is on the top of the MDI Form.
  192.     '*'
  193.     '*' Set the pointer to NS Resize
  194.     '*'
  195.     picHandle.MousePointer = 7
  196.     '*' Move into bottom left area of control
  197.     '*'
  198.     picHandle.Left = 0
  199.     picHandle.Top = UserControl.ScaleHeight - (150 * (UserControl.ScaleHeight / UserControl.Height))
  200.     '*' Render the size of the hidden picture box that controls the resize.
  201.     '*'
  202.     picHandle.Height = 150 * (UserControl.ScaleHeight / UserControl.Height)
  203.     picHandle.Width = UserControl.Width
  204. End Sub
  205. Private Sub SetUpBottom()
  206.     '*' Arrange control if it is on the top of the MDI Form.
  207.     '*'
  208.     '*' Set the pointer to NS Resize
  209.     '*'
  210.     picHandle.MousePointer = 7
  211.     '*' Move into top left area of control
  212.     '*'
  213.     picHandle.Left = 0
  214.     picHandle.Top = 0
  215.     '*' Render the size of the hidden picture box that controls the resize.
  216.     '*'
  217.     picHandle.Height = 150 * (UserControl.ScaleHeight / UserControl.Height)
  218.     picHandle.Width = UserControl.Width
  219. End Sub
  220. Private Sub SetUpLeft()
  221.     '*' Arrange control if it is on the top of the MDI Form.
  222.     '*'
  223.     '*' Set the pointer to EW Resize
  224.     '*'
  225.     picHandle.MousePointer = 9
  226.     '*' Move into the top right area of control
  227.     '*'
  228.     picHandle.Left = UserControl.ScaleWidth - (150 * (UserControl.ScaleWidth / UserControl.Width))
  229.     picHandle.Top = 0
  230.     '*' Render the size of the hidden picture box that controls the resize.
  231.     '*'
  232.     picHandle.Width = 150 * (UserControl.ScaleWidth / UserControl.Width)
  233.     picHandle.Height = UserControl.Height
  234. End Sub
  235. Private Sub SetUpRight()
  236.     '*' Arrange control if it is on the top of the MDI Form.
  237.     '*'
  238.     '*' Set the pointer to EW Resize
  239.     '*'
  240.     picHandle.MousePointer = 9
  241.     '*' Move into the top left area of the control.
  242.     '*'
  243.     picHandle.Left = 0
  244.     picHandle.Top = 0
  245.     '*' Render the size of the hidden picture box that controls the resize.
  246.     '*'
  247.     picHandle.Width = 150 * (UserControl.ScaleWidth / UserControl.Width)
  248.     picHandle.Height = UserControl.Height
  249. End Sub
  250. Private Sub SetUpNone()
  251.     '*' There is no allowance for no alignment, refer to the right alignment.
  252.     '*'
  253.     SetUpRight
  254. End Sub
  255. Private Sub picHandle_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  256. '*' The MouseDown event in the picHandle object is the trigger that will allow the tracking
  257. '*' of the mouse position to begin.  All of the calculations are done in a timer to allow
  258. '*' for the repetative and constant tracking of the mouse position and object sizes.
  259. timResize.Enabled = True
  260. End Sub
  261. Private Sub picHandle_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  262. '*' The MouseUp event kills the trigger that was set on the MouseDown event.  This will mean
  263. '*' that the user has release the mouse button and does not wish to resize the split plane
  264. '*' any further.
  265. timResize.Enabled = False
  266. End Sub
  267. Private Sub timResize_Timer()
  268. Dim MinWidth As Long            '*' Minimum Width of the Split Plane
  269. Dim MaxWidth As Long            '*' Maximum Width of the Split Plane
  270. Dim intCalc As Long             '*' Calculated value of the width of the Split Plane
  271. Dim CurrentX As Long            '*' Current XValue of the Mouse
  272. Dim CurrentY As Long            '*' Current YValue of the Mouse
  273. Static LastMousePosX As Long    '*' Static Variable to Track the Mouse's Last Known Position
  274. Static LastMousePosY As Long
  275. '*' Get the current value of the X and Y based upon the location of the mouse.
  276. CurrentX = GetX
  277. CurrentY = GetY
  278. '*' The minimum and maximum width of the splitter plane can be set to either an absolute value
  279. '*' or to an equation (Future).  Values are represented in Twips.
  280. MinWidth = 150                                    '*' On some machines, smaller values cause jumpiness.
  281. MaxWidth = (UserControl.Parent.Width / 2) - 150   '*' Limit the maximum to be one half of the form's size.
  282. MinHeight = 150
  283. MaxHeight = (UserControl.Parent.Height / 2) - 150
  284. '*' Equation for Determining the width of the PictureBox (Solve for i)
  285. '*' Note: This equation is for the right hand box alignment only.  Varies for other
  286. '*'       alignments.
  287. '*' Mx = Left of the MDI Form
  288. '*' Px = Left of the Mouse Pointer
  289. '*' S = Scale (Width/ScaleWidth)
  290. '*' Mw = Width of the MDI Form
  291. '*' i = Mx - (Px * S) + Mw
  292. '*' Yields: Anticipated width of the Split Plane
  293. Select Case UserControl.Extender.Align
  294.     Case 1      '*' Top
  295.         '*' Because of the titlebar and possible menus, we can not refer to the top of the
  296.         '*' form, since it might be off by a few hundred twips.  We need to create a RECT and
  297.         '*' store the value of a GetWindowRect API Call to return the top of the control.
  298.         '*'
  299.         Dim rctUser As RECT
  300.         
  301.         '*' Get the bounding box of the control
  302.         '*'
  303.         r = GetWindowRect(UserControl.hwnd, rctUser)
  304.         
  305.         '*' Calculate proposed height
  306.         '*'
  307.         intCalc = (CurrentY * (UserControl.Width / UserControl.ScaleWidth)) - (rctUser.Top * (UserControl.Width / UserControl.ScaleWidth))
  308.         '*' Bounds Checking
  309.         If intCalc <= MinHeight Then
  310.             intCalc = MinHeight
  311.         ElseIf intCalc >= MaxHeight Then
  312.             intCalc = MaxHeight
  313.         End If
  314.         '*' Set the height of the Split Plane to be equal to that of the value for the equation.
  315.         '*'
  316.         UserControl.Height = intCalc
  317.     Case 2      '*' Bottom
  318.         '*' Calculate proposed height
  319.         '*'
  320.         intCalc = UserControl.Parent.Top - (CurrentY * (UserControl.Width / UserControl.ScaleWidth)) + UserControl.Parent.Height
  321.         '*' Bounds Checking
  322.         '*'
  323.         If intCalc <= MinHeight Then
  324.             intCalc = MinHeight
  325.         ElseIf intCalc >= MaxHeight Then
  326.             intCalc = MaxHeight
  327.         End If
  328.         '*' Set the height of the Split Plane to be equal to that
  329.         UserControl.Height = intCalc
  330.     Case 3      '*' Left
  331.         '*' Calculate the proposed width
  332.         '*'
  333.         intCalc = (CurrentX * (UserControl.Width / UserControl.ScaleWidth)) - UserControl.Parent.Left
  334.         '*' Bounds Checking
  335.         If intCalc <= MinWidth Then
  336.             intCalc = MinWidth
  337.         ElseIf intCalc >= MaxWidth Then
  338.             intCalc = MaxWidth
  339.         End If
  340.         '*' Set the width of the Split Plane to be equal to that
  341.         UserControl.Width = intCalc
  342.     Case 4      '*' Right
  343.         '*' Calculate the proposed width
  344.         '*'
  345.         intCalc = UserControl.Parent.Left - (CurrentX * (UserControl.Width / UserControl.ScaleWidth)) + UserControl.Parent.Width
  346.         '*' Bounds Checking
  347.         '*'
  348.         If intCalc <= MinWidth Then
  349.             intCalc = MinWidth
  350.         ElseIf intCalc >= MaxWidth Then
  351.             intCalc = MaxWidth
  352.         End If
  353.         '*' Set the width of the Split Plane to be equal to that
  354.         UserControl.Width = intCalc
  355. End Select
  356. End Sub
  357.