Chip 1997 January/Chip_1997-01_cd.bin/ms95/disk21/dir03/f000850.re_/f000850.re

Text File | 1996-04-02 | 17KB | 523 lines

' Example produces a table in a design file from comma-delimited file
'
'--------------------------------------------------------------------
'
'  Copyright (1995) Bentley Systems, Inc., All rights reserved.
'
'   $Workfile:   table.bas  $
'   $Revision:   6.4  $
'       $Date:   10 Aug 1995 14:34:06  $
'
'  "MicroStation" is a registered trademark of Bentley Systems, Inc.
'
'  Limited permission is hereby granted to reproduce and modify this
'  copyrighted material provided that the resulting code is used only
'  in conjunction with Bentley Systems products under the terms of the
'  license agreement provided therein, and that this notice is retained
'  in its entirety in any such reproduction or modification.
'
'--------------------------------------------------------------------
' This example displays the standard file open dialog box to allow
' the user to select a comma-delimited file to incorporate into his
' design file as a table. It reads the file, treating each line in
' the file as a row and the comma delimiters as column separators.
' If the file is successfully read, it presents a custom dialog box
' to the user allowing him to set table parameters like line symbology
' for the individual table components, text size and spacing.
' It then draws the table into the design file.
'--------------------------------------------------------------------
Type TableSymbology
    color  as Integer
    weight as Integer
    style  as Integer
End Type

Type TableParams
    columnWidth as Double
    rowHeight   as Double
    textHeight  as Double
    textWidth   as Double
    wantHdgSep  as Integer
    wantColSep  as Integer
    wantRowSep  as Integer
    lineSymb(1 To 5) as TableSymbology
End Type

Const OUTLINE   = 1
Const HDGSEP    = 2
Const ROWSEP    = 3
Const COLSEP     = 4
Const TABLETEXT = 5

Const CANCELLED = 1

'---------------------------------------------------------------
'
' table_openFile - gets file name from user, opens it.
'                  Returns MBE_Success if successful,
'                  Fills in fileNum and fileName for later use
'
'---------------------------------------------------------------
Function table_openFile (fileName as String, fileNum as Integer)
    Dim status as Integer

    fileNum = FreeFile
    status = MbeFileOpen (fileName, "*.txt", _
                   "*.txt,Text Files [*.txt],*.csv,CSV Files [*.csv]", _
                                  "", "Table Input File")

    If status = MBE_Success Then
        On Error Goto CantOpen
        Open fileName For Input Access Read as fileNum
    End if
        table_openFile = status
    Exit Function

CantOpen:
    status = -1
    Resume Next

End Function

'---------------------------------------------------------------
'
' table_parseInputString - parse the comma-delimited input string
'
'---------------------------------------------------------------
Function table_parseInputString (outStrings() as String, inString as String)
    Dim stringNum   as Integer
    Dim commaPos    as Integer
    Dim tmpString   as String
    Dim blankOK     as Integer

    stringNum = 0
    Redim outStrings (1 to 1)

    Do
        commaPos = Instr (inString, ",", 0)

        tmpString = NULL

        If commaPos <> 0 Then
            tmpString = Left$ (inString, commaPos - 1)
            inString  = Mid$  (inString, commaPos + 1)
            ' allow empty strings (e.g. first col,,third col)
            blankOK = 1
        Else
            tmpString = inString
        End If

        If (Len (tmpString) <> 0) Or blankOK Then
            stringNum = stringNum + 1
            Redim Preserve outStrings (1 to stringNum)
            outStrings (stringNum) = tmpString
        End If

    Loop While commaPos <> 0

    If stringNum > 0 Then
        table_parseInputString = MBE_Success
    Else
        ' blank line
        table_parseInputString = -1
    End If

End Function

