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

📄 mdlclearalltext.bas

📁 旅行社管理信息系统主要实现旅游路线、景点、交通工具等的查询、修改和删除功能
💻 BAS
字号:
Attribute VB_Name = "MdlClearAllText"
Option Explicit
Type PforControl
   WidthP As Single
   HeightP As Single
   TopP As Single
   LeftP As Single
End Type
Dim ControlPArray() As PforControl

Sub ClearAllText(Frm As Form)
    On Error Resume Next
    Dim Ctr As Control
    Dim intcol As Integer
    For Each Ctr In Frm.Controls
       If TypeOf Ctr Is TextBox Then
          Ctr.Text = ""
       ElseIf TypeOf Ctr Is ComboBox Then
          If Ctr.Style = 0 Then
             Ctr.Text = ""
          ElseIf Ctr.Style = 2 Then
             Ctr.ListIndex = -1
          End If
    '   ElseIf TypeOf Ctr Is DTPicker Then
    '    Ctr.Value = ""
    '   ElseIf TypeOf Ctr Is MSFlexGrid Or TypeOf Ctr Is MSHFlexGrid Then
    '    Ctr.Rows = 2
    '
    '    For intcol = Ctr.FixedCols To Ctr.Cols - 1
    '        Ctr.TextMatrix(1, intcol) = ""
    '    Next intcol
    '
    '    Ctr.Row = 1
    '    Ctr.LeftCol = 1
    '   ElseIf TypeOf Ctr Is DTPicker Then
    '      Ctr.Value = ""
       Else
          Ctr.Text = ""
       End If
    Next

End Sub

Sub KeyUpAndDown(KeyCode As Integer)
    On Error Resume Next
    If KeyCode = 13 Then
       KeyCode = 0
       SendKeys "{tab}"
    
    ElseIf KeyCode = vbKeyUp Then
        SendKeys "+{tab}"
    ElseIf KeyCode = vbKeyDown Then
         SendKeys "{tab}"
    End If
End Sub

Sub KeyLeftAndRight(KeyCode As Integer)
    On Error Resume Next
    If KeyCode = 13 Then
       KeyCode = 0
       SendKeys "{tab}"
    
    ElseIf KeyCode = vbKeyLeft Then
        SendKeys "+{tab}"
    ElseIf KeyCode = vbKeyRight Then
         SendKeys "{tab}"
    End If
End Sub

Sub initControls(Frm As Form)
    On Error Resume Next
    Dim i As Integer
    ReDim ControlPArray(0 To Frm.Controls.Count - 1)
    For i = 0 To Frm.Controls.Count - 1
       With ControlPArray(i)
          .WidthP = Frm.Controls(i).Width / Frm.ScaleWidth
          .HeightP = Frm.Controls(i).Height / Frm.ScaleHeight
          .LeftP = Frm.Controls(i).Left / Frm.ScaleWidth
          .TopP = Frm.Controls(i).Top / Frm.ScaleHeight
       End With
    Next i
End Sub

Sub ResizeControls(Frm As Form)
    On Error Resume Next
    Dim i As Integer
    For i = 0 To Frm.Controls.Count - 1
       With ControlPArray(i)
           Frm.Controls(i).Width = .WidthP * Frm.ScaleWidth
    '      frm.Controls(i).Height = .HeightP * frm.ScaleHeight
           Frm.Controls(i).Left = .LeftP * Frm.ScaleWidth
    '       frm.Controls(i).Top = .TopP * frm.ScaleHeight
       End With
    Next i
End Sub

Sub txtGotFocus(txtvalue As Control)
    On Error Resume Next
    txtvalue.BackColor = &HE1E4FF '玫瑰色
    txtvalue.ForeColor = vbBlue
    If txtvalue.Text <> "" Then
        txtvalue.SelStart = 0
        txtvalue.SelLength = Len(txtvalue.Text)
    End If
End Sub

Sub txtLostFocus(txtvalue As Control)
    On Error Resume Next
    txtvalue.BackColor = vbWhite
    txtvalue.ForeColor = vbBlue
    If Trim(txtvalue.Text) = "" Then
        txtvalue.SetFocus
    End If
End Sub

⌨️ 快捷键说明

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