home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Programmer'…arterly (Limited Edition) / Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso / code / ch28code / quadrant.bas < prev    next >
Encoding:
BASIC Source File  |  1995-07-31  |  15.6 KB  |  353 lines
  1. Attribute VB_Name = "basQuadrants"
  2. '*********************************************************************
  3. ' QUADRANT.BAS - This is a special rectangle module that performs
  4. '                several rectangle functions.
  5. '*********************************************************************
  6. Option Explicit
  7. '*********************************************************************
  8. ' Expose a new rectangle data type.
  9. '*********************************************************************
  10. #If Win32 Then
  11. Public Type RECT
  12.     rL As Long 'Left
  13.     rT As Long 'Top
  14.     rR As Long 'Right (This is NOT equal to Width)
  15.     rB As Long 'Bottom (This is NOT equal to Height)
  16. End Type
  17. Public Type PointAPI
  18.         X As Long
  19.         Y As Long
  20. End Type
  21. #Else
  22. Public Type RECT
  23.     rL As Integer 'Left
  24.     rT As Integer 'Top
  25.     rR As Integer 'Right (This is NOT equal to Width)
  26.     rB As Integer 'Bottom (This is NOT equal to Height)
  27. End Type
  28. Public Type PointAPI
  29.         X As Integer
  30.         Y As Integer
  31. End Type
  32. #End If
  33. '*********************************************************************
  34. ' API Declarations.
  35. '*********************************************************************
  36. #If Win32 Then
  37. Public Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, _
  38.     lpRect As RECT)
  39. Public Declare Sub InflateRect Lib "user32" (lpRect As RECT, _
  40.     ByVal X As Long, ByVal Y As Long)
  41. Public Declare Function PtInRect Lib "user32" (lpRect As RECT, _
  42.     ByVal ptScreenX As Long, ByVal ptScreenY As Long) As Long
  43. Public Declare Function ClientToScreen Lib "user32" (ByVal hWnd&, _
  44.     lpPoint As PointAPI) As Long
  45. #Else
  46. Public Declare Sub GetClientRect Lib "User" (ByVal hWnd%, _
  47.     lpRect As RECT)
  48. Public Declare Sub InflateRect Lib "User" (lpRect As RECT, _
  49.     ByVal iX%, ByVal iY%)
  50. Public Declare Sub ClientToScreen Lib "User" (ByVal hWnd%, _
  51.     lpPoint As PointAPI)
  52. Public Declare Function PtInRect Lib "User" (lpRect As RECT, _
  53.     ByVal ptScreenY As Integer, ByVal ptScreenX As Integer) As Integer
  54. '    ptRect As PointAPI) As Integer
  55. #End If
  56. '*********************************************************************
  57. ' Private Module Variables
  58. '*********************************************************************
  59. Private Quad1 As RECT, Quad2 As RECT, Quad3 As RECT, Quad4 As RECT
  60. '*********************************************************************
  61. ' Divides a form into 4 quadrants, starting with the upper left
  62. ' corner (Q1), and continuing clockwise.
  63. '*********************************************************************
  64. Public Sub GetQuadrants(FormName As Form, Q1 As RECT, Q2 As RECT, _
  65.                         Q3 As RECT, Q4 As RECT)
  66. Dim FormWidth%, FormHeight%
  67.     '*****************************************************************
  68.     ' The form ScaleMode MUST be in pixels!
  69.     '*****************************************************************
  70.     FormName.ScaleMode = vbPixels
  71.     '*****************************************************************
  72.     ' Determine the height & width of the forms client area.
  73.     '*****************************************************************
  74.     FormWidth = FormName.ScaleWidth
  75.     FormHeight = FormName.ScaleHeight
  76.     '*****************************************************************
  77.     ' Set the 4 quad arguments and the module level quads.
  78.     '*****************************************************************
  79.     With Quad1
  80.         .rL = 0
  81.         .rT = 0
  82.         .rR = FormWidth / 2
  83.         .rB = FormHeight / 2
  84.     End With
  85.     
  86.     Q1 = Quad1
  87.     
  88.     With Quad2
  89.         .rL = FormWidth / 2
  90.         .rT = 0
  91.         .rR = FormWidth - 1
  92.         .rB = FormHeight / 2
  93.     End With
  94.     
  95.     Q2 = Quad2
  96.     
  97.     With Quad3
  98.         .rL = 0
  99.         .rT = FormHeight / 2
  100.         .rR = FormWidth / 2
  101.         .rB = FormHeight - 1
  102.     End With
  103.     
  104.     Q3 = Quad3
  105.     
  106.     With Quad4
  107.         .rL = FormWidth / 2
  108.         .rT = FormHeight / 2
  109.         .rR = FormWidth - 1
  110.         .rB = FormHeight - 1
  111.     End With
  112.     
  113.     Q4 = Quad4
  114. End Sub
  115. '*********************************************************************
  116. ' Draw either a solid or hollow rectangle on a form.
  117. '*********************************************************************
  118. Public Sub DrawRect(FormName As Form, rRect As RECT, _
  119.                     Solid As Boolean, Optional RectColor)
  120.     '*****************************************************************
  121.     ' If no color is provided, then use black.
  122.     '*****************************************************************
  123.     RectColor = IIf(IsMissing(RectColor), RGB(0, 0, 0), RectColor)
  124.     '*****************************************************************
  125.     ' Draw the rectangle on the form.
  126.     '*****************************************************************
  127.     If Solid Then
  128.         FormName.Line (rRect.rL, rRect.rT)-(rRect.rR, rRect.rB), _
  129.                                                      RectColor, BF
  130.     Else
  131.         FormName.Line (rRect.rL, rRect.rT)-(rRect.rR, rRect.rB), _
  132.                                                      RectColor, B
  133.     End If
  134. End Sub
  135. '*********************************************************************
  136. ' Draw a hollow 3D rectangle. (Similar to the SSPanel3D control.)
  137. '*********************************************************************
  138. Public Sub Draw3DRect(FormName As Form, rRect As RECT, Inset As Boolean)
  139. Dim LT&, BR&
  140.     '*****************************************************************
  141.     ' Set the L(eft)T(op) and B(ottom)R(ight) line colors.
  142.     '*****************************************************************
  143.     LT = IIf(Inset, vb3DShadow, vb3DHighlight)
  144.     BR = IIf(Inset, vb3DHighlight, vb3DShadow)
  145.     '*****************************************************************
  146.     ' Draw the 4 lines.
  147.     '*****************************************************************
  148.     FormName.Line (rRect.rL, rRect.rT)-(rRect.rL, rRect.rB), LT
  149.     FormName.Line (rRect.rL, rRect.rT)-(rRect.rR, rRect.rT), LT
  150.     FormName.Line (rRect.rR, rRect.rT)-(rRect.rR, rRect.rB), BR
  151.     FormName.Line (rRect.rL, rRect.rB)-(rRect.rR + 1, rRect.rB), BR
  152. End Sub
  153. '*********************************************************************
  154. ' Draw a hollow 3D rectangle. (Similar to the SSPanel3D control.)
  155. '*********************************************************************
  156. Public Sub Draw3DPBRect(pBox As PictureBox, rRect As RECT, Inset As Boolean)
  157. Dim LT&, BR&
  158.     '*****************************************************************
  159.     ' Set the L(eft)T(op) and B(ottom)R(ight) line colors.
  160.     '*****************************************************************
  161.     LT = IIf(Inset, vb3DShadow, vb3DHighlight)
  162.     BR = IIf(Inset, vb3DHighlight, vb3DShadow)
  163.     '*****************************************************************
  164.     ' Draw the 4 lines.
  165.     '*****************************************************************
  166.     pBox.Line (rRect.rL, rRect.rT)-(rRect.rL, rRect.rB), LT
  167.     pBox.Line (rRect.rL, rRect.rT)-(rRect.rR, rRect.rT), LT
  168.     pBox.Line (rRect.rR, rRect.rT)-(rRect.rR, rRect.rB), BR
  169.     pBox.Line (rRect.rL, rRect.rB)-(rRect.rR + 1, rRect.rB), BR
  170. End Sub
  171. '*********************************************************************
  172. ' Draw a hollow 3D rectangle around the edge of the picture box.
  173. '*********************************************************************
  174. Public Sub Draw3DPicBorder(pBox As PictureBox, Inset As Boolean)
  175. Dim rRect As RECT
  176.     '*****************************************************************
  177.     ' Get the client rect of the form.
  178.     '*****************************************************************
  179.     GetClientRect pBox.hWnd, rRect
  180.     '*****************************************************************
  181.     ' Deflate the right & bottom of the rect by 1 pixel.
  182.     '*****************************************************************
  183.     ResizeRect rRect, -1, -1, True
  184.     '*****************************************************************
  185.     ' Draw the 3D rect, and repeat again.
  186.     '*****************************************************************
  187.     Draw3DPBRect pBox, rRect, Inset
  188.     ResizeRect rRect, -1, -1, False
  189.     Draw3DPBRect pBox, rRect, Inset
  190. End Sub
  191. '*********************************************************************
  192. ' Draw a hollow 3D rectangle around the edge of the form.
  193. '*********************************************************************
  194. Public Sub Draw3DFormRect(FormName As Form, Inset As Boolean)
  195. Dim rRect As RECT
  196.     '*****************************************************************
  197.     ' Get the client rect of the form.
  198.     '*****************************************************************
  199.     GetClientRect FormName.hWnd, rRect
  200.     '*****************************************************************
  201.     ' Deflate the right & bottom of the rect by 1 pixel.
  202.     '*****************************************************************
  203.     ResizeRect rRect, -1, -1, True
  204.     '*****************************************************************
  205.     ' Draw the 3D rect.
  206.     '*****************************************************************
  207.     Draw3DRect FormName, rRect, Inset
  208. End Sub
  209. '*********************************************************************
  210. ' Inflates or Deflates a rectangle from all sides or the bottom.
  211. '*********************************************************************
  212. Public Sub ResizeRect(rRect As RECT, iX%, iY%, KeepSameLT As Boolean)
  213.     '*****************************************************************
  214.     ' If KeepSameL(eft)T(op), then only operate on .rR & .rB.
  215.     '*****************************************************************
  216.     If KeepSameLT Then
  217.         rRect.rR = rRect.rR + iX
  218.         rRect.rB = rRect.rB + iY
  219.     '*****************************************************************
  220.     ' Otherwise inflate or deflate all 4 sides.
  221.     '*****************************************************************
  222.     Else
  223.         InflateRect rRect, iX, iY
  224.     End If
  225. End Sub
  226. '*********************************************************************
  227. ' Changes the left & top values of a rectangle.
  228. '*********************************************************************
  229. Public Sub MoveRect(rRect As RECT, ByVal iX%, ByVal iY%)
  230.     rRect.rL = rRect.rL + iX
  231.     rRect.rT = rRect.rT + iY
  232. End Sub
  233. '*********************************************************************
  234. ' Draws a 3D grid on a form with 4 child quadrants.
  235. '*********************************************************************
  236. Public Sub Draw3DGrid(FormName As Form, Inset As Boolean, _
  237.                       Optional ByVal Offset)
  238. Dim InsideOffset%, OutsideOffset%
  239.     '*****************************************************************
  240.     ' Set the offset values.
  241.     '*****************************************************************
  242.     On Error Resume Next
  243.     Offset = IIf(IsMissing(Offset), 10, Offset)
  244.     InsideOffset = Offset
  245.     OutsideOffset = Abs(IIf(IsMissing(Offset), 5, (Offset / 2)) - 1)
  246.     '*****************************************************************
  247.     ' This is a bit redundant, but its necessary.
  248.     '*****************************************************************
  249.     GetQuadrants FormName, Quad1, Quad2, Quad3, Quad4
  250.     '*****************************************************************
  251.     ' Draw the 4 3D quadrants.
  252.     '*****************************************************************
  253.     MoveRect Quad1, InsideOffset + 1, InsideOffset + 1
  254.     ResizeRect Quad1, -InsideOffset, -InsideOffset, True
  255.     Draw3DRect FormName, Quad1, Inset
  256.     
  257.     MoveRect Quad2, OutsideOffset, InsideOffset + 1
  258.     ResizeRect Quad2, -InsideOffset - 1, -InsideOffset, True
  259.     Draw3DRect FormName, Quad2, Inset
  260.     
  261.     MoveRect Quad3, InsideOffset + 1, OutsideOffset
  262.     ResizeRect Quad3, -InsideOffset, -InsideOffset, True
  263.     Draw3DRect FormName, Quad3, Inset
  264.     
  265.     MoveRect Quad4, OutsideOffset, OutsideOffset
  266.     ResizeRect Quad4, -InsideOffset - 1, -InsideOffset, True
  267.     Draw3DRect FormName, Quad4, Inset
  268.     '*****************************************************************
  269.     ' Draw a 3D border around the form.
  270.     '*****************************************************************
  271.     Draw3DFormRect FormName, False
  272. End Sub
  273. '*********************************************************************
  274. ' Set a given RECT (Quad) to the value of a quadrant.
  275. '*********************************************************************
  276. Public Sub GetQuad(Quadrant%, Quad As RECT)
  277.     Select Case Quadrant
  278.         Case 1
  279.             Quad = Quad1
  280.         Case 2
  281.             Quad = Quad2
  282.         Case 3
  283.             Quad = Quad3
  284.         Case 4
  285.             Quad = Quad4
  286.     End Select
  287. End Sub
  288. '*********************************************************************
  289. ' Get the Width & Height of a rectangle.
  290. '*********************************************************************
  291. Public Function GetRectWidth(rRect As RECT) As Integer
  292.     GetRectWidth = rRect.rR - rRect.rL
  293. End Function
  294.  
  295. Public Function GetRectHeight(rRect As RECT) As Integer
  296.     GetRectHeight = rRect.rB - rRect.rT
  297. End Function
  298. '*********************************************************************
  299. ' Size a control into the client area of a rectangle.
  300. '*********************************************************************
  301. Public Sub SizeToRectClient(Cntl As Control, rSourceRect As RECT)
  302. Dim rRect As RECT
  303.     rRect = rSourceRect
  304.     ResizeRect rRect, -1, -1, False
  305.     Cntl.Move rRect.rL, rRect.rT, GetRectWidth(rRect), _
  306.                                  GetRectHeight(rRect)
  307. End Sub
  308. '*********************************************************************
  309. ' Check to see if a control is equal to the client area of a rect.
  310. '*********************************************************************
  311. Public Function EqualToQuadClient(Cntl As Control, _
  312.                                   rSourceRect As RECT) As Boolean
  313. Dim rRect As RECT
  314.     '*****************************************************************
  315.     ' Since you can't pass rects by value, then create a new copy.
  316.     '*****************************************************************
  317.     rRect = rSourceRect
  318.     '*****************************************************************
  319.     ' Resize the copy.
  320.     '*****************************************************************
  321.     ResizeRect rRect, -1, -1, False
  322.     '*****************************************************************
  323.     ' If any are true, then return false.
  324.     '*****************************************************************
  325.     If Cntl.left <> rRect.rL Then GoSub ReturnFalse
  326.     If Cntl.top <> rRect.rT Then GoSub ReturnFalse
  327.     If Cntl.Width <> GetRectWidth(rRect) Then GoSub ReturnFalse
  328.     If Cntl.Height <> GetRectHeight(rRect) Then GoSub ReturnFalse
  329.     '*****************************************************************
  330.     ' If you got this far, then they are indeed equal.
  331.     '*****************************************************************
  332.     EqualToQuadClient = True
  333.     Exit Function
  334. '*********************************************************************
  335. ' Save yourself some typing by using a GoSub to here.
  336. '*********************************************************************
  337. ReturnFalse:
  338.     EqualToQuadClient = False
  339.     Exit Function
  340. End Function
  341. '*********************************************************************
  342. ' Converts a rectangle to screen coordinates.
  343. '*********************************************************************
  344. Public Sub ConvertRectToScreen(FormName As Form, rSourceRect As RECT)
  345. Dim ptLT As PointAPI, ptRB As PointAPI
  346.     ptLT.X = rSourceRect.rL
  347.     ptLT.Y = rSourceRect.rT
  348.     ptRB.X = rSourceRect.rR
  349.     ptRB.Y = rSourceRect.rB
  350.     ClientToScreen FormName.hWnd, ptLT
  351.     ClientToScreen FormName.hWnd, ptRB
  352. End Sub
  353.