frmobjectinfo.frm

用VB开发的巡检系统基于MAPINFo用VB开发的巡检系统基于MAPINFo很好的

VERSION 5.00
Begin VB.Form frmObjectInfo 
   BorderStyle     =   5  'Sizable ToolWindow
   Caption         =   "信息工具"
   ClientHeight    =   6810
   ClientLeft      =   60
   ClientTop       =   330
   ClientWidth     =   3600
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6810
   ScaleWidth      =   3600
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox txtField 
      Appearance      =   0  'Flat
      Height          =   285
      Index           =   0
      Left            =   1560
      TabIndex        =   4
      Top             =   90
      Width           =   1965
   End
   Begin VB.Frame Frame2 
      Height          =   645
      Left            =   30
      TabIndex        =   0
      Top             =   6150
      Width           =   3555
      Begin VB.CommandButton cmdUpdate 
         Caption         =   "保存"
         Height          =   405
         Left            =   810
         TabIndex        =   6
         Top             =   180
         Width           =   705
      End
      Begin VB.CommandButton cmdPrevious 
         Caption         =   "<<"
         Height          =   405
         Left            =   60
         TabIndex        =   1
         Top             =   180
         Width           =   375
      End
      Begin VB.CommandButton cmdNext 
         Caption         =   ">>"
         Height          =   405
         Left            =   450
         TabIndex        =   2
         Top             =   180
         Width           =   345
      End
      Begin VB.Label lblTableName 
         Alignment       =   2  'Center
         Caption         =   "lblTableName"
         Height          =   315
         Left            =   1560
         TabIndex        =   3
         Top             =   270
         Width           =   1935
      End
   End
   Begin VB.Label lblField 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "lblField"
      Height          =   285
      Index           =   0
      Left            =   180
      TabIndex        =   5
      Top             =   120
      Width           =   1200
   End
End
Attribute VB_Name = "frmObjectInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'COL_TYPE_CHAR 'Character
'COL_TYPE_DECIMAL    'Fixed-point decimal
'COL_TYPE_FLOAT  'Floating-point decimal
'COL_TYPE_INTEGER    'Integer (4-byte)
'COL_TYPE_SMALLINT   'Small Integer (2-byte)
'COL_TYPE_DATE 'Date
'COL_TYPE_LOGICAL 'Logical(True Or False)
'COL_TYPE_GRAPHIC    'special column type Obj; this represents the graphical objects attached to the table

Public pObject As Long, X As Double, Y As Double, X2 As Double, Y2 As Double
Public curObject As Integer
Public RecNum As Long '记录行位置
Dim fldName() As String
Dim fldType() As Integer

Private Sub cmdNext_Click()
    curObject = curObject + 1
    If curObject >= pObject Then
        cmdNext.Enabled = False
        cmdPrevious.Enabled = True
    End If
    '读取相关图层的对象信息
    UpdateInfo X, Y, X2, Y2, 0
End Sub

Private Sub cmdPrevious_Click()
    curObject = curObject - 1
    If curObject <= 1 Then
        cmdNext.Enabled = True
        cmdPrevious.Enabled = False
    End If
    '读取相关图层的对象信息
    UpdateInfo X, Y, X2, Y2, 0
End Sub

Private Sub cmdUpdate_Click()
    '保存
    Dim I As Integer, J As Integer
    Dim strSql As String
    On Error GoTo err_lab
    I = Me.lblField.Count
    For J = 0 To I - 1
        Select Case fldType(J)
            Case COL_TYPE_CHAR
                If J = 0 Then
                    strSql = fldName(J) & "=""" & txtField(J).Text & ""","
                Else
                    strSql = strSql & fldName(J) & "=""" & txtField(J).Text & ""","
                End If
                
            Case COL_TYPE_DECIMAL, COL_TYPE_FLOAT, COL_TYPE_INTEGER, COL_TYPE_SMALLINT
                If J = 0 Then
                    strSql = fldName(J) & "=" & txtField(J).Text & ","
                Else
                    strSql = strSql & fldName(J) & "=" & txtField(J).Text & ","
                End If
                
            Case COL_TYPE_DATE
                If J = 0 Then
                    strSql = fldName(J) & "=""" & txtField(J).Text & ""","
                Else
                    strSql = strSql & fldName(J) & "=""" & txtField(J).Text & ""","
                End If
                
            Case COL_TYPE_LOGICAL
                If J = 0 Then
                    If txtField(J).Text = "T" Then
                        strSql = fldName(J) & "=""T"","
                    Else
                        strSql = fldName(J) & "=""F"","
                    End If
                Else
                    If txtField(J).Text = "T" Then
                        strSql = strSql & fldName(J) & "=""T"","
                    Else
                        strSql = strSql & fldName(J) & "=""F"","
                    End If
                End If
                
            'Case COL_TYPE_GRAPHIC
                
        End Select
    Next
    strSql = Mid(strSql, 1, Len(strSql) - 1)
'    Debug.Print strSql
    MapInfo.Do "Update " & Me.lblTableName.Caption & "  Set " & strSql & " where RowID=" & RecNum
    Exit Sub
err_lab:
'    MsgBox Err.Description, vbInformation, "提示"
End Sub

Private Sub Form_Load()
    Dim retValue As Long
    retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 250, 480, SWP_SHOWWINDOWS)
    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = Screen.Width - Me.Width - 10
    If pObject > 1 Then
        Me.cmdPrevious.Enabled = True
        Me.cmdNext.Enabled = True
    Else
        Me.cmdPrevious.Enabled = False
        Me.cmdNext.Enabled = False
    End If
End Sub

Public Sub ReadInfo(ByVal mObject As Integer)
    Dim K As Integer, I As Integer, J As Integer
    Dim TableName As String
    '表名和字段数
    TableName = MapInfo.Eval("SearchInfo(" & mObject & "," & SEARCH_INFO_TABLE & ")")
    '获取该对象在表中的位置
    RecNum = CLng(MapInfo.Eval("SearchInfo(" & mObject & "," & SEARCH_INFO_ROW & ")"))
    '定位该对象在表中记录位置
    MapInfo.Do "Fetch Rec " & RecNum & " From " & TableName

    K = Val(MapInfo.Eval("TableInfo(" & TableName & "," & TAB_INFO_NCOLS & ")"))
    If K > 1 Then
        For I = 1 To K - 1
            Load lblField(I)
            Load txtField(I)
            txtField(I).Top = txtField(I - 1).Top + txtField(I).Height + 30
            lblField(I).Top = txtField(I).Top + 30
            lblField(I).Visible = True
            txtField(I).Visible = True
        Next
    End If
    '读取对象的属性
    lblTableName = TableName
    ReDim fldName(K)
    ReDim fldType(K)
    For J = 0 To K - 1
        lblField(J).Caption = MapInfo.Eval("ColumnInfo(""" & TableName & """,""col" & J + 1 & """,1)") & "："
        txtField(J).Text = MapInfo.Eval(TableName & ".Col" & J + 1)
        
        fldName(J) = MapInfo.Eval("ColumnInfo(""" & TableName & """,""col" & J + 1 & """,1)") 'COL_INFO_NAME
        fldType(J) = MapInfo.Eval("ColumnInfo(""" & TableName & """,""col" & J + 1 & """,3)") 'COL_INFO_TYPE
    Next
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Me.txtField(0).Width = Me.ScaleWidth - Me.txtField(0).Left - 50
    Me.Frame2.Top = Me.ScaleHeight - Me.Frame2.Height - 10
    Me.Frame2.Width = Me.ScaleWidth - 50
    Me.Width = 3750
'    Debug.Print Me.Width
End Sub