home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 April / CMCD0404.ISO / Software / Demo / conceptdraw / data1.cab / Libraries__Project_Management / Project_Management / GanttChartTL.cdb < prev    next >
Encoding:
Text File  |  2004-02-13  |  5.1 KB  |  143 lines
  1. ' ---------------------------------------------------------------------------
  2. Function SetTimeLineByReadyShape(shapeTask As Shape, shapeTL As Shape) As Integer
  3. On Error Resume Next
  4.     Dim shapeOldTL        As Shape
  5.     Dim shapeOldTLIs1D    As Boolean
  6.  
  7.     Set shapeOldTL = FindShapeByNameInGroup(shapeTask, "TimeLineS")
  8.     If shapeOldTL <> Null Then
  9.         shapeOldTLIs1D = shapeOldTL.Is1D
  10.         If shapeOldTL.ID <> shapeTL.ID Then
  11.             shapeTask.RemoveShapeByID(shapeOldTL.ID)
  12.         End If
  13.     End If
  14.     thisDoc.MoveShapeToGroup(shapeTL, shapeTask, 0, 0, -1)
  15.  
  16.     shapeTL.BeginY = shapeTask.Height*0.5
  17.     shapeTL.SetPropertyFormula("=Parent.Height*0.5", CDPT_BEGINY)
  18.     shapeTL.BeginX = shapeTask.ControlDot(1).X
  19.     shapeTL.SetPropertyFormula("=Parent.Controls.X1", CDPT_BEGINX)
  20.     shapeTL.EndX = shapeTask.ControlDot(2).X
  21.     shapeTL.SetPropertyFormula("=Parent.Controls.X2", CDPT_ENDX)
  22.     shapeTL.Variable(1).X = shapeTask.ControlDot(3).X - shapeTask.ControlDot(1).X
  23.     shapeTL.SetPropertyFormula("=Parent.Controls.X3-Parent.Controls.X1", CDPT_VARIABLE_X, 1)
  24.  
  25.     shapeTask.SetPropertyFormula("=2", CDPT_CONTROL_XBEHAVIOUR, 2)
  26.     shapeTask.SetPropertyFormula("=2", CDPT_CONTROL_XBEHAVIOUR, 3)
  27.     If NOT shapeOldTLIs1D Then
  28.         shapeTask.ControlDot(2).X = shapeTask.ControlDot(1).X + 100
  29.         shapeTask.ControlDot(3).X = shapeTask.ControlDot(1).X + 50
  30.         shapeTask.SetDefaultFormula(CDPT_CONTROL_X, 2)
  31.         shapeTask.SetDefaultFormula(CDPT_CONTROL_X, 3)
  32.     End If
  33.  
  34.     shapeTL.RecalcProperty(CDPT_BEGINY)
  35.     shapeTL.RecalcProperty(CDPT_BEGINX)
  36.     shapeTL.RecalcProperty(CDPT_ENDX)
  37.     shapeTL.RecalcProperty(CDPT_VARIABLE_X, 1)
  38.  
  39.     shapeTask.RecalcProperty(CDPT_CONTROL_XBEHAVIOUR, 2)
  40.     shapeTask.RecalcProperty(CDPT_CONTROL_XBEHAVIOUR, 3)
  41. End Function
  42. ' ---------------------------------------------------------------------------
  43. Function SetMilestoneByReadyShape(shapeTask As Shape, shapeTL As Shape) As Integer
  44. On Error Resume Next
  45.     Dim shapeOldTL    As Shape
  46.     Dim bToChange    As Boolean
  47.  
  48.     Set shapeOldTL = FindShapeByNameInGroup(shapeTask, "TimeLineS")
  49.     bToChange = True
  50.     If shapeOldTL <> Null Then
  51.         If shapeOldTL.Is1D Then
  52.             bToChange = (MsgBox("To change timeline?", cdbYesNo) = cdbYes)
  53.         End If
  54.     End If
  55.     If bToChange Then
  56.         If shapeOldTL <> Null Then
  57.             If shapeOldTL.ID <> shapeTL.ID Then
  58.                 shapeTask.RemoveShapeByID(shapeOldTL.ID)
  59.             End If
  60.         End If
  61.         thisDoc.MoveShapeToGroup(shapeTL, shapeTask, 0, 0, -1)
  62.         shapeTL.GPinY = shapeTL.Height*0.5
  63.         shapeTL.SetPropertyFormula("=Parent.Height*0.5", CDPT_GPINY)
  64.         shapeTL.GPinX = shapeTL.ControlDot(1).X
  65.         shapeTL.SetPropertyFormula("=Parent.Controls.X1", CDPT_GPINX)
  66.  
  67.         shapeTask.SetPropertyFormula("=7", CDPT_CONTROL_XBEHAVIOUR, 2)
  68.         shapeTask.SetPropertyFormula("=7", CDPT_CONTROL_XBEHAVIOUR, 3)
  69.         shapeTask.ControlDot(2).X = shapeTask.Width
  70.         shapeTask.ControlDot(3).X = shapeTask.Width
  71.         shapeTask.SetPropertyFormula("=Width", CDPT_CONTROL_X, 2)
  72.         shapeTask.SetPropertyFormula("=Width", CDPT_CONTROL_X, 3)
  73.  
  74.         shapeTask.RecalcProperty(CDPT_CONTROL_XBEHAVIOUR, 2)
  75.         shapeTask.RecalcProperty(CDPT_CONTROL_XBEHAVIOUR, 3)
  76.         shapeTask.RecalcProperty(CDPT_CONTROL_X, 2)
  77.         shapeTask.RecalcProperty(CDPT_CONTROL_X, 3)
  78.     Else
  79.         Dim NumControl As Long
  80.         Dim Ctrl1 As Long, Ctrl2 As Long
  81.         Ctrl1 = shapeTask.ControlDot(1).X + shapeTask.GPinX
  82.         Ctrl2 = shapeTask.ControlDot(2).X + shapeTask.GPinX
  83.         If Abs(Ctrl1 - shapeTL.GPinX) < Abs(Ctrl2 - shapeTL.GPinX) Then
  84.             NumControl = 1
  85.             shapeTL.GPinX = Ctrl1
  86.         Else
  87.             NumControl = 2
  88.             shapeTL.GPinX = Ctrl2
  89.         End If
  90.         shapeTL.SetPropertyFormula("=ObjID" & shapeTask.ID & ".Controls.X" & NumControl & "+ObjID" & shapeTask.ID & ".GPinX", CDPT_GPINX)
  91.         shapeTL.GPinY = shapeTask.GPinY + shapeTask.Height*0.5
  92.         shapeTL.SetPropertyFormula("=ObjID" & shapeTask.ID & ".GPinY+ObjID" & shapeTask.ID & ".Height*0.5", CDPT_GPINY)
  93.     End If
  94.  
  95.     shapeTL.RecalcProperty(CDPT_GPINY)
  96.     shapeTL.RecalcProperty(CDPT_GPINX)
  97. End Function
  98. ' ---------------------------------------------------------------------------
  99. Function TLPlaceMy(inTimeLine As Shape) As Boolean
  100. On Error Resume Next
  101.     Dim shapeTask As Shape
  102.     Dim x1 As Long, x2 As Long, y1 As Long, y2 As Long
  103.     Dim rx1 As Long, rx2 As Long, ry1 As Long, ry2 As Long
  104.  
  105.     If inTimeLine.Is1D Then
  106.         x1 = inTimeLine.BeginX
  107.         y1 = inTimeLine.BeginY
  108.         x2 = inTimeLine.EndX
  109.         y2 = inTimeLine.EndY
  110.     Else
  111.         x1 = inTimeLine.GPinX
  112.         y1 = inTimeLine.GPinY
  113.         x2 = x1
  114.         y2 = y1
  115.     End If
  116.     For I=thisDoc.ActivePage.ShapesNum() To 1 Step -1
  117.         If thisDoc.ActivePage.Shape(I).Name = "TaskBar" Then
  118.             Set shapeTask = thisDoc.ActivePage.Shape(I)
  119.             rx1 = shapeTask.GPinX
  120.             rx2 = shapeTask.GPinX + shapeTask.Width
  121.             ry1 = shapeTask.GPinY
  122.             ry2 = shapeTask.GPinY + shapeTask.Height
  123.             If LineInRect(x1, y1, x2, y2, rx1, ry1, rx2, ry2) = True Then
  124.                 If inTimeLine.Is1D Then
  125.                     SetTimeLineByReadyShape(shapeTask, inTimeLine)
  126.                 Else
  127.                     SetMilestoneByReadyShape(shapeTask, inTimeLine)
  128.                 End If
  129.                 Place = True
  130.                 Exit Function
  131.             End If
  132.         End If
  133.     Next
  134.     Place = False
  135. End Function
  136. ' ---------------------------------------------------------------------------
  137. If thisShape.Variable(1).Y = 0 Then
  138.     thisShape.Name = "TimeLineS"
  139.     TLPlaceMy(thisShape)
  140. End If
  141. thisShape.Variable(1).Y = 1
  142. ' ---------------------------------------------------------------------------
  143.