home *** CD-ROM | disk | FTP | other *** search
/ PC Open 19 / pcopen19.iso / Imag / IMAGINE / CUSTOM.Z / UDLSTYLE.BAS < prev    next >
Encoding:
BASIC Source File  |  1997-04-13  |  4.5 KB  |  147 lines
  1. Attribute VB_Name = "basUDLStyle"
  2. Option Explicit
  3. '
  4. ' This is the main module for the macro project.  It includes constants and Windows API
  5. ' declarations needed for the macro.
  6. '
  7.  
  8. Public Const MillimetersToMeters = 1 / 1000
  9. Public Const InchesToMeters = 1 / 39.37
  10.  
  11. '
  12. ' Declare the rectangle type for use in GetWindowRect
  13. '
  14. Type RectType
  15.     iLeft As Long
  16.     iTop As Long
  17.     iright As Long
  18.     ibottom As Long
  19. End Type
  20. '
  21. ' Declare the Windows function that allows us to center a form either on the screen
  22. ' or within the application.
  23. '
  24. Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RectType) As Long
  25. '
  26. ' Declare a public array to hold Line Segments and Gaps
  27. '
  28. Public garrDash() As Double
  29. Public garrDist() As Double
  30. Public glngCurrentColor As Long
  31. Public gobjDocument As Object
  32. Public gobjSymbol As Object
  33. Public gdblSymbolLength As Double
  34. Public gvntConversionFactor As Variant
  35.  
  36.  
  37.  
  38. '
  39. ' This is the main function for the macro.
  40. '
  41. Sub main()
  42. End Sub
  43. '
  44. ' This function centers a form either on the screen if the hWndParent is 0 or within
  45. ' the parent.  Copied from VBProgrammers Journal OCT 95 and modified for our needs.
  46. '
  47. Sub CenterForm(ByVal hWndParent As Long, frmForm As Form)
  48.  
  49.     Dim iLeft As Long
  50.     Dim iTop As Long
  51.     Dim iMidX As Long
  52.     Dim iMidY As Long
  53.     Dim rcParent As RectType
  54.  
  55.     'Find the ideal center point
  56.     If hWndParent = 0 Then
  57.         ' No parent, center over the screen using the screen object
  58.         iMidX = Screen.Width / 2
  59.         iMidY = Screen.Height / 2
  60.     Else
  61.         ' Center within the form's parent
  62.         Call GetWindowRect(hWndParent, rcParent)
  63.  
  64.         ' in calculating mid x it seems to me that we should left*twipsX and right*twipsX
  65.         ' rather than right*twipsY
  66.         iMidX = ((rcParent.iLeft * Screen.TwipsPerPixelX) + _
  67.                  (rcParent.iright * Screen.TwipsPerPixelY)) / 2
  68.         iMidY = ((rcParent.iTop * Screen.TwipsPerPixelY) + _
  69.                  (rcParent.ibottom * Screen.TwipsPerPixelY)) / 2
  70.  
  71.         ' If the application is maximized or the app for some reason returns all 0 in the
  72.         ' rectangle type, then center on the screen
  73.         If (rcParent.iLeft = 0 And rcParent.iright = 0 And _
  74.             rcParent.iTop = 0 And rcParent.ibottom = 0) Then
  75.             iMidX = Screen.Width / 2
  76.             iMidY = Screen.Height / 2
  77.         End If
  78.     End If
  79.  
  80.  
  81.     ' Find the form's upper left based on that
  82.     iLeft = iMidX - (frmForm.Width / 2)
  83.     iTop = iMidY - (frmForm.Height / 2)
  84.  
  85.     ' If the form is outside the screen, move it inside
  86.     If iLeft < 0 Then
  87.         iLeft = 0
  88.     ElseIf (iLeft + frmForm.Width) > Screen.Width Then
  89.         iLeft = Screen.Width - frmForm.Width
  90.     End If
  91.  
  92.     If iTop < 0 Then
  93.         iTop = 0
  94.     ElseIf (iTop + frmForm.Height) > Screen.Height Then
  95.         iTop = Screen.Height - frmForm.Height
  96.     End If
  97.  
  98.     ' Move the form to its new position
  99.     frmForm.Move iLeft, iTop
  100. End Sub
  101. Function SetDashArray() As String
  102.     Dim i As Integer
  103.     Dim dblMeters As Double
  104.     
  105.     'This sub routine creates a Public array reflecting the measurements of
  106.     'the dashes and gaps created with scrollbars.  Measurements are read from
  107.     'text boxes that accompany the scroll bars.
  108.     
  109.     SetDashArray = "Success"
  110.     For i = 0 To 7
  111.         If frmUDLStyle.Text(i).Text <> 0 Then
  112.             ReDim Preserve garrDash(i + 1)
  113.             dblMeters = CDbl(frmUDLStyle.Text(i).Text) * gvntConversionFactor
  114.             garrDash(i) = dblMeters
  115.             Debug.Print "value " & i & " is " & garrDash(i)
  116.  
  117.         Else
  118.             If i = 0 Then
  119.                 SetDashArray = "Failure"
  120.             End If
  121.             Exit Function
  122.         End If
  123.     Next i
  124.     
  125.   
  126. End Function
  127. Sub SetDistArray()
  128.     Dim i As Integer
  129.     Dim intCount As Integer
  130.     Dim dblMeters As Double
  131.     
  132.     'This sub routine creates a Public array reflecting the distances of
  133.     'the symbols created with scrollbars.  Measurements are read from
  134.     'text boxes that accompany the scroll bars.
  135.     For i = 8 To 11
  136.         If frmUDLStyle.Text(i).Text <> 0 Then
  137.             ReDim Preserve garrDist(intCount + 1)
  138.             dblMeters = CDbl(frmUDLStyle.Text(i).Text) * gvntConversionFactor
  139.             garrDist(intCount) = dblMeters
  140.             Debug.Print "distance " & intCount & " is " & garrDist(intCount)
  141.         Else
  142.             Exit Sub
  143.         End If
  144.         intCount = intCount + 1
  145.     Next i
  146. End Sub
  147.