home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / jpcad / ACC / SAMPLES / DLINE / DLINE.FR_ / DLINE.FR
Text File  |  1998-01-21  |  8KB  |  241 lines
  1. VERSION 4.00
  2. Begin VB.Form frmDline 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   840
  5.    ClientLeft      =   6135
  6.    ClientTop       =   1455
  7.    ClientWidth     =   1560
  8.    Height          =   1200
  9.    Left            =   6075
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   840
  12.    ScaleWidth      =   1560
  13.    Top             =   1155
  14.    Width           =   1680
  15.    Begin ACCLib.Amoeba Amoeba 
  16.       Left            =   120
  17.       Top             =   240
  18.       _Version        =   65536
  19.       _ExtentX        =   847
  20.       _ExtentY        =   847
  21.       _StockProps     =   0
  22.    End
  23. End
  24. Attribute VB_Name = "frmDline"
  25. Attribute VB_Creatable = False
  26. Attribute VB_Exposed = False
  27. Option Base 0
  28.  
  29. Private Sub ProcedureCall(ByVal nProcedureCode As Long)
  30. 'calls different procedures according to registered command id
  31. 'in this case only one command was registered
  32.  Select Case nProcedureCode
  33.  Case 0
  34.     Dline
  35.  Case Else
  36.     'Bad procedure code
  37.  End Select
  38.  
  39. End Sub
  40.  
  41. Private Sub Amoeba_Drag(ByVal UserData As Variant, ByVal Point As Object, Trans As Object, nStatus As Long)
  42. 'drag function
  43.  Amoeba.DrawLine UserData, Point
  44. End Sub
  45.  
  46. Private Sub Amoeba_Error(ByVal nErrorCode As Long)
  47. 'processes error messages
  48.     MsgBox "JPCAD Error " + Str$(nErrorCode), vbCritical
  49. End Sub
  50.  
  51. Private Sub Amoeba_Status(ByVal nStatus As Long, ByVal nCmdCode As Long)
  52. Dim result As Long
  53. Select Case nStatus
  54.     Case A_LOAD
  55.     'program was loaded into Amoeba
  56.      result = Amoeba.DefCmd("dline", 0, 0)
  57.      Amoeba.Prompt Chr(10) + "DLINE - command defined"
  58.     Case A_CMD_CALL
  59.     'command was called - nCmdCode = command id
  60.      ProcedureCall nCmdCode
  61.     Case A_UNLOAD
  62.     'program was unloaded from Amoeba
  63.      Amoeba.Prompt Chr(10) + "DLINE - unloading"
  64.      ' do not quit yet...
  65.     Case A_END
  66.      ' ... quit here
  67.      Unload Me
  68. End Select
  69.  
  70. End Sub
  71.  
  72. Private Sub Form_Load()
  73.  Hide
  74. End Sub
  75.  
  76. '
  77. '    DLINE (c) 1997, ANTEK CS
  78. '
  79. 'Description:
  80. '      Sample file for demonstrating the use of ACC (Amoeba Custom Control).
  81. '      Draws double lines with chosen width.
  82. '
  83. '
  84. '      THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
  85. '      WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
  86. '      PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
  87. '
  88. '
  89. '  Program registeres only one command ("DLINE") for use with Amoeba.
  90. '  Communication with Amoeba takes place in Sub Amoeba_Status.
  91. '
  92. '
  93.  
  94. Public Sub Dline()
  95.  
  96. ' test area
  97. Dim Variable As Variant
  98. Dim VarT As Long
  99. Amoeba.V_Get "LASTPOINT", VarT, Variable
  100.  
  101. ' end of test area
  102.  
  103. Const EPSILON As Double = 0.000000001
  104.  
  105. 'declarations
  106. Dim StartPoint As Object, EndPoint As Object
  107. Dim SP As Object, EP As Object
  108. Dim L1StartPoint As Object, L1EndPoint As Object, L2StartPoint As Object, L2EndPoint As Object
  109. Dim PrevLine1 As Long, PrevLine2 As Long
  110.  
  111. Dim Vector As Object, V As Object, W As Object, PVector As Object
  112. Dim PrevVector As Object, Vector1 As Object, Vector2 As Object
  113. Dim Intersect1 As Object, Intersect2 As Object
  114. Dim S1 As Object, S2 As Object, E1 As Object, E2 As Object
  115.  
  116. 'Dim Vector As Variant, V As Variant, W As Variant, PVector As Variant
  117. 'Dim PrevVector As Variant, Vector1 As Variant, Vector2 As Variant
  118. 'Dim Intersect1 As Variant, Intersect2 As Variant
  119.  
  120. Dim DlineWidth As Double
  121. Dim result As Long
  122.  
  123. Dim pLayer As Long, pLineType As Long, pColor As Long
  124. Dim pWidth As Double
  125. Dim t1 As Double, t2 As Double
  126. Dim IsPrevLine As Boolean
  127.  
  128.  
  129. 'create Point objects
  130. Set StartPoint = CreateObject("acc.point")
  131. Set EndPoint = CreateObject("acc.point")
  132. Set SP = CreateObject("acc.point")
  133. Set EP = CreateObject("acc.point")
  134. Set L1StartPoint = CreateObject("acc.point")
  135. Set L1EndPoint = CreateObject("acc.point")
  136. Set L2StartPoint = CreateObject("acc.point")
  137. Set L2EndPoint = CreateObject("acc.point")
  138. 'vectors
  139. Set Vector = CreateObject("acc.point")
  140. Set PrevVector = CreateObject("acc.point")
  141. Set V = CreateObject("acc.point")
  142. Set W = CreateObject("acc.point")
  143. Set PVector = CreateObject("acc.point")
  144. Set Vector1 = CreateObject("acc.point")
  145. Set Vector2 = CreateObject("acc.point")
  146. Set Intersect1 = CreateObject("acc.point")
  147. Set Intersect2 = CreateObject("acc.point")
  148.  
  149. Set S1 = CreateObject("acc.point")
  150. Set S2 = CreateObject("acc.point")
  151. Set E1 = CreateObject("acc.point")
  152. Set E2 = CreateObject("acc.point")
  153.  
  154. 'Get double line width
  155. result = Amoeba.GetDouble("Double line width ", vbNullString, "10.0", DlineWidth)
  156. Select Case result
  157.         Case A_GET_CANCEL
  158.             Exit Sub
  159.         Case A_GET_DEFAULT
  160.             DlineWidth = 10#        'default is 10.0
  161.     End Select
  162.  
  163. 'Get first point
  164.     result = Amoeba.GetPoint("First dline point", vbNullString, vbNullString, StartPoint)
  165.     If result = A_GET_CANCEL Then
  166.         Exit Sub
  167.     End If
  168.     IsPrevLine = False
  169.     Do While True           'while there are any points...
  170.     result = Amoeba.GetPointDrag("Next dline point", vbNullString, vbNullString, 0, 0, StartPoint, EndPoint)
  171.     If result = A_GET_CANCEL Or result = A_GET_DEFAULT Or result = A_GET_KWORD Then
  172.         Exit Do         'Cancelled, so exit
  173.     End If
  174.  
  175.     'continue prompting if distance of start and end points is less than EPSILON
  176.     Vector = Amoeba.G_SubVV(StartPoint, EndPoint)
  177.     If Amoeba.G_LenV(Vector) < EPSILON Then
  178.         GoTo LoopLabel
  179.     End If
  180.  
  181.     'compute starting and ending points of double lines
  182.     Vector = Amoeba.G_SubVV(StartPoint, EndPoint)
  183.     PVector = Amoeba.G_PerpenV(Vector, 1)
  184.     V = Amoeba.G_MulVR(Amoeba.G_NormV(PVector), DlineWidth / 2)
  185.     S1 = Amoeba.G_AddVV(StartPoint, V)
  186.     E1 = Amoeba.G_AddVV(EndPoint, V)
  187.     PVector = Amoeba.G_PerpenV(Vector, 0)
  188.     V = Amoeba.G_MulVR(Amoeba.G_NormV(PVector), DlineWidth / 2)
  189.     S2 = Amoeba.G_AddVV(StartPoint, V)
  190.     E2 = Amoeba.G_AddVV(EndPoint, V)
  191.  
  192.     If IsPrevLine Then
  193.        'this line is not the first one, so modify preceding lines according to computed intersections
  194.        Amoeba.LINE_Get PrevLine1, L1StartPoint, L1EndPoint, pLayer, pColor, pLineType, pWidth
  195.        Amoeba.LINE_Get PrevLine2, L2StartPoint, L2EndPoint, pLayer, pColor, pLineType, pWidth
  196.        Vector1 = Amoeba.G_SubVV(S1, E1)
  197.        Vector2 = Amoeba.G_SubVV(S2, E2)
  198.        'compute intersection of previous and new line #1
  199.        If Amoeba.G_IntersLL(L1StartPoint, Amoeba.G_SubVV(L1StartPoint, L1EndPoint), S1, Vector1, t1, t2) = 0 Then
  200.             Intersect1 = Amoeba.G_AddVV(Amoeba.G_MulVR(Amoeba.G_SubVV(L1StartPoint, L1EndPoint), t1), L1StartPoint)
  201.             'change previous line #1
  202.             Amoeba.LINE_Change PrevLine1, L1StartPoint, Intersect1, A_USE_CURRENT, A_USE_CURRENT, A_USE_CURRENT, 0
  203.         'compute intersection of previous and new line #2
  204.         If Amoeba.G_IntersLL(L2StartPoint, Amoeba.G_SubVV(L2StartPoint, L2EndPoint), S2, Vector2, t1, t2) = 0 Then
  205.              Intersect2 = Amoeba.G_AddVV(Amoeba.G_MulVR(Amoeba.G_SubVV(L2StartPoint, L2EndPoint), t1), L2StartPoint)
  206.              'change previous line #2
  207.              Amoeba.LINE_Change PrevLine2, L2StartPoint, Intersect2, A_USE_CURRENT, A_USE_CURRENT, A_USE_CURRENT, 0
  208.          End If
  209.        Else
  210.             If Amoeba.G_SMulVV(Amoeba.G_NormV(PrevVector), Amoeba.G_NormV(Vector)) < 0 Then
  211.                 Intersect1 = L2EndPoint
  212.             Else
  213.                 Intersect1 = L1EndPoint
  214.             End If
  215.             If Amoeba.G_SMulVV(Amoeba.G_NormV(PrevVector), Amoeba.G_NormV(Vector)) < 0 Then
  216.                 Intersect2 = L1EndPoint
  217.             Else
  218.                 Intersect2 = L2EndPoint
  219.             End If
  220.        End If
  221.        'draw first line
  222.        Amoeba.LINE_Make Intersect1, E1, A_USE_CURRENT, A_USE_CURRENT, A_USE_CURRENT, 0, False, PrevLine1
  223.  
  224.        'draw second line
  225.        Amoeba.LINE_Make Intersect2, E2, A_USE_CURRENT, A_USE_CURRENT, A_USE_CURRENT, 0, False, PrevLine2
  226.       Else      'this is the first double line
  227.     'draw first line
  228.     Amoeba.LINE_Make S1, E1, A_USE_CURRENT, A_USE_CURRENT, A_USE_CURRENT, 0, False, PrevLine1
  229.     'draw second line
  230.     Amoeba.LINE_Make S2, E2, A_USE_CURRENT, A_USE_CURRENT, A_USE_CURRENT, 0, False, PrevLine2
  231.   End If
  232.   StartPoint = EndPoint
  233.   PrevVector = Vector
  234.   IsPrevLine = True
  235. LoopLabel:
  236.   Loop
  237.  
  238.  End Sub
  239.  
  240.  
  241.