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

📄 frmoptions.frm

📁 使用的是最小误差法的插补程序
💻 FRM
📖 第 1 页 / 共 2 页
字号:
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   6240
      TabIndex        =   2
      Top             =   2040
      Width           =   1575
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "查询"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   2040
      Width           =   1575
   End
   Begin MSComctlLib.TabStrip tbsOptions 
      Height          =   1845
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   7695
      _ExtentX        =   13573
      _ExtentY        =   3254
      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   4
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "按月查询"
            Key             =   "Group1"
            Object.ToolTipText     =   "为群组 1 设置选项"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "按日查询"
            Key             =   "Group2"
            Object.ToolTipText     =   "为群组 2 设置选项"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "按班查询"
            Key             =   "Group3"
            Object.ToolTipText     =   "为群组 3 设置选项"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab4 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "按编号查询"
            Key             =   "Group4"
            Object.ToolTipText     =   "为群组 4 设置选项"
            ImageVarType    =   2
         EndProperty
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
End
Attribute VB_Name = "frmOptions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdApply_Click()
    MsgBox "在这里设置代码来设置选项 w/o 关闭对话框!"
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
   
    Dim i As Integer, j As Integer
    Dim sYear As String, sMonth As String
    Dim sDay As String, sBanci As String
    Dim SBianhao As String
    Dim flag1 As Integer
    
    j = tbsOptions.SelectedItem.Index - 1
    

    Dim flag(0 To 4) As Integer  '标志各个文本框是否为空
    
    For i = 0 To 4
    If Text1(i).Text <> "" Then
         flag(i) = 1
    Else
        flag(i) = 0
    End If
    Next i
    
   
   If (Len(Text1(0).Text) > 4 Or Len(Text1(0).Text) = 3) Then   '对年份输入格式的判断
   MsgBox ("输入的格式错误")
   Exit Sub
   Else
    Select Case j
    Case 0
           For i = 0 To 1
           flag1 = flag(i) + 1
           Next i
           If flag1 = 2 Then
                sYear = Right(Text1(0).Text, 2)
             If Val(Text1(1).Text) >= 1 And Val(Text1(1).Text) <= 12 Then    '修改
              sMonth = Format(Text1(1).Text, "00")
              Else
                 MsgBox ("你的输入有错")
                 Exit Sub
             End If
            Else
             MsgBox ("请输入完整的查询条件")
             Exit Sub
           End If
    Case 1
           For i = 0 To 2
           flag1 = flag1 + flag(i)
           Next i
           If flag1 = 3 Then
              sYear = Right(Text1(0).Text, 2)
             If Val(Text1(1).Text) >= 1 And Val(Text1(1).Text) <= 12 Then
               sMonth = Format(Text1(1).Text, "00")
              Else
                 MsgBox ("你的输入有错")
               Exit Sub
              End If
            If Len(Text1(2).Text) <= 2 And Val(Text1(2).Text) >= 1 And Val(Text1(2).Text) <= 31 Then
               sDay = Format(Text1(2).Text, "00")
              Else
                 MsgBox ("你的输入有错")
               Exit Sub
              End If
          Else
                 MsgBox ("请输入完整的查询条件")
                 Exit Sub
          End If
    Case 2
         For i = 0 To 3
           flag1 = flag1 + flag(i)
         Next i
          If flag1 = 4 Then
                 sYear = Right(Text1(0).Text, 2)
           If Val(Text1(1).Text) >= 1 And Val(Text1(1).Text) <= 12 Then
               sMonth = Format(Text1(1).Text, "00")
              Else
                 MsgBox ("你的输入有错")
               Exit Sub
              End If
            If Len(Text1(2).Text) <= 2 And Val(Text1(2).Text) >= 1 And Val(Text1(2).Text) <= 31 Then
               sDay = Format(Text1(2).Text, "00")
              Else
                 MsgBox ("你的输入有错")
               Exit Sub
              End If
             sBanci = Format(Text1(3).Text, "0")
            Else
               MsgBox ("你的输入不完整")
        End If
    Case 3
         For i = 0 To 4
            flag1 = flag1 + flag(i)
            Next i
        If flag1 = 5 Then
          sYear = Right(Text1(0).Text, 2)
           If Val(Text1(1).Text) >= 1 And Val(Text1(1).Text) <= 12 Then
               sMonth = Format(Text1(1).Text, "00")
              Else
                 MsgBox ("你的输入有错")
               Exit Sub
              End If
            If Len(Text1(2).Text) <= 2 And Val(Text1(2).Text) >= 1 And Val(Text1(2).Text) <= 31 Then
               sDay = Format(Text1(2).Text, "00")
              Else
                 MsgBox ("你的输入有错")
               Exit Sub
          End If
              sBanci = Format(Text1(3).Text, "0")
              SBianhao = Format(Text1(4).Text, "0000")
           Else
                     MsgBox ("你的输入不完整")
                 Exit Sub
         

        End If
        End Select
    End If
      If j < 3 Then
        sqbianhao = sYear + sMonth + sDay + sBanci + SBianhao
      Call CountNumber(sqbianhao)
         ' 显示查询结果的窗体
         If flagExist = 1 Then
          Load frmsearch1
         frmsearch1.Show
         Else
           Exit Sub
           End If
       End If
    If j = 3 Then
       sqbianhao = sYear + sMonth + sDay + sBanci + SBianhao
        Call panBianhao(sqbianhao)
         If flagBianhao = 1 Then
          Load frmsearch3
          frmsearch3.Show
        ElseIf flagBianhao = 0 Then
          MsgBox ("数据库中无此记录 ")
        Exit Sub
      End If
    End If
