📄 workhead.ctl
字号:
VERSION 5.00
Begin VB.UserControl WorkHead
BackColor = &H00C0FFFF&
ClientHeight = 5505
ClientLeft = 0
ClientTop = 0
ClientWidth = 9150
ScaleHeight = 5505
ScaleWidth = 9150
Begin VB.CommandButton FindButton
Caption = "┉"
Height = 255
Left = 1800
TabIndex = 15
Top = 2160
Width = 255
End
Begin VB.TextBox StartDate
BackColor = &H00C0FFFF&
Height = 270
Left = 7080
MaxLength = 10
TabIndex = 7
Text = "StartDate"
Top = 1080
Width = 1695
End
Begin VB.TextBox Company
BackColor = &H00C0FFFF&
Height = 270
Left = 960
MaxLength = 50
TabIndex = 6
Text = "Company"
Top = 1560
Width = 1935
End
Begin VB.TextBox EmpName
BackColor = &H00C0FFFF&
Height = 270
Left = 7080
MaxLength = 10
TabIndex = 5
Text = "EmpName"
Top = 600
Width = 1695
End
Begin VB.TextBox EndDate
BackColor = &H00C0FFFF&
Height = 270
Left = 7080
MaxLength = 10
TabIndex = 4
Text = "EndDate"
Top = 1560
Width = 1695
End
Begin VB.TextBox Phone
BackColor = &H00C0FFFF&
Height = 270
Left = 3960
MaxLength = 20
TabIndex = 3
Text = "Phone"
Top = 1560
Width = 1935
End
Begin VB.TextBox CarType
BackColor = &H00C0FFFF&
Height = 270
Left = 3960
MaxLength = 20
TabIndex = 2
Text = "CarType"
Top = 1080
Width = 1935
End
Begin VB.TextBox CarCode
BackColor = &H00C0FFFF&
Height = 270
Left = 960
MaxLength = 20
TabIndex = 1
Text = "CarCode"
Top = 1080
Width = 1935
End
Begin VB.Label LabelEndFlag
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "完 工"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 375
Left = 240
TabIndex = 16
Top = 240
Width = 1095
End
Begin VB.Label EmpLabel
BackStyle = 0 'Transparent
Caption = "维修人员"
Height = 255
Left = 6120
TabIndex = 14
Top = 600
Width = 855
End
Begin VB.Label EndLabel
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "完工日期"
Height = 180
Left = 6120
TabIndex = 13
Top = 1560
Width = 720
End
Begin VB.Label StartLabel
BackStyle = 0 'Transparent
Caption = "送修日期"
Height = 255
Left = 6120
TabIndex = 12
Top = 1080
Width = 735
End
Begin VB.Label PhoneLabel
BackStyle = 0 'Transparent
Caption = "电 话"
Height = 255
Left = 3120
TabIndex = 11
Top = 1560
Width = 735
End
Begin VB.Label TypeLabel
BackStyle = 0 'Transparent
Caption = "车 型"
Height = 255
Left = 3120
TabIndex = 10
Top = 1080
Width = 615
End
Begin VB.Label CompLabel
BackStyle = 0 'Transparent
Caption = "送修单位"
Height = 255
Left = 120
TabIndex = 9
Top = 1560
Width = 735
End
Begin VB.Label CodeLabel
BackStyle = 0 'Transparent
Caption = "车 号"
Height = 255
Left = 120
TabIndex = 8
Top = 1080
Width = 735
End
Begin VB.Label TableHead
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "汽车维修情况"
BeginProperty Font
Name = "宋体"
Size = 18
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 360
Left = 3600
TabIndex = 0
Top = 120
Width = 2250
End
End
Attribute VB_Name = "WorkHead"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Type EmpData
EmpId As Long
EmpCode As String
EmpName As String
EmpIsChange As Boolean
End Type
Private m_CarProject As CarProject
Private m_EmpData As EmpData
'Private m_WorkState As WorkMode
Public Event PopupFind(ByRef pComm As String, ByRef pVal As TextBox)
Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
Private Sub CarCode_GotFocus()
'隐藏查找按钮
FindButton.Visible = False
End Sub
Private Sub CarType_GotFocus()
'隐藏查找按钮
FindButton.Visible = False
End Sub
Private Sub Company_GotFocus()
'隐藏查找按钮
FindButton.Visible = False
End Sub
Private Sub EmpName_Change()
'置修改标志
m_EmpData.EmpIsChange = True
End Sub
'Public Event DataSave()
Private Sub EmpName_GotFocus()
'显示查找按钮
FindButton.Move EmpName.Left + EmpName.Width, EmpName.Top
FindButton.Visible = True
'设置按钮类型
End Sub
Private Sub EmpName_LostFocus()
'根据人员编号查找人员名称
Dim InputString As String
Dim re As ADODB.Recordset
If ActiveControl Is Nothing Then Exit Sub
If TypeOf ActiveControl Is CommandButton Then
m_EmpData.EmpIsChange = True
Exit Sub
End If
FindEmp
End Sub
Private Sub EndDate_GotFocus()
'隐藏查找按钮
FindButton.Visible = False
'显示查找按钮
'设置按钮类型
End Sub
Private Sub EndDate_LostFocus()
If Not IsDate(EndDate.Text) Then
MsgBox "无效日期,请重输", vbCritical Or vbOKOnly, "错误"
EndDate.SelStart = 0
EndDate.SelLength = Len(StartDate.Text)
EndDate.SetFocus
End If
End Sub
Private Sub FindButton_Click()
Dim t_find As String
t_find = vbNullString
If EmpName.Text <> "" Then t_find = "WHERE Name LIKE '" & Trim$(EmpName.Text) & "%'"
RaiseEvent PopupFind("SELECT Code as 存货代码,Name as 存货名称 FROM Employees " & t_find, _
EmpName)
'弹出查询窗口
'获得返回值
'设置窗口控件值
End Sub
Private Sub FindButton_LostFocus()
FindEmp
End Sub
Private Sub Phone_GotFocus()
'隐藏查找按钮
FindButton.Visible = False
End Sub
Private Sub StartDate_GotFocus()
'隐藏查找按钮
FindButton.Visible = False
'显示查找按钮
'设置按钮类型
End Sub
Private Sub StartDate_LostFocus()
If Not IsDate(StartDate.Text) Then
MsgBox "无效日期,请重输", vbCritical Or vbOKOnly, "错误"
StartDate.SelStart = 0
StartDate.SelLength = Len(StartDate.Text)
StartDate.SetFocus
End If
End Sub
Private Sub UserControl_Initialize()
Set m_CarProject = New CarProject
m_EmpData.EmpId = -1
m_EmpData.EmpIsChange = True
m_EmpData.EmpCode = vbNullString
m_EmpData.EmpName = vbNullString
End Sub
Private Sub UserControl_Paint()
Line (0, 0)-(9140, 5480), , B
End Sub
Private Sub UserControl_Resize()
UserControl.Width = 9150
UserControl.Height = 5500
End Sub
Private Sub UserControl_Show()
FindButton.Visible = False
ShowData
End Sub
Public Sub ClearData()
m_CarProject.ClearPrivateDate
End Sub
Public Sub ShowData()
Dim re As ADODB.Recordset
With m_CarProject
CarCode.Text = .CarCode
CarType.Text = .CarType
Company.Text = .Company
Phone.Text = .Phone
StartDate.Text = FormatDateTime(.StartDate, vbShortDate)
EndDate.Text = FormatDateTime(.EndDate, vbShortDate)
m_RepairSum = .RepairSum
m_InventorySum = .InventorySum
LabelEndFlag.Visible = m_EndFlag
If .EmpId > 0 Then
Set re = SQLFind(CStr(.EmpId), "Employees", "AutoId", FT_NUMBER)
If re.BOF And re.EOF Then
MsgBox "数据库出错,请检查", vbCritical Or vbOKOnly, "错误"
Exit Sub
End If
EmpName.Text = re.Fields(2).Value
Set re = Nothing
Else
EmpName.Text = vbNullString
End If
End With
End Sub
Public Function Save() As Boolean
Dim t_code As String
'Dim t_type As String
Dim t_startdate As Date
Dim t_enddate As Date
t_code = Trim$(CarCode.Text)
If t_code = "" Then
MsgBox "车号一定要输入", vbCritical Or vbOKOnly, "错误"
SetTextBoxFocus CarCode
Save = False
Exit Function
End If
't_type = Trim$(CarType.Text)
If Not IsDate(StartDate.Text) Then
MsgBox "请输入送修日期", vbCritical Or vbOKOnly, "错误"
SetTextBoxFocus StartDate
Save = False
Exit Function
End If
t_startdate = CDate(StartDate.Text)
If Not IsDate(EndDate.Text) Then
MsgBox "请输入完工日期", vbCritical Or vbOKOnly, "错误"
SetTextBoxFocus EndDate
Save = False
Exit Function
End If
t_enddate = CDate(EndDate.Text)
If t_startdate > t_enddate Then
MsgBox "开始日期不能大于结束时间", vbCritical Or vbOKOnly, "错误"
Save = False
SetTextBoxFocus EndDate
Exit Function
End If
If Not FindEmp Then
Save = False
Exit Function
End If
With m_CarProject
Set .ActiveConnection = g_Conn
.CarCode = t_code
.CarType = Trim$(CarType.Text)
.Company = Trim$(Company.Text)
.Phone = Trim$(Phone.Text)
.StartDate = t_startdate
.EndDate = t_enddate
.EmpId = m_EmpData.EmpId
End With
If m_CarProject.WorkHeadId < 0 Then
Save = m_CarProject.AddSave
Else
Save = m_CarProject.EditSave
End If
End Function
Public Function FindData(ByVal SQLCom As String, ByRef pConn As ADODB.Connection) As Boolean
Set m_CarProject.ActiveConnection = pConn
FindData = m_CarProject.FindProject(SQLCom)
End Function
Public Property Let Enabled(ByVal vData As Boolean)
CarCode.Enabled = vData
CarType.Enabled = vData
Company.Enabled = vData
Phone.Enabled = vData
StartDate.Enabled = vData
EndDate.Enabled = vData
EmpName.Enabled = vData
FindButton.Visible = vData
End Property
Private Function FindEmp() As Boolean
Dim InputString As String
Dim re As ADODB.Recordset
If EmpName.Text = "" Then Exit Function
If m_EmpData.EmpIsChange Then
InputString = Trim$(EmpName.Text)
If IsNumeric(InputString) Then
Set re = SQLFind(InputString, "Employees", "Code", FT_CHAR)
Else
Set re = SQLFind(InputString, "Employees", "Name", FT_CHAR)
End If
If re.BOF And re.EOF Then
MsgBox "不存在该员工,请重新输入", vbCritical Or vbOKOnly, "错误"
EmpName.Text = m_EmpData.EmpName
SetTextBoxFocus EmpName
FindEmp = False
Else
m_EmpData.EmpId = re.Fields(0).Value
m_EmpData.EmpCode = re.Fields(1).Value
m_EmpData.EmpName = re.Fields(2).Value
m_EmpData.EmpIsChange = False
EmpName.Text = m_EmpData.EmpName
FindEmp = True
End If
Else
FindEmp = True
End If
Set re = Nothing
End Function
Private Function SetTextBoxFocus(ByRef Obj As TextBox) As Boolean
SetTextBoxFocus = SetFocus(Obj.hwnd)
End Function
Public Function GetWorkId() As Long
GetWorkId = m_CarProject.WorkHeadId
End Function
Public Property Let RepairSum(ByRef vData As Double)
If vData < 0 Then Exit Property
m_CarProject.RepairSum = vData
'mfiIsDirty = True
End Property
Public Property Get RepairSum() As Double
RepairSum = m_CarProject.RepairSum
End Property
'm_InventorySum
Public Property Let InventorySum(ByRef vData As Double)
If vData < 0 Then Exit Property
m_CarProject.InventorySum = vData
'mfiIsDirty = True
End Property
Public Property Get InventorySum() As Double
InventorySum = m_CarProject.InventorySum
End Property
Public Function SetWorkEnd()
SetWorkEnd = m_CarProject.SetWorkEnd()
LabelEndFlag.Visible = m_CarProject.EndFlag
End Function
Public Function ResetWorkEnd()
ResetWorkEnd = m_CarProject.ResetWorkEnd()
LabelEndFlag.Visible = m_CarProject.EndFlag
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -