home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form BaseFrm
- Caption = "Form1"
- ClientHeight = 840
- ClientLeft = 1140
- ClientTop = 1515
- ClientWidth = 1560
- Height = 1200
- Left = 1080
- LinkTopic = "Form1"
- ScaleHeight = 840
- ScaleWidth = 1560
- Top = 1215
- Width = 1680
- Begin ACCLib.Amoeba Amoeba
- Left = 240
- Top = 240
- _Version = 65536
- _ExtentX = 847
- _ExtentY = 847
- _StockProps = 0
- End
- Attribute VB_Name = "BaseFrm"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Dim XDataTypeStr(30) As String
- Option Explicit
- Private Sub Amoeba_Drag(ByVal UserData As Variant, ByVal Point As Object, Trans As Object, nStatus As Long)
- 'draw dragging line
- Amoeba.DrawLine UserData, Point
- End Sub
- Private Sub Amoeba_Error(ByVal nErrorCode As Long)
- If nErrorCode <= -1000 Then
- MsgBox "JPCAD Error " + Str$(nErrorCode) + Chr(10) + "Ending XDView application"
- End
- End If
- End Sub
- Private Sub Amoeba_Status(ByVal nStatus As Long, ByVal nCmdCode As Long)
- 'handles Amoeba requests
- Dim Result As Long
- Select Case nStatus
- Case A_LOAD
- 'program was loaded into Amoeba
- Result = Amoeba.DefCmd("xdview", 0, 0)
- Result = Amoeba.DefCmd("xdcreate", 1, 0)
- Prompt "XDVIEW - new commands defined: xdcreate, xdview"
- Case A_UNLOAD
- 'unloading request from Amoeba
- Prompt "XDVIEW - unloading"
- ' do not quit here ....
- Case A_END
- ' ...but here
- Unload Me
- Case A_CMD_CALL
- 'command was called - pass control to appropriate sub according to nCmdCode
- Select Case nCmdCode
- Case 0
- XDViewBase
- Case 1
- frmXDCreate.Show 1
- Case Else
- 'Bad procedure code
- End Select
- End Select
- End Sub
- Private Sub Form_Load()
- Hide
- End Sub
- Public Sub XDViewBase()
- ' main sub for XDVIEW command
- 'X-data types descriptions
- XDataTypeStr(A_X_ARRAY) = "array"
- XDataTypeStr(A_X_STRING) = "variable length string"
- XDataTypeStr(A_X_CHAR) = "char"
- XDataTypeStr(A_X_SHORT) = "16-bit integer"
- XDataTypeStr(A_X_LONG) = "32-bit integer"
- XDataTypeStr(A_X_DOUBLE) = "double"
- XDataTypeStr(A_X_POINT) = "point/vector not transformated"
- XDataTypeStr(A_X_LENGTH) = "double length transformated"
- XDataTypeStr(A_X_ANGLE) = "double angle transformated (radians)"
- XDataTypeStr(A_X_MIRROR) = "32-bit integer mirror flag"
- XDataTypeStr(A_X_POSITION) = "point transformated"
- XDataTypeStr(A_X_VECTOR) = "vector transformated (not moved)"
- XDataTypeStr(A_X_DIRECTION) = "direction transformated (not moved or scaled)"
- XDataTypeStr(A_X_ENTITY) = "index of element"
- XDataTypeStr(A_X_VCHUNK) = "variable length chunk of bytes"
- XDataTypeStr(A_X_CCHUNK) = "fixed length chunk of bytes"
- XDataModified = False
- Dim NullString As String
- Dim description As String
- Dim sPos As Long
- Dim xType As Long
- Dim xValue As Variant
- Dim Point As Object
- Dim i As Long
- 'select entity to scan for X-Data
- Set Point = CreateObject("ACC.Point")
- i = Amoeba.GetEnt("Handle/Select entity", "H,Handle", NullString, pEntity, Point)
- If i = A_GET_CANCEL Then
- Amoeba.Prompt Chr(13) + "Bad selection"
- Exit Sub
- End If
- If i = A_GET_KWORD Then
- i = Amoeba.GetLong("Entity handle", NullString, NullString, pEntity)
- If i <> A_GET_OK Then
- Amoeba.Prompt Chr(13) + "Bad selection"
- Exit Sub
- End If
- End If
- Loop While i <> A_GET_OK
- i = 0
- 'count X-Data structures on selected entity
- Do While BaseFrm.Amoeba.X_GetStruct(pEntity, i, pStruct) <> -1
- i = i + 1
- Loop
- If i > 1 Then
- 'more than one structure, so let the user select
- frmSelectXData.Show 1
- If m_quitting Then
- Exit Sub
- End If
- Else
- If i = 0 Then
- Prompt "No X-Data found."
- Exit Sub
- Else
- If BaseFrm.Amoeba.X_GetStruct(pEntity, 0, pStruct) = -1 Then
- Prompt "Error during loading X-Data description"
- Exit Sub
- End If
- frmXDView.XList.Clear
- End If
- End If
- If BaseFrm.Amoeba.X_GetDesc(pStruct, description) = -1 Then
- Prompt "Could not read X-Data description"
- Exit Sub
- End If
- If BaseFrm.Amoeba.X_CreateData(pStruct, pEntity, True, pXData) = -1 Then
- Prompt "CreateData failed"
- Exit Sub
- End If
- If BaseFrm.Amoeba.X_SetIndex(pXData, -1, -1, True) = -1 Then
- Prompt "SetIndex failed"
- Exit Sub
- End If
- sPos = InStr(description, ";")
- If sPos > 0 Then
- frmXDView.lbUserdescription.Caption = Left(description, sPos - 1)
- frmXDView.Caption = "XData view - " + frmXDView.lbUserdescription.Caption
- description = Right(description, Len(description) - sPos)
- End If
- Prompt "Description : " + description
- frmXDView.lbDescription.Caption = description
- i = 0
- 'retrieve all variables
- Do While True
- If BaseFrm.Amoeba.X_GetData(pXData, i, xType, xValue) = -1 Then
- Exit Do
- End If
- frmXDView.XList.AddItem XDataTypeStr(xType)
- frmXDView.XList.ItemData(frmXDView.XList.NewIndex) = xType
- i = i + 1
- Loop
- If frmXDView.XList.ListCount > 0 Then
- frmXDView.XList.ListIndex = 0
- End If
- 'show main window
- frmXDView.Show 1
- End Sub
- Public Sub Prompt(s As String)
- 'appends new-line character at the beginning of the prompt string
- BaseFrm.Amoeba.Prompt Chr(10) + s
- End Sub
-