Chip 1998 March/Chip_1998-03_cd.bin/tema/jpcad/ACC/SAMPLES/XDVIEW/BASEFRM.FR_/BASEFRM.FR

Visual Basic Form | 1998-01-21 | 5.5 KB | 174 lines

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