home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / tema / jpcad / ACC / SAMPLES / XDVIEW / XDVIEW.FR_ / XDVIEW.FR (.txt)
Encoding:
Visual Basic Form  |  1998-01-21  |  22.3 KB  |  698 lines
  1. VERSION 4.00
  2. Begin VB.Form frmXDView 
  3.    AutoRedraw      =   -1  'True
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "XData view"
  6.    ClientHeight    =   3975
  7.    ClientLeft      =   1725
  8.    ClientTop       =   2085
  9.    ClientWidth     =   6315
  10.    Height          =   4380
  11.    Icon            =   "XDVIEW.frx":0000
  12.    Left            =   1665
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   3975
  17.    ScaleWidth      =   6315
  18.    Top             =   1740
  19.    Width           =   6435
  20.    Begin VB.CommandButton bUp 
  21.       Caption         =   ">"
  22.       Height          =   255
  23.       Left            =   5580
  24.       TabIndex        =   17
  25.       Top             =   420
  26.       Visible         =   0   'False
  27.       Width           =   255
  28.    End
  29.    Begin VB.TextBox tIndex 
  30.       Height          =   285
  31.       Left            =   5040
  32.       TabIndex        =   16
  33.       Top             =   405
  34.       Visible         =   0   'False
  35.       Width           =   495
  36.    End
  37.    Begin VB.CommandButton bDown 
  38.       Caption         =   "<"
  39.       Height          =   255
  40.       Left            =   4755
  41.       TabIndex        =   15
  42.       Top             =   420
  43.       Visible         =   0   'False
  44.       Width           =   255
  45.    End
  46.    Begin VB.TextBox tValueY 
  47.       Enabled         =   0   'False
  48.       Height          =   285
  49.       Left            =   3240
  50.       TabIndex        =   11
  51.       Top             =   2880
  52.       Visible         =   0   'False
  53.       Width           =   2655
  54.    End
  55.    Begin VB.TextBox tValueX 
  56.       Enabled         =   0   'False
  57.       Height          =   285
  58.       Left            =   360
  59.       TabIndex        =   10
  60.       Top             =   2880
  61.       Visible         =   0   'False
  62.       Width           =   2655
  63.    End
  64.    Begin VB.TextBox tValue 
  65.       Enabled         =   0   'False
  66.       Height          =   285
  67.       Left            =   360
  68.       TabIndex        =   6
  69.       Top             =   2880
  70.       Width           =   5535
  71.    End
  72.    Begin VB.CommandButton bUpLevel 
  73.       Caption         =   "Up level"
  74.       Enabled         =   0   'False
  75.       Height          =   375
  76.       Left            =   360
  77.       TabIndex        =   4
  78.       Top             =   3360
  79.       Width           =   1215
  80.    End
  81.    Begin VB.CommandButton bPick 
  82.       Caption         =   "Pick"
  83.       Enabled         =   0   'False
  84.       Height          =   375
  85.       Left            =   1800
  86.       TabIndex        =   3
  87.       Top             =   3360
  88.       Width           =   1215
  89.    End
  90.    Begin VB.CommandButton bModify 
  91.       Caption         =   "Modify"
  92.       Height          =   375
  93.       Left            =   3240
  94.       TabIndex        =   2
  95.       Top             =   3360
  96.       Width           =   1215
  97.    End
  98.    Begin VB.CommandButton bOK 
  99.       Caption         =   "Close"
  100.       Height          =   375
  101.       Left            =   4680
  102.       TabIndex        =   1
  103.       Top             =   3360
  104.       Width           =   1215
  105.    End
  106.    Begin VB.ListBox XList 
  107.       Height          =   1815
  108.       ItemData        =   "XDVIEW.frx":0442
  109.       Left            =   360
  110.       List            =   "XDVIEW.frx":0444
  111.       TabIndex        =   0
  112.       Top             =   720
  113.       Width           =   5535
  114.    End
  115.    Begin VB.Label lbIndex 
  116.       Caption         =   "Index"
  117.       Height          =   255
  118.       Left            =   4290
  119.       TabIndex        =   18
  120.       Top             =   465
  121.       Visible         =   0   'False
  122.       Width           =   495
  123.    End
  124.    Begin VB.Label lbLevel 
  125.       Caption         =   "Root"
  126.       Height          =   255
  127.       Left            =   1320
  128.       TabIndex        =   14
  129.       Top             =   480
  130.       Width           =   2295
  131.    End
  132.    Begin VB.Label Label2 
  133.       Caption         =   "Level:"
  134.       Height          =   255
  135.       Left            =   360
  136.       TabIndex        =   13
  137.       Top             =   480
  138.       Width           =   855
  139.    End
  140.    Begin VB.Label lbValue2 
  141.       Caption         =   "Y value"
  142.       Height          =   255
  143.       Left            =   3240
  144.       TabIndex        =   12
  145.       Top             =   2640
  146.       Visible         =   0   'False
  147.       Width           =   1095
  148.    End
  149.    Begin VB.Label lbUserDescription 
  150.       Height          =   255
  151.       Left            =   360
  152.       TabIndex        =   9
  153.       Top             =   0
  154.       Visible         =   0   'False
  155.       Width           =   5535
  156.    End
  157.    Begin VB.Label Label1 
  158.       Caption         =   "Description:"
  159.       Height          =   255
  160.       Left            =   360
  161.       TabIndex        =   8
  162.       Top             =   240
  163.       Width           =   855
  164.    End
  165.    Begin VB.Label lbValue1 
  166.       Caption         =   "Value"
  167.       Height          =   255
  168.       Left            =   360
  169.       TabIndex        =   7
  170.       Top             =   2640
  171.       Width           =   1575
  172.    End
  173.    Begin VB.Label lbDescription 
  174.       Height          =   255
  175.       Left            =   1320
  176.       TabIndex        =   5
  177.       Top             =   240
  178.       Width           =   4575
  179.    End
  180. Attribute VB_Name = "frmXDView"
  181. Attribute VB_Creatable = False
  182. Attribute VB_Exposed = False
  183. Dim XDataTypeStr(30) As String
  184. Private Sub bPick_Click()
  185. 'pick point, vector, length, direction, angle and entity in JPCAD instead of entering values
  186. Dim NullString As String
  187. Dim Result As Long
  188. Dim Point As Object, SPoint As Object, EPoint As Object
  189. Dim Angle As Double, Entity As Long
  190. Set Point = CreateObject("ACC.Point")
  191. Set SPoint = CreateObject("ACC.Point")
  192. Set EPoint = CreateObject("ACC.Point")
  193. Select Case XList.ItemData(XList.ListIndex)
  194.     Case A_X_POINT, A_X_POSITION
  195.       If BaseFrm.Amoeba.GetPoint("Enter point", NullString, NullString, Point) = A_GET_OK Then
  196.          tValueX.Text = Str(Point.x)
  197.          tValueY.Text = Str(Point.y)
  198.       End If
  199.     Case A_X_VECTOR, A_X_DIRECTION, A_X_LENGTH
  200.       If BaseFrm.Amoeba.GetPoint("Enter start point", NullString, NullString, SPoint) = A_GET_OK Then
  201.       Result = BaseFrm.Amoeba.GetPointDrag("Enter end point", vbNullString, vbNullString, 0, 0, CVar(SPoint), EPoint)
  202.        If Result = A_GET_OK Then
  203.            Dim EP As Object, SP As Object, Vector As Object, V As Object
  204.            Set EP = CreateObject("ACC.Point")
  205.            Set SP = CreateObject("ACC.Point")
  206.            Set Vector = CreateObject("ACC.Point")
  207.            Set V = CreateObject("ACC.Point")
  208.            SP = SPoint
  209.            EP = EPoint
  210.            V = BaseFrm.Amoeba.G_SubVV(EP, SP)
  211.            Vector = V
  212.            If XList.ItemData(XList.ListIndex) = A_X_LENGTH Then
  213.                 tvalue.Text = Str(BaseFrm.Amoeba.G_LenV(Vector))
  214.            Else
  215.                 tValueX.Text = Str(Vector.x)
  216.                 tValueY.Text = Str(Vector.y)
  217.            End If
  218.        End If
  219.       End If
  220.     Case A_X_ENTITY
  221.       If BaseFrm.Amoeba.GetEnt("Select entity", NullString, NullString, Entity, Point) = A_GET_OK Then
  222.         tvalue.Text = Str(Entity)
  223.       End If
  224.     Case A_X_ANGLE
  225.       Prompt "Picking angle"
  226.       If BaseFrm.Amoeba.GetPoint("Enter base point", NullString, NullString, Point) = A_GET_OK Then
  227.           If BaseFrm.Amoeba.GetAngle("Enter angle", "", NullString, A_A_EMTPY, Point, 0, Angle) = A_GET_OK Then
  228.                tvalue.Text = Str(Angle)
  229.           End If
  230.       End If
  231.  End Select
  232.  Show 1
  233. End Sub
  234. Private Sub bDown_Click()
  235. 'decrease array index
  236. Dim i As Long
  237. i = CLng(tIndex.Text) - 1
  238. If i = -1 Then
  239.  Exit Sub
  240. End If
  241. If BaseFrm.Amoeba.X_SetIndex(pXData, -1, i, False) = -1 Then
  242.    MsgBox "Cannot decrease index", vbExclamation
  243.  tIndex.Text = Str(i)
  244. End If
  245. End Sub
  246. Private Sub bUplevel_Click()
  247. 'goes up one level, i.e. in the array
  248.     BaseFrm.Amoeba.X_SetIndex pXData, -1, -1, False
  249.     LoadXListBox
  250.     If lbLevel.Caption <> "Root" Then
  251.         If Val(lbLevel.Caption) = 1 Then
  252.             lbLevel.Caption = "Root"
  253.             lbIndex.Visible = False
  254.             bUplevel.Enabled = False
  255.             tIndex.Visible = False
  256.             bUp.Visible = False
  257.             bDown.Visible = False
  258.         Else
  259.             lbLevel.Caption = Str(Val(lbLevel.Caption) - 1)
  260.             tIndex.Text = "0"
  261.         End If
  262.     End If
  263. End Sub
  264. Private Sub bModify_Click()
  265. 'button modify
  266. '    caption "MODIFY" - modify value & change caption to "SAVE"
  267. '    caption "SAVE" - save value & change caption back to "MODIFY"
  268.  Dim ErrLine As Long
  269.  Dim VarValue As Variant
  270.  ErrLine = 0
  271.  On Error GoTo ErrorHandler
  272.  If bModify.Caption = "Save" Then
  273.     Dim d1 As Double, d2 As Double
  274.     Select Case XList.ItemData(XList.ListIndex)
  275.         Case A_X_POSITION, A_X_POINT, A_X_VECTOR, A_X_DIRECTION
  276.             ErrLine = 1
  277.             d1 = CDbl(tValueX.Text)
  278.             ErrLine = 2
  279.             d2 = CDbl(tValueY.Text)
  280.             Dim obj As Object
  281.             Set obj = CreateObject("ACC.POINT")
  282.             obj.x = d1
  283.             obj.y = d2
  284.             If BaseFrm.Amoeba.X_SetData(pXData, XList.ListIndex, XList.ItemData(XList.ListIndex), CVar(obj)) = -1 Then
  285.                 MsgBox "X-Data were not saved!"
  286.             Else
  287.                 'MsgBox "Items were saved" + Chr(10) + "X : " + Str(d1) + ", Y: " + Str(d2) + Chr(10) + "Type :" + Str(XList.ItemData(XList.ListIndex)) + ", index " + Str(XList.ListIndex) + Chr(10) + "Data : " + Str(pXData)
  288.             End If
  289.         Case A_X_CHAR
  290.             Dim CharValue As Byte
  291.             CharValue = Asc(Left(tvalue.Text, 1))
  292.             If BaseFrm.Amoeba.X_SetData(pXData, XList.ListIndex, XList.ItemData(XList.ListIndex), CharValue) = -1 Then
  293.                 MsgBox "X-Data were not saved!"
  294.             Else
  295.             '    MsgBox "Items were saved" + Chr(10) + "X : " + Str(d1) + ", Y: " + Str(d2) + Chr(10) + "Type :" + Str(XList.ItemData(XList.ListIndex)) + ", index " + Str(XList.ListIndex) + Chr(10) + "Data : " + Str(pXData)
  296.             End If
  297.         Case A_X_STRING
  298.             Dim StrValue As String
  299.             StrValue = tvalue.Text
  300.             If BaseFrm.Amoeba.X_SetData(pXData, XList.ListIndex, XList.ItemData(XList.ListIndex), CVar(StrValue)) = -1 Then
  301.                 MsgBox "X-Data were not saved!"
  302.             Else
  303.             '    MsgBox "Items were saved" + Chr(10) + "Type :" + Str(XList.ItemData(XList.ListIndex)) + ", index " + Str(XList.ListIndex) + Chr(10) + "Data : " + Str(pXData)
  304.             End If
  305.         Case A_X_DOUBLE, A_X_ANGLE, A_X_LENGTH
  306.             Dim DblValue As Double
  307.             ErrLine = 3
  308.             DblValue = CDbl(tvalue.Text)
  309.             If BaseFrm.Amoeba.X_SetData(pXData, XList.ListIndex, XList.ItemData(XList.ListIndex), DblValue) = -1 Then
  310.                 MsgBox "X-Data were not saved!"
  311.             Else
  312.             '    MsgBox "Items were saved" + Chr(10) + "Type :" + Str(XList.ItemData(XList.ListIndex)) + ", index " + Str(XList.ListIndex) + Chr(10) + "Data : " + Str(pXData)
  313.             End If
  314.         Case A_X_SHORT
  315.             Dim ShortValue As Integer
  316.             ErrLine = 3
  317.             ShortValue = CInt(tvalue.Text)
  318.             If BaseFrm.Amoeba.X_SetData(pXData, XList.ListIndex, XList.ItemData(XList.ListIndex), ShortValue) = -1 Then
  319.                 MsgBox "X-Data were not saved!"
  320.             Else
  321.             '    MsgBox "Items were saved" + Chr(10) + "Type :" + Str(XList.ItemData(XList.ListIndex)) + ", index " + Str(XList.ListIndex) + Chr(10) + "Data : " + Str(pXData)
  322.             End If
  323.         Case Else
  324.             ErrLine = 3
  325.             Dim ElseValue As Long
  326.             ElseValue = CLng(tvalue.Text)
  327.             If BaseFrm.Amoeba.X_SetData(pXData, XList.ListIndex, XList.ItemData(XList.ListIndex), CVar(ElseValue)) = -1 Then
  328.                 MsgBox "X-Data were not saved!"
  329.             Else
  330.             '    MsgBox "Items were saved" + Chr(10) + "X : " + Str(d1) + ", Y: " + Str(d2) + Chr(10) + "Type :" + Str(XList.ItemData(XList.ListIndex)) + ", index " + Str(XList.ListIndex) + Chr(10) + "Data : " + Str(pXData)
  331.             End If
  332.             
  333.     End Select
  334.     bModify.Caption = "Modify"
  335.     bModify.Default = False
  336.     bOK.Caption = "Close"
  337.     If lbLevel.Caption <> "Root" Then
  338.         bUplevel.Enabled = True
  339.     End If
  340.     bPick.Enabled = False
  341.     tValueX.Enabled = False
  342.     tValueY.Enabled = False
  343.     tvalue.Enabled = False
  344.     XList.Enabled = True
  345.     XList_Click
  346.  Else
  347.     If XList.ItemData(XList.ListIndex) = A_X_VCHUNK Or XList.ItemData(XList.ListIndex) = A_X_CCHUNK Then
  348.         MsgBox "Sorry, cannot handle byte chunks", vbInformation
  349.         Exit Sub
  350.     End If
  351.     bModify.Caption = "Save"
  352.     bOK.Caption = "Cancel"
  353.     Select Case XList.ItemData(XList.ListIndex)
  354.         Case A_X_POSITION, A_X_POINT, A_X_ANGLE, A_X_LENGTH, A_X_ENTITY, A_X_VECTOR, A_X_DIRECTION
  355.                 bPick.Enabled = True
  356.         Case Else
  357.                 bPick.Enabled = False
  358.     End Select
  359.     bUplevel.Enabled = False
  360.     XList.Enabled = False
  361.     Select Case XList.ItemData(XList.ListIndex)
  362.         Case A_X_POSITION, A_X_POINT, A_X_VECTOR, A_X_DIRECTION
  363.             tvalue.Enabled = False
  364.             tvalue.Visible = False
  365.             tValueX.Visible = True
  366.             tValueY.Visible = True
  367.             tValueX.Enabled = True
  368.             tValueY.Enabled = True
  369.             lbvalue1.Caption = "X value"
  370.             lbvalue2.Visible = True
  371.             tValueX.SetFocus
  372.             tValueX.SelStart = 0
  373.             tValueX.SelLength = Len(tValueX.Text)
  374.         Case Else
  375.             tvalue.Enabled = True
  376.             tvalue.Visible = True
  377.             tValueX.Visible = False
  378.             tValueY.Visible = False
  379.             tValueX.Enabled = False
  380.             tValueY.Enabled = False
  381.             lbvalue1.Caption = "Value"
  382.             lbvalue2.Visible = False
  383.             tvalue.SetFocus
  384.             tvalue.SelStart = 0
  385.             tvalue.SelLength = Len(tvalue.Text)
  386.     End Select
  387.  End If
  388.  On Error GoTo 0
  389.  On Error Resume Next
  390. Exit Sub
  391. ErrorHandler:
  392.     MsgBox "Incorrect value ", 48
  393. Select Case ErrLine
  394.     Case 1
  395.         tValueX.SetFocus
  396.         tValueX.SelStart = 0
  397.         tValueX.SelLength = Len(tValueX.Text)
  398.     Case 2
  399.         tValueY.SetFocus
  400.         tValueY.SelStart = 0
  401.         tValueY.SelLength = Len(tValueY.Text)
  402.     Case 3
  403.         tvalue.SetFocus
  404.         tvalue.SelStart = 0
  405.         tValueY.SelLength = Len(tvalue.Text)
  406.     Case Else
  407. End Select
  408. End Sub
  409. Private Sub bOK_Click()
  410.  If bOK.Caption = "Cancel" Then
  411.     bOK.Caption = "Close"
  412.     bModify.Caption = "Modify"
  413.     bModify.Default = False
  414.     bPick.Enabled = False
  415.     If lbLevel.Caption <> "Root" Then
  416.         bUplevel.Enabled = True
  417.     End If
  418.     tvalue.Enabled = False
  419.     tValueX.Enabled = False
  420.     tValueY.Enabled = False
  421.     XList.Enabled = True
  422.     XList_Click
  423.  Else
  424.     If BaseFrm.Amoeba.X_PutData(pEntity, pXData) = -1 Then
  425.             MsgBox "Could not write XData", vbExclamation
  426.     End If
  427.     If BaseFrm.Amoeba.X_FreeData(pXData) = -1 Then
  428.         MsgBox "Error freeing XData", vbExclamation
  429.     End If
  430.     Unload frmXDView
  431.  End If
  432. End Sub
  433. Private Sub bUp_Click()
  434. 'increases array index
  435. Dim i As Long, j As Long
  436. Dim xType As Long, xValue As Variant
  437. i = CLng(tIndex.Text) + 1
  438. j = BaseFrm.Amoeba.X_SetIndex(pXData, -1, i, False)
  439. If j = -1 Then
  440.    MsgBox "Cannot increase index", vbExclamation
  441.  If BaseFrm.Amoeba.X_GetData(pXData, 0, xType, xValue) = -1 Then
  442.    Exit Sub
  443.  Else
  444.   tIndex.Text = Str(i)
  445.  End If
  446. End If
  447. End Sub
  448. Private Sub Form_Load()
  449.     XDataTypeStr(A_X_ARRAY) = "array"
  450.     XDataTypeStr(A_X_STRING) = "variable length string"
  451.     XDataTypeStr(A_X_CHAR) = "char"
  452.     XDataTypeStr(A_X_SHORT) = "16-bit integer"
  453.     XDataTypeStr(A_X_LONG) = "32-bit integer"
  454.     XDataTypeStr(A_X_DOUBLE) = "double"
  455.     XDataTypeStr(A_X_POINT) = "point/vector not transformated"
  456.     XDataTypeStr(A_X_LENGTH) = "double length transformated"
  457.     XDataTypeStr(A_X_ANGLE) = "double angle transformated (radians)"
  458.     XDataTypeStr(A_X_MIRROR) = "32-bit integer mirror flag"
  459.     XDataTypeStr(A_X_POSITION) = "point transformated"
  460.     XDataTypeStr(A_X_VECTOR) = "vector transformated (not moved)"
  461.     XDataTypeStr(A_X_DIRECTION) = "direction transformated (not moved or scaled)"
  462.     XDataTypeStr(A_X_ENTITY) = "index of element"
  463.     XDataTypeStr(A_X_VCHUNK) = "variable length chunk of bytes"
  464.     XDataTypeStr(A_X_CCHUNK) = "fixed length chunk of bytes"
  465. End Sub
  466. Public Function XDataToStr(xType As Long, xValue As Variant) As String
  467. XDataToStr = ""
  468. Select Case xType
  469.     Case A_X_ANGLE
  470.     Case A_X_ARRAY
  471.     Case A_X_CHAR
  472.     Case A_X_DIRECTION
  473.     Case A_X_DOUBLE
  474.     Case A_X_ENTITY
  475.     Case A_X_LENGTH
  476.     Case A_X_LONG
  477.     Case A_X_MIRROR
  478.     Case A_X_POINT
  479.         XDataToStr = Str(xValue(0)) + ";" + Str(xValue(1))
  480.     Case A_X_POSITION
  481.         XDataToStr = Str(xValue(0)) + ";" + Str(xValue(1))
  482.     Case A_X_SHORT
  483.     Case A_X_STRING
  484.         XDataToStr = xValue
  485.     Case A_X_VECTOR
  486.         XDataToStr = Str(xValue(0)) + ";" + Str(xValue(1))
  487. End Select
  488. End Function
  489. Private Sub tIndex_Change()
  490. On Error GoTo ErrorHandler
  491. Dim i As Long, j As Long
  492. i = CLng(tIndex.Text)
  493. On Error GoTo 0
  494. On Error Resume Next
  495. LoadXListBox
  496. Exit Sub
  497. ErrorHandler:
  498.     MsgBox "Input correct numeric value ", 48
  499.     tIndex.Text = "0"
  500. End Sub
  501. Private Sub tIndex_KeyDown(KeyCode As Integer, Shift As Integer)
  502.  If KeyCode = vbKeyReturn Then
  503.     XList.SetFocus
  504.  End If
  505. End Sub
  506. Private Sub tIndex_LostFocus()
  507. On Error GoTo ErrorHandler
  508. Dim i As Long, j As Long
  509. Dim xType As Long, xValue As Variant
  510. i = CLng(tIndex.Text)
  511. On Error GoTo 0
  512. On Error Resume Next
  513. j = BaseFrm.Amoeba.X_SetIndex(pXData, -1, i, False)
  514. If j = -1 Then
  515.    MsgBox "Cannot increase index", vbExclamation
  516.    Exit Sub
  517.  If BaseFrm.Amoeba.X_GetData(pXData, 0, xType, xValue) = -1 Then
  518.    MsgBox "Cannot get data with given index", vbExclamation
  519.    BaseFrm.Amoeba.X_SetIndex pXData, -1, 0, False
  520.    tIndex.Text = "0"
  521.    Exit Sub
  522.  End If
  523. End If
  524. LoadXListBox
  525. Exit Sub
  526. ErrorHandler:
  527.     MsgBox "Input correct numeric value", 48
  528. End Sub
  529. Private Sub tvalue_GotFocus()
  530.   tvalue.SelStart = 0
  531.   tvalue.SelLength = Len(tvalue.Text)
  532.   If tvalue.Enabled = True Then
  533.     bModify.Default = True
  534.   End If
  535. End Sub
  536. Private Sub tValueX_GotFocus()
  537.    tValueX.SelStart = 0
  538.    tValueX.SelLength = Len(tValueX.Text)
  539. End Sub
  540. Private Sub tValueX_KeyDown(KeyCode As Integer, Shift As Integer)
  541.  If KeyCode = vbKeyReturn Then
  542.   tValueY.SetFocus
  543.  End If
  544. End Sub
  545. Private Sub tValueY_GotFocus()
  546.         tValueY.SelStart = 0
  547.         tValueY.SelLength = Len(tValueY.Text)
  548.  If tValueY.Enabled = True Then
  549.     bModify.Default = True
  550.  End If
  551. End Sub
  552. Private Sub XList_Click()
  553. 'click on a listbox item
  554. 'this sub displays item's value depending on its type
  555. Dim XT As Long, Index As Long
  556. Dim XV As Variant
  557. Index = XList.ListIndex
  558. If XList.ItemData(Index) = A_X_ARRAY Then
  559.  bModify.Enabled = False
  560.  bModify.Enabled = True
  561. End If
  562. If BaseFrm.Amoeba.X_GetData(pXData, Index, XT, XV) = -1 Then
  563.    MsgBox "X_GetData failed!"
  564.  Exit Sub
  565. End If
  566. Select Case XT
  567.     Case A_X_POSITION, A_X_POINT, A_X_VECTOR, A_X_DIRECTION
  568.         ShowXYValues XT, XV
  569.     Case Else
  570.         ShowValue XT, XV
  571. End Select
  572. End Sub
  573. Public Function GetXDataTypeStr(xType As Long) As String
  574. Select Case xType
  575.     Case A_X_ANGLE
  576.         GetXDataTypeStr = "Angle"
  577.     Case A_X_ARRAY
  578.         GetXDataTypeStr = "Array"
  579.     Case A_X_CHAR
  580.         GetXDataTypeStr = "Char"
  581.     Case A_X_DIRECTION
  582.         GetXDataTypeStr = "Direction"
  583.     Case A_X_DOUBLE
  584.         GetXDataTypeStr = "Double"
  585.     Case A_X_ENTITY
  586.         GetXDataTypeStr = "Entity"
  587.     Case A_X_LENGTH
  588.         GetXDataTypeStr = "Length"
  589.     Case A_X_LONG
  590.         GetXDataTypeStr = "Long"
  591.     Case A_X_MIRROR
  592.         GetXDataTypeStr = "Mirror"
  593.     Case A_X_POINT
  594.         GetXDataTypeStr = "Point"
  595.     Case A_X_POSITION
  596.         GetXDataTypeStr = "Position"
  597.     Case A_X_SHORT
  598.         GetXDataTypeStr = "Short"
  599.     Case A_X_STRING
  600.         GetXDataTypeStr = "String"
  601.     Case A_X_VECTOR
  602.         GetXDataTypeStr = "Vector"
  603.     Case Else
  604.         GetXDataTypeStr = "Unknown type"
  605. End Select
  606. End Function
  607. Public Sub ShowXYValues(xType As Long, V As Variant)
  608. 'displays item consisting of two values
  609. Dim x As Double, y As Double
  610. x = V.x
  611. y = V.y
  612. tvalue.Enabled = False
  613. tvalue.Visible = False
  614. tValueX.Visible = True
  615. tValueY.Visible = True
  616. lbvalue1.Visible = True
  617. lbvalue1.Caption = "X value"
  618. lbvalue2.Visible = True
  619. tValueX.Text = Str(x)
  620. tValueY.Text = Str(y)
  621. Exit Sub
  622. End Sub
  623. Public Sub ShowValue(xType As Long, V As Variant)
  624. 'display item consisting of one value
  625. tValueX.Visible = False
  626. tValueY.Visible = False
  627. tvalue.Visible = True
  628. lbvalue2.Visible = False
  629. lbvalue1.Visible = True
  630. lbvalue1.Caption = "Value"
  631. Dim s As String
  632. s = ""
  633. Select Case xType
  634.     Case A_X_ARRAY
  635.         lbvalue1.Visible = False
  636.         s = "Double click listbox item to see array contents"
  637.     Case A_X_STRING
  638.         s = V
  639.     Case A_X_CHAR
  640.         s = Chr(V)
  641.     Case Else
  642.         s = Str(V)
  643. End Select
  644. tvalue.Text = s
  645. End Sub
  646. Private Sub XList_DblClick()
  647. If XList.ItemData(XList.ListIndex) = A_X_ARRAY Then
  648.     Dim i As Long
  649.     i = BaseFrm.Amoeba.X_SetIndex(pXData, XList.ListIndex, 0, False)
  650.     If i <> 0 Then
  651.         MsgBox "SetIndex: " + Str(XList.ListIndex) + Chr(10) + "returned :" + Str(i)
  652.     End If
  653.     bUplevel.Caption = "Up level"
  654.     bUplevel.Enabled = True
  655.     lbIndex.Visible = True
  656.     bUp.Visible = True
  657.     bDown.Visible = True
  658.     tIndex.Visible = True
  659.     tIndex.Text = "0"
  660.     If lbLevel.Caption <> "Root" Then
  661.         lbLevel.Caption = Str(Val(lbLevel.Caption) + 1)
  662.     Else
  663.         lbLevel.Caption = "1"
  664.     End If
  665.     LoadXListBox
  666. End If
  667. End Sub
  668. Public Sub LoadXListBox()
  669. 'fill listbox with X-Data items
  670.  Dim xType As Long, xValue As Variant
  671.  Dim i As Long
  672.  i = 0
  673.  XList.Clear
  674.  Do While True
  675.     If BaseFrm.Amoeba.X_GetData(pXData, i, xType, xValue) = -1 Then
  676.         Exit Do
  677.     End If
  678.     XList.AddItem XDataTypeStr(xType)
  679.     XList.ItemData(XList.NewIndex) = xType
  680.     i = i + 1
  681.  Loop
  682.  If i > 0 Then
  683.     XList.ListIndex = 0
  684.  End If
  685. End Sub
  686. Private Sub XList_KeyDown(KeyCode As Integer, Shift As Integer)
  687. If KeyCode = vbKeyReturn Then
  688.     XList_DblClick
  689.     If KeyCode = vbKeyBack Then
  690.         bUplevel_Click
  691.     End If
  692. End If
  693. End Sub
  694. Public Sub GetXDataHandle(pXD As Long, pE As Long)
  695.  pXData = pXD
  696.  pEntity = pE
  697. End Sub
  698.