📄 dlgsrgqueue.frm
字号:
VERSION 5.00
Begin VB.Form dlgSrgQueue
BorderStyle = 1 'Fixed Single
Caption = "选择客户号码"
ClientHeight = 3195
ClientLeft = 45
ClientTop = 330
ClientWidth = 4770
Icon = "dlgSrgQueue.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3195
ScaleWidth = 4770
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 375
Left = 3720
TabIndex = 3
Top = 2640
Width = 975
End
Begin VB.CommandButton cmdOK
Caption = "确定(&O)"
Height = 375
Left = 2760
TabIndex = 2
Top = 2640
Width = 975
End
Begin VB.ListBox lstCustCode
Height = 2040
Left = 240
TabIndex = 1
Top = 960
Width = 2295
End
Begin VB.TextBox txtCustCode
Height = 270
Left = 1200
MaxLength = 4
TabIndex = 0
Top = 240
Width = 1335
End
Begin VB.PictureBox picBack
Height = 2000
Left = 3000
ScaleHeight = 1935
ScaleWidth = 1455
TabIndex = 16
Top = 240
Width = 1510
Begin VB.CommandButton cmdDel
Caption = "Del"
BeginProperty Font
Name = "宋体"
Size = 7.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 960
TabIndex = 15
Top = 1440
Width = 495
End
Begin VB.CommandButton cmd0
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 0
Left = 480
TabIndex = 13
Top = 1440
Width = 495
End
Begin VB.CommandButton cmdBack
Caption = "Back"
BeginProperty Font
Name = "宋体"
Size = 7.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 0
TabIndex = 14
Top = 1440
Width = 495
End
Begin VB.CommandButton cmd0
Caption = "9"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 9
Left = 960
TabIndex = 12
Top = 960
Width = 495
End
Begin VB.CommandButton cmd0
Caption = "8"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 8
Left = 480
TabIndex = 11
Top = 960
Width = 495
End
Begin VB.CommandButton cmd0
Caption = "7"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 7
Left = 0
TabIndex = 10
Top = 960
Width = 495
End
Begin VB.CommandButton cmd0
Caption = "6"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 6
Left = 960
TabIndex = 9
Top = 480
Width = 495
End
Begin VB.CommandButton cmd0
Caption = "5"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 5
Left = 480
TabIndex = 8
Top = 480
Width = 495
End
Begin VB.CommandButton cmd0
Caption = "4"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 4
Left = 0
TabIndex = 7
Top = 480
Width = 495
End
Begin VB.CommandButton cmd0
Caption = "3"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 3
Left = 960
TabIndex = 6
Top = 0
Width = 495
End
Begin VB.CommandButton cmd0
Caption = "2"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 2
Left = 480
TabIndex = 5
Top = 0
Width = 495
End
Begin VB.CommandButton cmd0
Caption = "1"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 1
Left = 0
TabIndex = 4
Top = 0
Width = 495
End
End
Begin VB.Label lblInfo
Caption = "存储编号："
Height = 165
Index = 1
Left = 240
TabIndex = 18
Top = 720
Width = 975
End
Begin VB.Label lblInfo
Caption = "客户编号："
Height = 160
Index = 0
Left = 240
TabIndex = 17
Top = 295
Width = 975
End
End
Attribute VB_Name = "dlgSrgQueue"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim m_tagErrInfo As TYPE_ERRORINFO
Dim m_sCode As String '传入的客户列表
Dim m_bCode As Boolean '传入标示
Dim m_sCustCode As String '传出的客户编号
Dim m_bCustCode As Boolean '传出的客户表示是否有效
Private Sub cmd0_Click(Index As Integer)
On Error Resume Next
Dim i As Integer
If Not IsNumeric(txtCustCode.Text) Then
txtCustCode.Text = txtCustCode.Text & CStr(Index)
Else
If CInt(txtCustCode.Text) > 999 Then
i = CInt(txtCustCode.Text) \ 10
txtCustCode.Text = CStr(i) & CStr(Index)
Else
txtCustCode.Text = txtCustCode.Text & CStr(Index)
End If
End If
End Sub
Private Sub cmdBack_Click()
On Error Resume Next
Dim str As String
If txtCustCode.Text = "" Then Exit Sub
str = txtCustCode.Text
str = Left$(str, Len(str) - 1)
txtCustCode.Text = str
End Sub
Private Sub cmdCancel_Click()
On Error Resume Next
m_sCustCode = ""
m_bCustCode = False
Unload Me
End Sub
Private Sub cmdDel_Click()
On Error Resume Next
txtCustCode.Text = ""
End Sub
Private Sub cmdOK_Click()
On Error Resume Next
If Not IsNumeric(txtCustCode.Text) Then
MsgBox "请输入正确的客户编号！", vbOKOnly, "系统提示"
txtCustCode.SetFocus
SendKeys "{HOME}"
SendKeys "+{END}"
Exit Sub
End If
m_sCustCode = txtCustCode.Text
m_bCustCode = True
Unload Me
End Sub
Private Sub Form_Load()
On Error Resume Next
m_sCode = ""
m_bCode = False
m_sCustCode = ""
m_bCustCode = False
End Sub
Private Sub Form_Terminate()
On Error Resume Next
Set dlgSrgQueue = Nothing
End Sub
Private Sub lstCustCode_Click()
On Error Resume Next
If lstCustCode.ListIndex < 0 Then Exit Sub
txtCustCode.Text = lstCustCode.List(lstCustCode.ListIndex)
txtCustCode.SetFocus
SendKeys "{HOME}"
SendKeys "+{END}"
End Sub
Private Sub lstCustCode_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then '是回车键？
KeyAscii = 0 '0取消输入
SendKeys "{tab}"
End If
End Sub
Private Sub txtCustCode_GotFocus()
On Error Resume Next
txtCustCode.BackColor = &H80000018
End Sub
Private Sub txtCustCode_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then '是回车键？
KeyAscii = 0 '0取消输入
SendKeys "{tab}"
End If
End Sub
Private Sub txtCustCode_LostFocus()
On Error Resume Next
txtCustCode.BackColor = &H80000005
End Sub
'//////////////////////////////////////////////////////////////////////////////////////////
'/设定条屏编号
Public Property Let CustCode(ByVal vNewValue As String)
On Error Resume Next
m_sCode = vNewValue
m_bCode = True
End Property
'得到结果是否有效标志
Public Property Get bResult() As Boolean
On Error Resume Next
bResult = m_bCustCode
End Property
'得到结果
Public Property Get sResult() As String
On Error Resume Next
sResult = m_sCustCode
End Property
'初始化对话框
Public Function InitSet(Optional ByVal bMode As Boolean = True) As Boolean
On Error GoTo ERROR_EXIT
Dim sData() As String, i As Integer, str As String
If bMode = True Then
lblInfo(1).Caption = "存储编号："
Else
lblInfo(1).Caption = "当前客户："
sData = Split(m_sCode, " ")
For i = UBound(sData) To 0 Step -1
If str = "" Then
str = sData(i)
Else
str = str & " " & sData(i)
End If
Next i
m_sCode = str
End If
If m_bCode = True Then
sData = Split(m_sCode, " ")
For i = 0 To UBound(sData)
lstCustCode.AddItem sData(i)
Next i
InitSet = True
Else
InitSet = False
End If
Exit Function
ERROR_EXIT:
InitSet = False
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -