⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmselectionwindow.frm

📁 一个交通专用的gis-T系统
💻 FRM
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "Msflxgrd.ocx"
Begin VB.Form frmSelectionWindow 
   Appearance      =   0  'Flat
   BackColor       =   &H8000000A&
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "属性查看"
   ClientHeight    =   3465
   ClientLeft      =   5415
   ClientTop       =   4650
   ClientWidth     =   4260
   Icon            =   "frmSelectionWindow.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3465
   ScaleWidth      =   4260
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton Command1 
      Caption         =   "对象详细信息>>"
      Default         =   -1  'True
      Height          =   375
      Left            =   0
      TabIndex        =   6
      Top             =   3000
      Width           =   1695
   End
   Begin VB.Frame Frame3 
      Caption         =   "选中对象属性数据:"
      Height          =   3255
      Left            =   1800
      TabIndex        =   1
      Top             =   120
      Width           =   2415
      Begin MSFlexGridLib.MSFlexGrid Dgshow 
         Height          =   2895
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   2235
         _ExtentX        =   3942
         _ExtentY        =   5106
         _Version        =   393216
         Rows            =   13
         FixedRows       =   0
         FixedCols       =   0
         ScrollBars      =   2
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "选中的对象:"
      Height          =   2775
      Left            =   0
      TabIndex        =   0
      Top             =   120
      Width           =   1695
      Begin VB.ComboBox Combo1 
         Appearance      =   0  'Flat
         Height          =   300
         Left            =   720
         TabIndex        =   4
         Top             =   240
         Width           =   855
      End
      Begin VB.ListBox List1 
         Appearance      =   0  'Flat
         Height          =   1650
         ItemData        =   "frmSelectionWindow.frx":014A
         Left            =   120
         List            =   "frmSelectionWindow.frx":014C
         TabIndex        =   2
         Top             =   600
         Width           =   1455
      End
      Begin VB.Label Label1 
         Caption         =   "图层:"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   300
         Width           =   615
      End
   End
End
Attribute VB_Name = "frmSelectionWindow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************
'*
'*                本源码完全免费,共交通同仁学习参考                 *
'*                      www.tranbbs.com                              *
'*                   Developed by Yang Ming                          *
'*       Nanjing Institute of City Transportation Planning           *
'*                 请保留本版权信息,谢谢合作                        *
'*                      中国交通技术论坛                             *
'*                                                                   *
'*                                                                   *
'*********************************************************************


Private Sub Command1_Click()
    
   If FrmMax = False Then
    Me.Width = 4200
    FrmMax = True
    Command1.Caption = "<<关闭详细信息"
   Else
    Me.Width = 1800
    FrmMax = False
    Command1.Caption = "详细信息查看>>"
   End If


End Sub

Private Sub Form_Load()
  Me.Top = Main.Top + 2000
  Me.Left = Main.Left + 100
  Me.Width = 1800
  FrmMax = False
  Call KeepOnTop(Me)    '保持在FrmMapWindow窗口之上

End Sub

Private Sub Form_Unload(Cancel As Integer)

    Main.Toolbar1.Buttons(12).Value = tbrUnpressed
    
End Sub


Private Sub List1_Click()
On Error Resume Next
Dim SelName As String

'------------------------------------------------------------------------------------------------
'显示节点属性数据

    If Left(List1.Text, 1) = "N" Then
        SelName = Right(List1.Text, Len(List1.Text) - 5)

        Dim RS_sql As Recordset
        Set RS_sql = mDbBiblio.OpenRecordset("select * from Nodes where NodeId=" & Val(SelName))
        
        Dim FirNum
        FirNum = RS_sql.Fields.Count
        
        If FirNum + 1 > 13 Then
            Dgshow.Rows = FirNum + 1
        Else
            Dgshow.Rows = 13
        End If
        Dgshow.Clear
        
        Dgshow.Cols = 2
        
        Dgshow.Row = 0
        Dgshow.Col = 0
        Dgshow.Text = "字段名称"
        Dgshow.Col = 1
        Dgshow.Text = "内容"
        
        For i = 0 To FirNum - 1
            Dgshow.Row = i + 1
            Dgshow.Col = 0
            
            Dgshow.Text = RS_sql.Fields(i).Name
            
            Dgshow.Col = 1
            
            If IsNull(RS_sql.Fields(i)) = True Then
                Dgshow.Text = ""
            Else
                Dgshow.Text = RS_sql.Fields(i).Value
            End If
            
        Next i

        Dgshow.Refresh
        

    End If
'--------------------------------------------------------------------------------------------


'--------------------------------------------------------------------------------------------
'显示路段表属性数据

    If Left(List1.Text, 1) = "L" Then
        SelName = Right(List1.Text, Len(List1.Text) - 5)
        
        Set RS_sql = mDbBiblio.OpenRecordset("select * from Links where LinkId=" & Val(SelName))

        FirNum = RS_sql.Fields.Count
        
        If FirNum + 1 > 13 Then
            Dgshow.Rows = FirNum + 1
        Else
            Dgshow.Rows = 13
        End If
        Dgshow.Clear
        Dgshow.Cols = 2
        
        Dgshow.Row = 0
        Dgshow.Col = 0
        Dgshow.Text = "字段名称"
        Dgshow.Col = 1
        Dgshow.Text = "内容"
        
        
        For i = 0 To FirNum - 1
        
            Dgshow.Row = i + 1
            Dgshow.Col = 0
            If IsNull(RS_sql.Fields(i)) = True Then
            Dgshow.Text = ""
            Else
            Dgshow.Text = RS_sql.Fields(i).Name
            Dgshow.Col = 1
            Dgshow.Text = RS_sql.Fields(i).Value
            End If
            
        Next i

        Dgshow.Refresh
        

    End If '--------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -