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

📄 frmtab.frm

📁 VB+mapinfo开发的最短路径
💻 FRM
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form FrmTAB 
   BackColor       =   &H80000000&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "打开表或工作空间"
   ClientHeight    =   6780
   ClientLeft      =   708
   ClientTop       =   1248
   ClientWidth     =   8772
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   7.8
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H00000080&
   MaxButton       =   0   'False
   MinButton       =   0   'False
   NegotiateMenus  =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6780
   ScaleWidth      =   8772
   StartUpPosition =   2  '屏幕中心
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   0
      Top             =   1320
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
   End
   Begin VB.PictureBox PictureCompute 
      Height          =   6372
      Left            =   120
      ScaleHeight     =   6324
      ScaleWidth      =   8484
      TabIndex        =   0
      Top             =   120
      Width           =   8532
      Begin VB.PictureBox Picture2 
         Height          =   5412
         Left            =   4320
         ScaleHeight     =   5364
         ScaleWidth      =   4044
         TabIndex        =   10
         Top             =   360
         Width           =   4092
         Begin VB.ListBox ListWor 
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   11.4
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   4608
            Left            =   120
            Sorted          =   -1  'True
            TabIndex        =   13
            Top             =   600
            Visible         =   0   'False
            Width           =   3732
         End
         Begin VB.TextBox InIndex 
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   11.4
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   360
            Left            =   120
            MaxLength       =   12
            TabIndex        =   12
            Text            =   "*.TAB"
            Top             =   120
            Width           =   3732
         End
         Begin VB.ListBox ListIn 
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   11.4
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   4608
            Left            =   120
            MultiSelect     =   2  'Extended
            Sorted          =   -1  'True
            TabIndex        =   11
            Top             =   600
            Visible         =   0   'False
            Width           =   3732
         End
      End
      Begin VB.CommandButton CommandCancel 
         Caption         =   "退回"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   11.4
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   5040
         TabIndex        =   9
         Top             =   5880
         Width           =   2895
      End
      Begin VB.CommandButton CommandOK 
         Caption         =   "确定"
         Enabled         =   0   'False
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   11.4
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   720
         TabIndex        =   7
         Top             =   5880
         Width           =   2895
      End
      Begin VB.FileListBox FileInT 
         Height          =   648
         Left            =   5040
         MultiSelect     =   1  'Simple
         Pattern         =   "*.F;*.FB"
         TabIndex        =   4
         Top             =   1560
         Visible         =   0   'False
         Width           =   1575
      End
      Begin VB.PictureBox Picture1 
         Height          =   5412
         Left            =   120
         ScaleHeight     =   5364
         ScaleWidth      =   4044
         TabIndex        =   1
         Top             =   360
         Width           =   4092
         Begin VB.DirListBox DirIn 
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   11.4
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   4608
            Left            =   120
            TabIndex        =   3
            Top             =   600
            Width           =   3732
         End
         Begin VB.DriveListBox DriveIn 
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   11.4
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   324
            Left            =   120
            TabIndex        =   2
            Top             =   120
            Width           =   3732
         End
      End
      Begin VB.Label Label1 
         Alignment       =   2  'Center
         Caption         =   "文件属性"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   11.4
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   252
         Left            =   4320
         TabIndex        =   6
         Top             =   120
         Width           =   3852
      End
      Begin VB.Label lblCriteria 
         Alignment       =   2  'Center
         Caption         =   "文件路径"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   11.4
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   252
         Left            =   120
         TabIndex        =   5
         Top             =   120
         Width           =   4092
      End
   End
   Begin ComctlLib.ProgressBar ProgressBar1 
      Align           =   2  'Align Bottom
      Height          =   216
      Left            =   0
      TabIndex        =   8
      Top             =   6564
      Visible         =   0   'False
      Width           =   8772
      _ExtentX        =   15473
      _ExtentY        =   381
      _Version        =   327682
      Appearance      =   1
   End