End Sub
Private Sub Form_Load()
    Dim i As Integer
    '定义窗体的默认位置
   frmOptions.Left = 800
   frmOptions.Top = 1000
   '默认条件下显示第一个查询
     Frame1.Left = 360: Frame1.Width = 3615
     cmdOK.Left = 105: cmdCancel.Left = 3210
     frmOptions.Width = 5565
     tbsOptions.Width = 4690
     '文本框默认值
     Dim a As String
     a = Date
     Text1(0).Text = Format(a, "yyyy")
     Text1(1).Text = Format(a, "mm")
     Text1(2).Text = Format(a, "dd")
     Text1(3).Text = "1"
     Text1(4).Text = ""
    
     End Sub


Private Sub tbsOptions_Click()
    
    Dim i As Integer
    '显示并使选项的控件可用
    '并且隐藏使其他被禁用
    '可变的适当的大小
   'If tbsOptions.SelectedItem.Index - 1 = 0 Then
    ' Frame1.Left = 720: Frame1.Width = 2560
     'cmdOK.Left = 120: cmdOK.Width = 1575
     'cmdCancel.Left = 2520: cmdCancel.Width = 1575
     'frmOptions.Width = 4650
     'tbsOptions.Width = 3960
    'End If
     If tbsOptions.SelectedItem.Index - 1 = 0 Then
     Frame1.Left = 360: Frame1.Width = 3615
     cmdOK.Left = 105: cmdCancel.Left = 3210
     frmOptions.Width = 5565
     tbsOptions.Width = 4690
    End If
     If tbsOptions.SelectedItem.Index - 1 = 1 Then
     Frame1.Left = 360: Frame1.Width = 4815
     cmdOK.Left = 105: cmdCancel.Left = 4200
     frmOptions.Width = 6480
     tbsOptions.Width = 5655
    End If
    If tbsOptions.SelectedItem.Index - 1 = 2 Then
     Frame1.Left = 360: Frame1.Width = 5895
     cmdOK.Left = 105: cmdCancel.Left = 5160
     frmOptions.Width = 7410
     tbsOptions.Width = 6615
    End If
     If tbsOptions.SelectedItem.Index - 1 = 3 Then
      Frame1.Left = 360: Frame1.Width = 7095
     cmdOK.Left = 105: cmdCancel.Left = 6240
     frmOptions.Width = 8580
     tbsOptions.Width = 7695
    End If
End Sub

⌨️ 快捷键说明

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