'---------------------------------------------------------------
'
' table_readEntries - reads the entries into the array
'
'---------------------------------------------------------------
Function table_readEntries (tableStrings() as String, numRows as Integer, _
                             fileNum as Integer, allowBlank as Integer)

    Dim inputString  as String
    Dim rowNum       as Integer
    Dim maxColumns   as Integer
    Dim inputColumns as Integer
    Dim columnNum    as Integer
    Dim iColumn      as Integer
    Dim newTableRows as Integer
    Dim rowStrings() as String

    rowNum = 1
    maxColumns = 4

    On Error Goto noMoreInput

    While not Eof (fileNum)
        Line Input fileNum, inputString

        ' parse the input line
        status = table_parseInputString (rowStrings, inputString)

        If (status = MBE_Success) Or AllowBlank Then
            inputColumns = UBound(rowStrings) - LBound (rowStrings) + 1

            If inputColumns > maxColumns Then
                maxColumns = inputColumns
                Redim Preserve tableStrings (1 to UBound(tableStrings, 1),_
                                             1 to maxColumns)
            End If

            For iColumn = 1 to inputColumns
                tableStrings (rowNum, iColumn) = rowStrings (iColumn)
            Next iColumn

            rowNum = rowNum + 1

            If (rowNum Mod 10) = 0 Then
                newTableRows = 10 * ((rowNum \ 10) + 1)
                If (newTableRows > UBound (tableStrings, 1)) Then
                    Redim Preserve tableStrings (1 to newTableRows,_
                                                 1 to UBound (tableStrings, 2))
                End If
            End If
        End If
    Wend


noMoreInput:
    numRows = rowNum - 1

    If numRows > 0 Then
        text_readEntries = MBE_Success
    Else
        text_readEntries = -1
    End If

    Resume doneReading

doneReading:
    Close fileNum

    Exit Function
End Function

'---------------------------------------------------------------
'
' table_getTableParams - gets table parameters
'
'---------------------------------------------------------------
Function table_getTableParams (table as TableParams)

    Dim status       as Integer
    Dim buttonVal    as Long

    table.wantHdgSep  = 1
    table.wantColSep  = 1
    table.wantRowSep  = 1

    table.columnWidth = 3.0
    table.rowHeight   = 0.3
    table.textHeight  = 0.2
    table.textWidth   = 0.15

    table.lineSymb(OUTLINE).color = 0
    table.lineSymb(HDGSEP).color  = 4
    table.lineSymb(COLSEP).color  = 2
    table.lineSymb(ROWSEP).color  = 5

    table.lineSymb(OUTLINE).weight = 2
    table.lineSymb(HDGSEP).weight  = 1
    table.lineSymb(COLSEP).weight  = 0
    table.lineSymb(ROWSEP).weight  = 0

    table.lineSymb(OUTLINE).style  = 0
    table.lineSymb(HDGSEP).style   = 0
    table.lineSymb(COLSEP).style   = 0
    table.lineSymb(ROWSEP).style   = 1

    buttonVal = MbeOpenModalDialog (1)

    If (buttonVal < 0) Or (buttonVal = MBE_BUTTON_OK) Then
        table_getTableParams = MBE_Success
    Else
        table_getTableParams = CANCELLED
    End If

End Function

'---------------------------------------------------------------
'
' table_drawOutline - draws outline into design file
'
'---------------------------------------------------------------
Sub table_drawOutline (origin as MbePoint, view as Integer, _
               totalWidth as Double, totalHeight as Double)
    Dim point as MbePoint

    point = origin
    Call MbeSendCommand ("PLACE SHAPE")
    Call MbeSendDataPoint (origin, view)
    point.x = origin.x + totalWidth
    Call MbeSendDataPoint (point, view)
    point.y = origin.y - totalHeight
    Call MbeSendDataPoint (point, view)
    point.x = origin.x
    Call MbeSendDataPoint (point, view)
    point.y = origin.y
    Call MbeSendDataPoint (point, view)
End Sub

'---------------------------------------------------------------
'
' table_drawTable - draws table into design file
'
'---------------------------------------------------------------
Sub table_drawTable (table as TableParams, tableStrings() as String, numRows as Integer)

    Dim columns     as Integer
    Dim totalWidth  as Double
    Dim totalHeight as Double
    Dim saveColor   as Integer
    Dim saveStyle   as Integer
    Dim saveWeight  as Integer
    Dim saveTxJust  as Integer
    Dim saveAngle   as Double
    Dim saveTxHght  as Double
    Dim saveTxWdth  as Double
    Dim point       as MbePoint
    Dim iCol        as Integer
    Dim iRow        as Integer
    Dim offset      as Double
    Dim eofPos      as Long
    Dim view        as Integer
    Dim origin         as MbePoint
    Dim saveLocTol  as Integer
    Dim saveParse   as Integer

    saveColor    = MbeSettings.color
    saveStyle    = MbeSettings.lineStyle
    saveWeight   = MbeSettings.weight
    saveAngle    = MbeSettings.angle

    saveTxJust   = MbeSettings.textJustification
    saveTxHght   = MbeSettings.textHeight
    saveTxWdth   = MbeSettings.textWidth

    ' We set the locate tolerance to make sure that our PLACE SHAPE
    '  works OK at all zoom levels
    saveLocTol   = MbeState.locateTolerance
    MbeState.locateTolerance = 0

    ' Set parseAll off so MicroStation doesn't try to parse the text
    saveParse    = MbeState.parseAll
    MbeState.parseAll = 0

    On Error Goto cleanup

    ' turn off messages
    MbeState.messages = 0

    ' put everything into a graphic group
    MbeSettings.currentGraphicGroup = MbeDgnInfo.nextGraphicGroup
    MbeSettings.angle = 0.0

    ' set up an undo mark
    Call MbeSendCommand ("Mark")

    columns = UBound(tableStrings,2) - LBound(tableStrings,2) + 1

    totalWidth  = columns * table.columnWidth
    totalHeight = numRows * table.rowHeight

    ' Draw the outline shape at position 0,0 in the design file
    MbeSettings.color     = table.lineSymb(OUTLINE).color
    MbeSettings.lineStyle = table.lineSymb(OUTLINE).style
    MbeSettings.weight    = table.lineSymb(OUTLINE).weight

    origin.x = 0
    origin.y = 0
    origin.z = 0
    view = 1

    ' save file position so we can locate outline shape after placing
    eofPos = MbeDgnInfo.endOfFile

    MbeCurrentTransform.fromView view
    MbeState.noElementDisplay = TRUE

    Call table_drawOutline (origin, view, totalWidth, totalHeight)

    ' Start the Move command to get dynamics
    Call MbeSendCommand ("MOVE")

    ' Locate the shape we just placed
    Call MbeLocateElement (eofPos)

    ' now get the table position
    Call MbeWritePrompt ("Position table or Reset to exit")

    ' wait for data or reset
    Call MbeGetInput (MBE_DataPointInput, MBE_ResetInput)

    ' clear the prompt, give "in progress" message
    Call MbeWritePrompt ("")

    ' reset aborts, data point gives upper left corner
    If MbeState.inputType = MBE_ResetInput Then
        ' delete the shape we placed
        Call MbeSendCommand ("DELETE")
        Call MbeLocateElement (eofPos)
        Call MbeSendDataPoint (point, view)

        Goto cleanupNoMsg
    ElseIf MbeState.inputType = MBE_DataPointInput Then
        ' get the datapoint as the origin
        stat = MbeState.getInputDataPoint (origin, view)

    ' delete the shape (can't use it because it's at wrong depth in 3D)
        Call MbeSendCommand ("DELETE")
        Call MbeLocateElement (eofPos)
        Call MbeSendDataPoint (point, view)
    Call MbeWriteStatus ("Generating Table")
    End If

    MbeState.noElementDisplay = FALSE

    ' set transform back to master units
    MbeCurrentTransform.masterUnits
    ' set the transform from the selected view
    MbeCurrentTransform.fromView view

    ' place the outline (again, but with right transform and depth)
    Call table_drawOutline (origin, view, totalWidth, totalHeight)
    point = origin

    ' Draw the heading separator
    If table.wantHdgSep <> 0 Then
        MbeSettings.color     = table.lineSymb(HDGSEP).color
        MbeSettings.lineStyle = table.lineSymb(HDGSEP).style
        MbeSettings.weight    = table.lineSymb(HDGSEP).weight
        Call MbeSendCommand ("PLACE LINE")
        point.x = origin.x
        point.y = origin.y - table.rowHeight
        Call MbeSendDataPoint (point, view)
        point.x = origin.x + totalWidth
        Call MbeSendDataPoint (point, view)
        MbeSendReset
    End If

    ' Draw the column separators
    If table.wantColSep <> 0 Then
        MbeSettings.color     = table.lineSymb(COLSEP).color
        MbeSettings.lineStyle = table.lineSymb(COLSEP).style
        MbeSettings.weight    = table.lineSymb(COLSEP).weight
        For iCol = 1 To columns - 1
            point.x = origin.x + iCol * table.columnWidth
            point.y = origin.y
            Call MbeSendDataPoint (point, view)
            point.y = origin.y - totalHeight
            Call MbeSendDataPoint (point, view)
            MbeSendReset
        Next iCol
    End If

    ' Draw the row separators
    If table.wantRowSep <> 0 Then
        MbeSettings.color     = table.lineSymb(ROWSEP).color
        MbeSettings.lineStyle = table.lineSymb(ROWSEP).style
        MbeSettings.weight    = table.lineSymb(ROWSEP).weight
        For iRow = 1 To numRows - 1
            point.x = origin.x
            point.y = origin.y - table.rowHeight * (iRow + 1)
            Call MbeSendDataPoint (point, view)
            point.x = origin.x + totalWidth
            Call MbeSendDataPoint (point, view)
            MbeSendReset
        Next iRow
    End If

    ' Draw the actual text
    MbeSettings.color     = table.lineSymb(TABLETEXT).color
    MbeSettings.lineStyle = table.lineSymb(TABLETEXT).style
    MbeSettings.weight    = table.lineSymb(TABLETEXT).weight
    MbeSettings.textJustification = MBE_LeftTop

    MbeSettings.textHeight = table.textHeight
    MbeSettings.textWidth  = table.textWidth
    offset = (table.rowHeight - table.textHeight) / 2
    Call MbeSendCommand ("PLACE TEXT")
    For iRow = 1 To numRows
        For iCol = 1 to columns
            If Len (tableStrings (iRow, iCol)) <> 0 Then
                point.x = origin.x + table.textWidth + table.columnWidth * (iCol - 1)
                point.y = origin.y - offset - table.rowHeight * (iRow - 1)
                Call MbeSendKeyin (tableStrings (iRow, iCol))
                Call MbeSendDataPoint (point, view)
            End If
        Next iCol
    Next iRow
    Call MbeSendCommand ("NULL")