End
Attribute VB_Name = "FrmTAB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim bClick As Boolean
Private Sub SearchFile()
    Dim I As Integer, J As Integer

    If (bClick = False) Then Exit Sub
    CommandOK.Enabled = False
    ListIn.Clear
    ListWor.Clear
    If (FileInT.ListCount < 1) Then Exit Sub
    bClick = False
    ProgressBar1.Visible = True
    ProgressBar1.MIn = 0
    ProgressBar1.Max = FileInT.ListCount
    PictureCompute.MousePointer = 11
    If (RightIndex = ".TAB") Then
        ListWor.Visible = False
        ListIn.Visible = True
        ListIn.Clear
        For I = 0 To FileInT.ListCount - 1
            ProgressBar1.Value = I
            J = InStr(UCase(FileInT.List(I)), RightIndex)
            If (J > 0) Then
                ListIn.AddItem UCase(FileInT.List(I))
            End If
        Next I
    Else
        ListWor.Visible = True
        ListIn.Visible = False
        ListWor.Clear
        For I = 0 To FileInT.ListCount - 1
            ProgressBar1.Value = I
            J = InStr(UCase(FileInT.List(I)), RightIndex)
            If (J > 0) Then
                ListWor.AddItem UCase(FileInT.List(I))
            End If
        Next I
    End If

    ProgressBar1.Visible = False
    If (ListIn.SelCount > 0) Then
        CommandOK.Enabled = True
    Else
        CommandOK.Enabled = False
    End If
    PictureCompute.MousePointer = 0
    bClick = True
End Sub
Private Sub CommandCancel_Click()

    bOKCancel = False
    
    nTabOrWor = 0
    
    Unload Me
End Sub

Private Sub CommandOk_Click()
    Dim I As Integer
    
    If (RightIndex = ".TAB") Then
        nTabOrWor = ListIn.SelCount
        ReDim TabOrWor(1 To nTabOrWor)
        nTabOrWor = 0
    
        For I = 0 To ListIn.ListCount - 1
            If (ListIn.Selected(I) = True) Then
                nTabOrWor = nTabOrWor + 1
                
                TabOrWor(nTabOrWor) = ListIn.List(I)
            End If
        Next I
    Else
        nTabOrWor = 1
        ReDim TabOrWor(1 To nTabOrWor)
        
        TabOrWor(nTabOrWor) = ListWor.List(ListWor.ListIndex)
    End If
    
    LeftRightIndex = InIndex.Text
    
    bOKCancel = True
    Unload Me
End Sub
Private Sub dirin_Change()
    If Len(DirIn.Path) <= 3 Then
        TheInPathTabOrWor = DirIn.Path
    Else
        TheInPathTabOrWor = DirIn.Path + "\"
    End If
    
    FileInT.Path = DirIn.Path

End Sub

Private Sub dirin_LostFocus()
    DirIn.Path = DirIn.List(DirIn.ListIndex)
End Sub


Private Sub driveIn_Change()
    On Error GoTo DriveHandler
    DirIn.Path = DriveIn.Drive
    Exit Sub
DriveHandler:
    DriveIn.Drive = DirIn.Path
    Exit Sub
End Sub


Private Sub FileInT_PathChange()
Call SearchFile

End Sub


Private Sub FileInT_PatternChange()
Call SearchFile
End Sub


Private Sub Form_Load()
    Dim TheInPathT As String
    
    If (RightIndex = ".TAB") Then
        FrmTAB.Caption = "打开表"
        ListWor.Visible = False
        ListIn.Visible = True
        ListIn.Clear
    Else
        FrmTAB.Caption = "打开工作空间"
        ListWor.Visible = True
        ListIn.Visible = False
        ListWor.Clear
    End If
    
    TheInPathT = TheInPathTabOrWor
    bClick = False
    InIndex.Text = LeftRightIndex
    FileInT.Pattern = "^@%$"
    FileInT.Pattern = LeftRightIndex
    DriveIn.Drive = Left(TheInPathT, 2)
    DirIn.Path = TheInPathT
    bClick = True
    Call SearchFile
    
    nTabOrWor = 0
End Sub
Private Sub InIndex_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next

If (KeyCode = 13) Then
    FileInT.Pattern = InIndex.Text
End If

End Sub

Private Sub ListIn_Click()
    
    If (bClick = False) Then Exit Sub
    
    If (ListIn.SelCount > 0) Then
        CommandOK.Enabled = True
    Else
        CommandOK.Enabled = False
    End If
End Sub

Private Sub ListIn_DblClick()
    Call CommandOk_Click
End Sub


Private Sub ListWor_Click()
    If (bClick = False) Then Exit Sub
    
    If (ListWor.SelCount > 0) Then
        CommandOK.Enabled = True
    Else
        CommandOK.Enabled = False
    End If
End Sub


Private Sub ListWor_DblClick()
    Call CommandOk_Click
End Sub

⌨️ 快捷键说明

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