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

📄 workhead.ctl

📁 汽车维修管理软件。其中包含三个编辑控件。
💻 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 + -