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 / cBlock.cls < prev    next >
Text File  |  2003-09-15  |  13KB  |  416 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 = "cBlock"
  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. Attribute VB_Ext_KEY = "Member0" ,"blockCollection"
  17. ' =========================================================
  18. '  === Project of Data-flow Visual Programming Language ===
  19. ' =========================================================
  20. ' Copyright Emu8086, Inc. Free Code !
  21. '
  22. '
  23. ' URL: http://www.emu8086.com/vb/
  24.  
  25.  
  26.  
  27.  
  28. ' info@emu8086.com
  29. ' =========================================================
  30. '  The class for cBlock
  31. '  (works with myShape Active-X like
  32. '   two these objects are single big object).
  33. '  Programs are made from cBlock(s) connected
  34. '  by cLine(s).
  35. ' =========================================================
  36.  
  37. Option Explicit
  38.  
  39.  
  40.  
  41.  
  42. 'local variable(s) to hold property value(s)
  43. ' currect active-x object linked with this
  44. ' block (assumed they are the same object):
  45. Public theObjectShape As PictureBox 'GShape
  46.  
  47. 'To fire this event, use RaiseEvent with the following syntax:
  48. 'RaiseEvent linkError[(arg1, arg2, ... , argn)]
  49. Public Event linkError(sERROR As String)
  50. 'local variable(s) to hold property value(s)
  51. Private mvarbSetUpperCaptionDown As Boolean 'local copy
  52.  
  53. 'local variable(s) to hold property value(s)
  54. ' added internal property to allow running without GUI:
  55. Private mvar_TagID As String
  56.  
  57.  
  58. Public zAction As String   ' action of this block.
  59. Public zParam1 As String   ' first parameter for action.
  60. Public zParam2 As String   ' second parameter for action.
  61. Public zParam3 As String   ' third parameter (generally result).
  62.  
  63. 'Property Variables:
  64. Dim m_TextColor As OLE_COLOR
  65. Dim m_BGColor As OLE_COLOR
  66. Dim m_Shape As Integer
  67. Dim m_BorderColor As OLE_COLOR
  68. Dim m_sCaptionUp As String
  69. Dim m_sCaption As String
  70.  
  71.  
  72.  
  73. Public Property Let TextColor(ByVal vData As Long)
  74. 'used when assigning a value to the property, on the left side of an assignment.
  75. 'Syntax: X.TextColor = 5
  76.     m_TextColor = vData
  77. End Property
  78.  
  79.  
  80. Public Property Get TextColor() As Long
  81. 'used when retrieving value of a property, on the right side of an assignment.
  82.     TextColor = m_TextColor
  83. End Property
  84.  
  85.  
  86. ' this procedure sets the caption for the block
  87. ' according to zAction (the action for this block):
  88. Public Sub setCaptionToAction()
  89.     Select Case zAction
  90.     
  91.     Case "START"
  92.         sCaption = cLang("start")
  93.         
  94.     Case "STOP"
  95.         sCaption = cLang("stop")
  96.     
  97.     Case "INTERSECTION"
  98.         ' nothing.
  99.     
  100.     Case "OUTPUT"
  101.         sCaptionUp = cLang("output")
  102.         If zParam2 = "" Then    ' only message
  103.             sCaption = """" & zParam1 & """"
  104.         ElseIf zParam1 = "" Then ' only variable
  105.             sCaption = zParam2
  106.         Else                    ' both message & variable
  107.             sCaption = """" & zParam1 & """, " & zParam2
  108.         End If
  109.         
  110.     Case "INPUT"
  111.         sCaptionUp = cLang("input")
  112.         If zParam1 = "" Then    ' only variable
  113.             sCaption = zParam2
  114.         Else                    ' both message & variable
  115.             sCaption = """" & zParam1 & """, " & zParam2
  116.         End If
  117.         
  118.     Case "DEFINITION"
  119.         sCaption = zParam1 & " = " & zParam2
  120.  
  121.         
  122.     Case "IF_EQUAL"
  123.         sCaption = zParam1 & " = " & zParam2
  124.     Case "IF_GREATER"
  125.         sCaption = zParam1 & " > " & zParam2
  126.     Case "IF_LESS"
  127.         sCaption = zParam1 & " < " & zParam2
  128.     Case "IF_LESS_EQUAL"
  129.         sCaption = zParam1 & " <= " & zParam2
  130.     Case "IF_GREATER_EQUAL"
  131.         sCaption = zParam1 & " >= " & zParam2
  132.         
  133.     Case "ADD"
  134.         sCaption = zParam3 & " = " & zParam1 & " + " & zParam2
  135.     Case "SUBTRACT"
  136.         sCaption = zParam3 & " = " & zParam1 & " - " & zParam2
  137.     Case "MULTIPLY"
  138.         sCaption = zParam3 & " = " & zParam1 & " * " & zParam2
  139.     Case "DIVIDE"
  140.         sCaption = zParam3 & " = " & zParam1 & " / " & zParam2
  141.         
  142.     Case "JOIN"
  143.         sCaption = zParam3 & " = " & zParam1 & " & " & zParam2
  144.     Case "COMP"
  145.         sCaption = zParam3 & " = " & zParam1 & " COMP " & zParam2
  146.         
  147.     Case "SQL"
  148.         sCaption = "SQL"
  149.         
  150.     Case "FUNCTION"
  151.         If zParam3 <> "" Then
  152.             sCaption = zParam3 & " = " & zParam1 & "(" & zParam2 & ")"
  153.         Else
  154.             sCaption = zParam1 & "(" & zParam2 & ")"
  155.         End If
  156.         
  157.     Case "WINDOW"
  158.         sCaption = cLang("window")
  159.         
  160.     Case Else
  161.         Debug.Print "setCaptionToAction(). Unknown action code in zAction: " & zAction
  162.     End Select
  163.     
  164.     ' making sure the caption will be visible on the block
  165.     '   (resize if required)
  166.     ' assumed: frmScreen uses the same font as blocks!
  167.     If sCaption <> "" Then  ' ignored for intersections.
  168.         If m_Shape = 92 Then ' 92 - for diamond.
  169.             If frmScreen.TextWidth(sCaption) + 40 > shapeWidth Then
  170.                 shapeWidth = frmScreen.TextWidth(sCaption) + 40
  171.             End If
  172.         Else ' all other boxes:
  173.             If frmScreen.TextWidth(sCaption) + 20 > shapeWidth Then
  174.                 shapeWidth = frmScreen.TextWidth(sCaption) + 20
  175.             End If
  176.         End If
  177.     End If
  178.     
  179. End Sub
  180.  
  181. Public Property Let sCaption(ByVal vData As String)
  182. 'used when assigning a value to the property, on the left side of an assignment.
  183. 'Syntax: X.sCaption = 5
  184.     m_sCaption = vData
  185. End Property
  186.  
  187. Public Property Get sCaption() As String
  188. 'used when retrieving value of a property, on the right side of an assignment.
  189.     sCaption = m_sCaption
  190. End Property
  191.  
  192. Public Property Let sCaptionUp(ByVal vData As String)
  193.     m_sCaptionUp = vData
  194. End Property
  195.  
  196. Public Property Get sCaptionUp() As String
  197.     sCaptionUp = m_sCaptionUp
  198. End Property
  199.  
  200.  
  201. ' this makes active-x object and this object have:
  202. '      Tag == TagID
  203. Public Property Let TagID(ByVal vData As String)
  204.     mvar_TagID = vData
  205.     If bGUI Then theObjectShape.Tag = mvar_TagID
  206. End Property
  207.  
  208. Public Property Get TagID() As String
  209.     TagID = mvar_TagID 'theObjectShape.Tag
  210. End Property
  211.  
  212.  
  213. Public Property Let BorderColor(ByVal vData As Long)
  214. 'used when assigning a value to the property, on the left side of an assignment.
  215. 'Syntax: X.shapeBorderColor = 5
  216.     m_BorderColor = vData
  217. End Property
  218.  
  219.  
  220. Public Property Get BorderColor() As Long
  221. 'used when retrieving value of a property, on the right side of an assignment.
  222.     BorderColor = m_BorderColor
  223. End Property
  224.  
  225.  
  226. Public Property Let BGColor(ByVal vData As Long)
  227. 'used when assigning a value to the property, on the left side of an assignment.
  228. 'Syntax: X.shapeBackColor = 5
  229.     m_BGColor = vData
  230. End Property
  231.  
  232.  
  233. Public Property Get BGColor() As Long
  234. 'used when retrieving value of a property, on the right side of an assignment.
  235.     BGColor = m_BGColor
  236. End Property
  237.  
  238.  
  239. Public Property Let shapeHeight(ByVal vData As Integer)
  240. 'used when assigning a value to the property, on the left side of an assignment.
  241. 'Syntax: X.shapeHeight = 5
  242.     theObjectShape.Height = vData
  243. End Property
  244.  
  245.  
  246. Public Property Get shapeHeight() As Integer
  247. 'used when retrieving value of a property, on the right side of an assignment.
  248.     shapeHeight = theObjectShape.Height
  249. End Property
  250.  
  251.  
  252. Public Property Let shapeWidth(ByVal vData As Integer)
  253. 'used when assigning a value to the property, on the left side of an assignment.
  254. 'Syntax: X.shapeWidth = 5
  255.     theObjectShape.Width = vData
  256. End Property
  257.  
  258.  
  259. Public Property Get shapeWidth() As Integer
  260. 'used when retrieving value of a property, on the right side of an assignment.
  261.     shapeWidth = theObjectShape.Width
  262. End Property
  263.  
  264.  
  265. Public Property Let Shape(ByVal vData As Integer)
  266. 'used when assigning a value to the property, on the left side of an assignment.
  267. 'Syntax: X.Shape = 5
  268.     m_Shape = vData
  269. End Property
  270.  
  271.  
  272. Public Property Get Shape() As Integer
  273. 'used when retrieving value of a property, on the right side of an assignment.
  274.     Shape = m_Shape
  275. End Property
  276.  
  277.  
  278. Public Property Let Visible(ByVal vData As Boolean)
  279. 'used when assigning a value to the property, on the left side of an assignment.
  280. 'Syntax: X.Visible = 5
  281.     theObjectShape.Visible = vData
  282. End Property
  283.  
  284.  
  285. Public Property Get Visible() As Boolean
  286. 'used when retrieving value of a property, on the right side of an assignment.
  287.     Visible = theObjectShape.Visible
  288. End Property
  289.  
  290. Public Property Let shapeLeft(ByVal vData As Single)
  291. 'used when assigning a value to the property, on the left side of an assignment.
  292. 'Syntax: X.shapeLeft = 5
  293.     theObjectShape.Left = vData
  294. End Property
  295.  
  296.  
  297. Public Property Get shapeLeft() As Single
  298. 'used when retrieving value of a property, on the right side of an assignment.
  299.     shapeLeft = theObjectShape.Left
  300. End Property
  301.  
  302.  
  303. Public Property Let shapeTop(ByVal vData As Single)
  304. 'used when assigning a value to the property, on the left side of an assignment.
  305. 'Syntax: X.shapeTop = 5
  306.     theObjectShape.Top = vData
  307. End Property
  308.  
  309.  
  310. Public Property Get shapeTop() As Single
  311. 'used when retrieving value of a property, on the right side of an assignment.
  312.     shapeTop = theObjectShape.Top
  313. End Property
  314.  
  315.  
  316. Public Sub PaintMe()
  317.     Dim tWidth As Single
  318.     Dim tHeight As Single
  319.     Dim p(0 To 5) As POINTAPI
  320.  
  321.  ' because of below:
  322.  On Error GoTo err_expt
  323.  
  324. ' sometimes there is an error: Client site not available!
  325. '  in the end  of execution of c.tzr (on closing of frmMain):
  326.     theObjectShape.BackColor = theObjectShape.Parent.BackColor
  327.     theObjectShape.Cls
  328.  
  329.     ' temporary variables to keep width-1 and height-1
  330.     tWidth = theObjectShape.ScaleWidth - 1
  331.     tHeight = theObjectShape.ScaleHeight - 1
  332.  
  333.     theObjectShape.ForeColor = m_BorderColor
  334.     theObjectShape.FillColor = m_BGColor
  335.     Select Case m_Shape
  336.     
  337.     Case 0      ' rectangle
  338.         ' draw frame:
  339.         theObjectShape.Line (0, 0)-(tWidth, tHeight), , B
  340.         ' draw inside:
  341.         theObjectShape.Line (1, 1)-(tWidth - 1, tHeight - 1), theObjectShape.FillColor, BF
  342.     Case 2      ' oval
  343.         theObjectShape.Circle (tWidth / 2, tHeight / 2), tWidth / 2, , , , tHeight / tWidth
  344.     
  345.     Case 3      ' circle
  346.         theObjectShape.Circle (tWidth / 2, tHeight / 2), tWidth / 2
  347.     
  348.     Case 91     ' parallelogram.
  349.         p(0).X = 10
  350.         p(0).Y = 0
  351.         p(1).X = tWidth
  352.         p(1).Y = 0
  353.         p(2).X = tWidth - 10
  354.         p(2).Y = tHeight
  355.         p(3).X = 0
  356.         p(3).Y = tHeight
  357.         Polygon theObjectShape.hdc, p(0), 4
  358.         
  359.     Case 92     ' diamond.
  360.         p(0).X = tWidth / 2
  361.         p(0).Y = 0
  362.         p(1).X = tWidth
  363.         p(1).Y = tHeight / 2
  364.         p(2).X = tWidth / 2
  365.         p(2).Y = tHeight
  366.         p(3).X = 0
  367.         p(3).Y = tHeight / 2
  368.         Polygon theObjectShape.hdc, p(0), 4
  369.         
  370.     Case 93     ' six-point diamond.
  371.         p(0).X = 0
  372.         p(0).Y = tHeight / 2
  373.         p(1).X = 10
  374.         p(1).Y = 0
  375.         p(2).X = tWidth - 10
  376.         p(2).Y = 0
  377.         p(3).X = tWidth
  378.         p(3).Y = tHeight / 2
  379.         p(4).X = tWidth - 10
  380.         p(4).Y = tHeight
  381.         p(5).X = 10
  382.         p(5).Y = tHeight
  383.         Polygon theObjectShape.hdc, p(0), 6
  384.           
  385.     Case Else
  386.         MsgBox "wrong setting to Shape property: " & m_Shape
  387.     End Select
  388.  
  389.    
  390.     ' print the caption:
  391.     
  392.     ' restore ForeColor:
  393.     theObjectShape.ForeColor = m_TextColor
  394.     
  395.     ' in case there is one line caption:
  396.     If m_sCaptionUp = "" Then
  397.         theObjectShape.CurrentX = tWidth / 2 - theObjectShape.TextWidth(m_sCaption) / 2
  398.         theObjectShape.CurrentY = tHeight / 2 - theObjectShape.TextHeight(m_sCaption) / 2
  399.         theObjectShape.Print m_sCaption
  400.     ' in case there are two lines in caption:
  401.     Else
  402.         ' print first line:
  403.         theObjectShape.CurrentX = tWidth / 2 - theObjectShape.TextWidth(m_sCaptionUp) / 2
  404.         theObjectShape.CurrentY = tHeight / 2 - theObjectShape.TextHeight(m_sCaptionUp)
  405.         theObjectShape.Print m_sCaptionUp
  406.         ' print second line:
  407.         theObjectShape.CurrentX = tWidth / 2 - theObjectShape.TextWidth(m_sCaption) / 2
  408.         theObjectShape.CurrentY = tHeight / 2
  409.         theObjectShape.Print m_sCaption
  410.     End If
  411.  
  412.     Exit Sub
  413. err_expt:
  414.  
  415. End Sub
  416.