cleanup:
    Call MbeWriteStatus ("Table completed")

cleanupNoMsg:
    ' set transform back to master units
    MbeCurrentTransform.masterUnits

    MbeSettings.color       = saveColor
    MbeSettings.lineStyle   = saveStyle
    MbeSettings.weight      = saveWeight
    MbeSettings.angle        = saveAngle

    MbeSettings.textJustification = saveTxJust
    MbeSettings.textHeight = saveTxHght
    MbeSettings.textWidth  = saveTxWdth

    MbeSettings.currentGraphicGroup = 0
    MbeState.messages         = 1
    MbeState.noElementDisplay = FALSE
    MbeState.locateTolerance  = saveLocTol
    MbeState.parseAll          = saveParse

End Sub

'---------------------------------------------------------------
'
' Main Entry point
'
'---------------------------------------------------------------
Sub Main
    Dim tableStrings() as String
    Dim fileName$ as String
    Dim fileNum   as Integer
    Dim status    as Integer
    Dim numRows   as Integer
    Dim tableInfo as TableParams


    ' start tableString size as something reasonable
    Redim tableStrings (1 to 10, 1 to 4)

    ' Start MicroStation off at a known state
    Call MbeSendCommand ("NULL")

    status = table_openFile (fileName$, fileNum)

    If status <> MBE_Success Then
        If status <> CANCELLED Then
            MbeMessageBox ("Can't open file")
        End If
        Exit Sub
    End If

    ' read the file once to get the entry count
    If table_readEntries (tableStrings, numRows, fileNum, TRUE) <> MBE_Success Then
        MbeMessageBox ("File is wrong format")
        Exit Sub
    End If

    If table_getTableParams(tableInfo) <> MBE_Success Then
        Exit Sub
    End If

    Call table_drawTable (tableInfo, tableStrings, numRows)

End Sub