home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Data-Flow_186296392005.psc / FlowChart_301_SOURCE / cLine.cls < prev   
Text File  |  2003-07-17  |  10KB  |  288 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cLine"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. ' =========================================================
  17. '  === Project of Data-flow Visual Programming Language ===
  18. ' =========================================================
  19. ' Copyright Emu8086, Inc. Free Code !
  20. '
  21. '
  22. ' URL: http://www.emu8086.com/vb/
  23.  
  24.  
  25. ' info@emu8086.com
  26. ' =========================================================
  27. '  The class for cLine
  28. '  (works with Line - VB Object
  29. '   two these objects are single big object).
  30. ' cLine connects cBlock one with another.
  31. ' =========================================================
  32.  
  33. Option Explicit
  34.  
  35. Public theObjectLine As Line
  36.  
  37. 'local variable(s) to hold property value(s)
  38. Private mvarsFrom As String 'local copy
  39. Private mvarsTo As String 'local copy
  40.  
  41. Private mvar_sCaption As String ' added to support no GUI.
  42.  
  43. Public Property Let sCaption(ByVal vData As String)
  44.     mvar_sCaption = vData
  45.     
  46.     If bGUI Then
  47.         frmMain.lblLineCap(theObjectLine.Index).Caption = mvar_sCaption
  48.         
  49.         If sCaption <> "" Then
  50.             frmMain.lblLineCap(theObjectLine.Index).Visible = True
  51.         Else
  52.             frmMain.lblLineCap(theObjectLine.Index).Visible = False
  53.         End If
  54.     End If
  55. End Property
  56.  
  57. Public Property Get sCaption() As String
  58.     sCaption = mvar_sCaption ' frmMain.lblLineCap(theObjectLine.Index).Caption
  59. End Property
  60.  
  61.  
  62. Public Property Let sTo(ByVal vData As String)
  63. 'used when assigning a value to the property, on the left side of an assignment.
  64. 'Syntax: X.sTo = 5
  65.     mvarsTo = vData
  66. End Property
  67.  
  68.  
  69. Public Property Get sTo() As String
  70. 'used when retrieving value of a property, on the right side of an assignment.
  71.     sTo = mvarsTo
  72. End Property
  73.  
  74.  
  75.  
  76. Public Property Let sFrom(ByVal vData As String)
  77. 'used when assigning a value to the property, on the left side of an assignment.
  78. 'Syntax: X.sFrom = 5
  79.     mvarsFrom = vData
  80. End Property
  81.  
  82.  
  83. Public Property Get sFrom() As String
  84. 'used when retrieving value of a property, on the right side of an assignment.
  85.     sFrom = mvarsFrom
  86. End Property
  87.  
  88. ' updates line position and its arrow:
  89. Public Sub updateLine()
  90.     Dim iFrom As Integer
  91.     Dim iTo As Integer
  92.     Dim lineIndex As Integer
  93.     
  94.     If Not bGUI Then Exit Sub
  95.     
  96.     ' temporary variables:
  97.     Dim x1 As Single
  98.     Dim y1 As Single
  99.     Dim x2 As Single
  100.     Dim y2 As Single
  101.     
  102.     
  103.         With frmMain.theBlockCollection
  104.             iFrom = .getIndexFromTag(sFrom)
  105.             iTo = .getIndexFromTag(sTo)
  106.         End With
  107.        
  108.             
  109.             ' set start of line (not an arrow)
  110.             ' to the nearest edge of the block (source):
  111.             
  112.             ' arrow will be on the right side:
  113.             If frmMain.shp(iTo).Left > (frmMain.shp(iFrom).Left + frmMain.shp(iFrom).Width) Then
  114.                 x1 = frmMain.shp(iFrom).Left + frmMain.shp(iFrom).Width
  115.                 y1 = frmMain.shp(iFrom).Top + frmMain.shp(iFrom).Height / 2
  116.             ' arrow will be at the bottom:
  117.             ElseIf frmMain.shp(iTo).Top > (frmMain.shp(iFrom).Top + frmMain.shp(iFrom).Height) Then
  118.                 x1 = frmMain.shp(iFrom).Left + frmMain.shp(iFrom).Width / 2
  119.                 y1 = frmMain.shp(iFrom).Top + frmMain.shp(iFrom).Height
  120.             ' arrow will be on the left:
  121.             ElseIf (frmMain.shp(iTo).Left + frmMain.shp(iTo).Width) < frmMain.shp(iFrom).Left Then
  122.                 x1 = frmMain.shp(iFrom).Left
  123.                 y1 = frmMain.shp(iFrom).Top + frmMain.shp(iFrom).Height / 2
  124.             ' arrow will be at the top:
  125.             Else
  126.                 x1 = frmMain.shp(iFrom).Left + frmMain.shp(iFrom).Width / 2
  127.                 y1 = frmMain.shp(iFrom).Top
  128.             End If
  129.             
  130.             
  131.             
  132.             ' set end of line (an arrow)
  133.             ' to the nearest edge of the block (target):
  134.             
  135.             ' arrow will be on the right side:
  136.             If frmMain.shp(iFrom).Left > (frmMain.shp(iTo).Left + frmMain.shp(iTo).Width) Then
  137.                 x2 = frmMain.shp(iTo).Left + frmMain.shp(iTo).Width
  138.                 y2 = frmMain.shp(iTo).Top + frmMain.shp(iTo).Height / 2
  139.             ' arrow will be at the bottom:
  140.             ElseIf frmMain.shp(iFrom).Top > (frmMain.shp(iTo).Top + frmMain.shp(iTo).Height) Then
  141.                 x2 = frmMain.shp(iTo).Left + frmMain.shp(iTo).Width / 2
  142.                 y2 = frmMain.shp(iTo).Top + frmMain.shp(iTo).Height
  143.             ' arrow will be on the left:
  144.             ElseIf (frmMain.shp(iFrom).Left + frmMain.shp(iFrom).Width) < frmMain.shp(iTo).Left Then
  145.                 x2 = frmMain.shp(iTo).Left
  146.                 y2 = frmMain.shp(iTo).Top + frmMain.shp(iTo).Height / 2
  147.             ' arrow will be at the top:
  148.             Else
  149.                 x2 = frmMain.shp(iTo).Left + frmMain.shp(iTo).Width / 2
  150.                 y2 = frmMain.shp(iTo).Top
  151.             End If
  152.             
  153.             ' update position of line's caption:
  154.             If frmMain.lblLineCap(lineIndex).Caption <> "" Then
  155.                 lineIndex = theObjectLine.Index
  156.                 Dim tL As Single
  157.                 Dim tT As Single
  158.                 tL = x1 + (x2 - x1) / 2 - frmMain.lblLineCap(lineIndex).Width / 2
  159.                 tT = y1 + (y2 - y1) / 2 - frmMain.lblLineCap(lineIndex).Height / 2
  160.                 ' to prevent flickering:
  161.                 If (Fix(frmMain.lblLineCap(lineIndex).Left) <> Fix(tL)) _
  162.                     Or (Fix(frmMain.lblLineCap(lineIndex).Top) <> Fix(tT)) Then
  163.                         frmMain.lblLineCap(lineIndex).Move tL, tT
  164.                         ' Debug.Print "Label updated: " & frmMain.lblLineCap(lineIndex).Index
  165.                 End If
  166.             End If
  167.         
  168.         
  169.         ' to prevent flickering (and unnecessary actions):
  170.         If (Fix(theObjectLine.x1) <> Fix(x1)) Or (Fix(theObjectLine.y1) <> Fix(y1)) _
  171.           Or (Fix(theObjectLine.x2) <> Fix(x2)) Or (Fix(theObjectLine.y2) <> Fix(y2)) Then
  172.             theObjectLine.x1 = x1
  173.             theObjectLine.y1 = y1
  174.             theObjectLine.x2 = x2
  175.             theObjectLine.y2 = y2
  176.             
  177.             ' update arrow for this line:
  178.             showArrow
  179.             
  180.            ' Debug.Print "Line updated: " & theObjectLine.Index & "  " & x1, y1, x2, y2
  181.            ' Debug.Print theObjectLine.y1, y1
  182.         End If
  183.         
  184.  
  185.  
  186. End Sub
  187.  
  188.  
  189. Private Sub showArrow()
  190.  
  191.     Dim mSin As Double
  192.     Dim mCos As Double
  193.     Dim pril As Double
  194.     Dim prot As Double
  195.     Dim gip As Double
  196.     
  197.     Dim arINDEX As Integer
  198.     
  199.     arINDEX = theObjectLine.Index
  200.     
  201.     pril = (theObjectLine.x1 - theObjectLine.x2)
  202.     prot = (theObjectLine.y1 - theObjectLine.y2)
  203.     
  204.     gip = Sqr(pril ^ 2 + prot ^ 2)
  205.     
  206.     If gip <> 0 Then
  207.         mSin = prot / gip
  208.         mCos = pril / gip
  209.     Else
  210.         mSin = 0
  211.         mCos = 0
  212.         'Debug.Print "gip is zero!"
  213.     End If
  214.     
  215.    Dim iXcor As Double
  216.    Dim iYcor As Double
  217.    
  218.    Dim new_mSin1 As Double
  219.    Dim new_mCos1 As Double
  220.    Dim new_mSin2 As Double
  221.    Dim new_mCos2 As Double
  222.    
  223.    Dim arrow_angle As Double
  224.    Dim arrow_len As Double
  225.    
  226.    arrow_angle = 0.5
  227.    arrow_len = 15
  228.    
  229.    ' according to quadrant add or subtract angle:
  230.    If (mSin >= 0) And (mCos >= 0) Then
  231.         new_mSin1 = sIn(Arcsin(mSin) - arrow_angle)
  232.         new_mSin2 = sIn(Arcsin(mSin) + arrow_angle)
  233.         new_mCos1 = Cos(Arccos(mCos) - arrow_angle)
  234.         new_mCos2 = Cos(Arccos(mCos) + arrow_angle)
  235.      ElseIf (mSin <= 0) And (mCos >= 0) Then
  236.         new_mSin1 = sIn(Arcsin(mSin) - arrow_angle)
  237.         new_mSin2 = sIn(Arcsin(mSin) + arrow_angle)
  238.         new_mCos1 = Cos(Arccos(mCos) + arrow_angle)
  239.         new_mCos2 = Cos(Arccos(mCos) - arrow_angle)
  240.    ElseIf (mSin >= 0) And (mCos <= 0) Then
  241.         new_mSin1 = sIn(Arcsin(mSin) + arrow_angle)
  242.         new_mSin2 = sIn(Arcsin(mSin) - arrow_angle)
  243.         new_mCos1 = Cos(Arccos(mCos) - arrow_angle)
  244.         new_mCos2 = Cos(Arccos(mCos) + arrow_angle)
  245.    ElseIf (mSin <= 0) And (mCos <= 0) Then
  246.         new_mSin1 = sIn(Arcsin(mSin) + arrow_angle)
  247.         new_mSin2 = sIn(Arcsin(mSin) - arrow_angle)
  248.         new_mCos1 = Cos(Arccos(mCos) + arrow_angle)
  249.         new_mCos2 = Cos(Arccos(mCos) - arrow_angle)
  250.    End If
  251.    
  252.     
  253.     ' arrow point:
  254.     iXcor = theObjectLine.x2
  255.     iYcor = theObjectLine.y2
  256.  
  257.     Dim X As Double
  258.     Dim Y As Double
  259.  
  260.     X = iXcor   ' xRadius=0
  261.     Y = iYcor   ' yRadius=0
  262.  
  263.     frmMain.aDot(arINDEX).Left = X - frmMain.aDot(arINDEX).Width / 2
  264.     frmMain.aDot(arINDEX).Top = Y - frmMain.aDot(arINDEX).Height / 2
  265.     
  266.       
  267.    frmMain.arrUp(arINDEX).x1 = frmMain.aDot(arINDEX).Left + frmMain.aDot(arINDEX).Width / 2
  268.    frmMain.arrUp(arINDEX).y1 = frmMain.aDot(arINDEX).Top + frmMain.aDot(arINDEX).Height / 2
  269.    frmMain.arrDown(arINDEX).x1 = frmMain.arrUp(arINDEX).x1
  270.    frmMain.arrDown(arINDEX).y1 = frmMain.arrUp(arINDEX).y1
  271.    
  272.    ' xRadius=yRadius=0
  273.    frmMain.arrUp(arINDEX).x2 = new_mCos1 * arrow_len + iXcor
  274.    frmMain.arrUp(arINDEX).y2 = new_mSin1 * arrow_len + iYcor
  275.    frmMain.arrDown(arINDEX).x2 = new_mCos2 * arrow_len + iXcor
  276.    frmMain.arrDown(arINDEX).y2 = new_mSin2 * arrow_len + iYcor
  277.    
  278.     
  279.    frmMain.arrUp(arINDEX).Visible = True
  280.    frmMain.arrUp(arINDEX).ZOrder 0
  281.    frmMain.arrDown(arINDEX).Visible = True
  282.    frmMain.arrDown(arINDEX).ZOrder 0
  283.    frmMain.aDot(arINDEX).Visible = True
  284.    frmMain.aDot(arINDEX).ZOrder 0
  285.     
  286. End Sub
  287.  
  288.