home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Delphi / PolarDraw / data1.cab / Samples / Visual_Basic / VBDraw / PolarDraw.bas < prev    next >
Encoding:
BASIC Source File  |  2001-08-31  |  4.0 KB  |  105 lines
  1. Attribute VB_Name = "PolarDraw"
  2. 'this module contains some functions and declarations needed
  3. 'in this application
  4. 'those are functions for easier manipulation of Polar Draw instance
  5.  
  6. Public pd_Page As POLARDRAW20Lib.Page
  7. Public pd_Environment As POLARDRAW20Lib.Environment
  8. Public pd_Shapes As POLARDRAW20Lib.Shapes
  9. Public pd_Selection As POLARDRAW20Lib.Selection
  10. Public pd_Window As POLARDRAW20Lib.Window
  11. Public pd_HorGuides As POLARDRAW20Lib.Guidelines
  12. Public pd_VertGuides As POLARDRAW20Lib.Guidelines
  13. Public arr_ShapeTypeConstants As Variant
  14. Public arr_ShapeTypeNames As Variant
  15.  
  16. Public Sub SetShapeTypes()
  17.    arr_ShapeTypeConstants = Array(polArc, polDiamond, polDimensionBar, polEllipse, polFreeform, polHexagon, polIsoscelesTriangle, polLeftArrow, polLine, polLink, polOctagon, polParallelogram, polPentagon, polPlainText, polPlusSign, polRectangle, polRightTriangle, polRoundRectangle, polStar, polTextBox, polTrapezoid)
  18.    arr_ShapeTypeNames = Array("Arc", "Diamond", "Dimension Bar", "Ellipse", "Freeform", "Hexagon", "Isosceles Triangle", "Left Arrow", "Line", "Link", "Octagon", "Parallelogram", "Pentagon", "Plain Text", "Plus Sign", "Rectangle", "Right Triangle", "Round Rectangle", "Star", "Text Box", "Trapezoid")
  19.  
  20. End Sub
  21. Public Sub SetEditMode(EditType As polEditMode, TypeOfShape As polShapeType, TypeOfPolygon As polPolygonTypes)
  22.    'This sub sets current edit mode and shape type according to the sent parameters
  23.    'if edit mode isn't CreateNew, TypeOfShape  and TypeOfPolygon must be sent as -1
  24.    If pd_Environment.EditMode = -1 Then Exit Sub
  25.    With pd_Environment
  26.       .EditMode = EditType
  27.       If TypeOfShape <> -1 Then
  28.          .CurrentShapeType = TypeOfShape
  29.          If .CurrentShapeType = polLink Then
  30.             .Root.ShowConnectors = True
  31.          Else
  32.             .Root.ShowConnectors = False
  33.          End If
  34.       End If
  35.       If TypeOfPolygon <> -1 Then .CurrentPolygonType = TypeOfPolygon
  36.    End With
  37.            
  38. End Sub
  39.  
  40. Public Sub FreeObjects()
  41.    Set pd_Page = Nothing
  42.    Set pd_Window = Nothing
  43.    Set pd_Environment = Nothing
  44.    Set pd_Shapes = Nothing
  45.    Set pd_Selection = Nothing
  46.    
  47.    Set pd_HorGuides = Nothing
  48.    Set pd_VertGuides = Nothing
  49. End Sub
  50. Public Sub CreateObjects()
  51.    Set pd_Page = frmDrawVB.POLARDraw1.ActivePage
  52.    Set pd_Window = frmDrawVB.POLARDraw1.ActiveWindow
  53.    Set pd_Environment = frmDrawVB.POLARDraw1.ActiveWindow.Environment
  54.    Set pd_Shapes = pd_Page.Shapes
  55.    Set pd_Selection = pd_Page.Selection
  56.  
  57. End Sub
  58.  
  59. Public Function SelectionExists() As Boolean
  60.    If pd_Selection.ShapeRange Is Nothing Then
  61.       MsgBox "Nothing selected!", vbExclamation, "Warning"
  62.       SelectionExists = False
  63.    Else
  64.       If pd_Selection.ShapeRange.Count < 1 Then
  65.          MsgBox "Nothing selected!", vbExclamation, "Warning"
  66.          SelectionExists = False
  67.       Else
  68.          SelectionExists = True
  69.       End If
  70.    End If
  71. End Function
  72.  
  73. Public Sub SetEnvironment()
  74.     With pd_Environment
  75.         .EditMode = polResize
  76.         .RulerMeasurementUnits = polUnitsMilimeter
  77.         .ShowHorizontalRuler = True
  78.         .ShowHorizontalScrollBar = True
  79.         .ShowVerticalRuler = True
  80.         .ShowVerticalScrollBar = True
  81.         .ShowGrid = True
  82.         .ShowGuidelines = True
  83.     End With
  84.     
  85.     pd_Window.CenterPage
  86.     pd_Environment.Root.MeasurementUnits = polUnitsMilimeter
  87.     pd_Environment.Root.AllowErrorReporting = True
  88.     Set pd_HorGuides = pd_Page.HorGuidelines
  89.     Set pd_VertGuides = pd_Page.VertGuidelines
  90.     pd_HorGuides.Add 0.1 * pd_Page.Height
  91.     pd_HorGuides.Add 0.9 * pd_Page.Height
  92.     pd_VertGuides.Add 0.1 * pd_Page.Width
  93.     pd_VertGuides.Add 0.9 * pd_Page.Width
  94.     SetShapeTypes
  95. End Sub
  96. Function GetShapeType(lShapeID As Long) As Long
  97.    For i = 1 To UBound(arr_ShapeTypeConstants)
  98.       If pd_Shapes.ItemFromID(lShapeID).Type = arr_ShapeTypeConstants(i) Then
  99.          MsgBox arr_ShapeTypeNames(i)
  100.          GetShapeType = arr_ShapeTypeConstants(i)
  101.          Exit Function
  102.       End If
  103.    Next i
  104. End Function
  105.