📄 mdlclearalltext.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 + -