📄 frmbeforecolor.frm
字号:
VERSION 5.00
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "Actbar2.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmBeforeColor
Caption = "顏色資料"
ClientHeight = 4785
ClientLeft = 60
ClientTop = 345
ClientWidth = 4260
LinkTopic = "Form1"
ScaleHeight = 4785
ScaleWidth = 4260
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin ActiveBar2LibraryCtl.ActiveBar2 ActiveBar21
Height = 4785
Left = 0
TabIndex = 0
Top = 0
Width = 4260
_LayoutVersion = 1
_ExtentX = 7514
_ExtentY = 8440
_DataPath = ""
Bands = "frmBeforeColor.frx":0000
Begin VB.Frame Frame1
Height = 4155
Left = 60
TabIndex = 1
Top = 540
Width = 4095
Begin VB.ComboBox txteColorName
Height = 315
Left = 1500
TabIndex = 18
Top = 1560
Width = 1995
End
Begin VB.ComboBox txtColorName
Height = 315
Left = 1500
TabIndex = 17
Top = 1140
Width = 1995
End
Begin VB.CheckBox ComColor
Caption = "Check1"
Height = 195
Left = 1500
TabIndex = 15
Top = 2100
Width = 195
End
Begin VB.TextBox txtColorNumber
BackColor = &H00FFFFC0&
Height = 315
Left = 1500
TabIndex = 7
Text = "0"
Top = 2520
Width = 1995
End
Begin VB.TextBox txtLabdipNo
BackColor = &H8000000F&
Enabled = 0 'False
Height = 315
Left = 1500
MaxLength = 20
TabIndex = 6
Top = 240
Width = 1995
End
Begin VB.TextBox txtOrderNo
BackColor = &H8000000F&
Enabled = 0 'False
Height = 315
Left = 1500
MaxLength = 20
TabIndex = 5
Top = 660
Width = 1995
End
Begin VB.TextBox ColorId
Height = 315
Left = 2820
TabIndex = 2
Top = 2040
Visible = 0 'False
Width = 615
End
Begin MSComCtl2.DTPicker txtReviewsDate
Height = 315
Left = 1500
TabIndex = 3
Top = 3480
Width = 2055
_ExtentX = 3625
_ExtentY = 556
_Version = 393216
Format = 92798977
CurrentDate = 39583
End
Begin MSComCtl2.DTPicker txtLabdipDate
Height = 315
Left = 1500
TabIndex = 4
Top = 2940
Width = 2055
_ExtentX = 3625
_ExtentY = 556
_Version = 393216
Format = 92798977
CurrentDate = 39583
End
Begin VB.Label Label4
Caption = "英文颜色名称"
Height = 255
Left = 300
TabIndex = 16
Top = 1560
Width = 1215
End
Begin VB.Label Label24
Caption = "訂單號"
Height = 255
Left = 300
TabIndex = 14
Top = 720
Width = 1275
End
Begin VB.Label Label14
Caption = "評語日期"
Height = 255
Left = 300
TabIndex = 13
Top = 3540
Width = 1035
End
Begin VB.Label Label16
Caption = "上批日期"
Height = 255
Left = 300
TabIndex = 12
Top = 2940
Width = 1035
End
Begin VB.Label Label1
Caption = "上批單號"
Height = 255
Left = 300
TabIndex = 11
Top = 300
Width = 1035
End
Begin VB.Label Label2
Caption = "顏色結果"
Height = 255
Index = 1
Left = 300
TabIndex = 10
Top = 2040
Width = 1035
End
Begin VB.Label Label3
Caption = "顏色名稱"
Height = 255
Index = 1
Left = 300
TabIndex = 9
Top = 1140
Width = 1035
End
Begin VB.Label Label11
Caption = "次數"
Height = 255
Left = 300
TabIndex = 8
Top = 2520
Width = 1035
End
End
End
End
Attribute VB_Name = "frmBeforeColor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public newItem As Boolean 'true表示增加
Private Sub ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
Select Case Tool.Name
Case "cmdSave":
Save newItem
Case "cmdCancel":
Unload Me
Case "cmdDel":
DelOperatorInf
End Select
End Sub
Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
Initcbb txtColorName, "Color", "tBasicColor"
Initcbb txteColorName, "eColor", "tBasicColor"
InitTitle
End Sub
Private Sub InitTitle()
Label1.Caption = "上批單號"
Label24.Caption = "訂單號"
Label3.item(1).Caption = "顏色名稱"
Label4.Caption = "英文颜色名称"
Label2.item(1).Caption = "顏色結果"
Label11.Caption = "次數"
Label16.Caption = "上批日期"
Label14.Caption = "評語日期"
Me.Caption = "顏色資料"
End Sub
Private Sub DelOperatorInf()
Dim strSql As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
On Error GoTo errHandle
If MsgBox("确定要刪除？", vbQuestion + vbYesNo, "询问") = vbNo Then
Exit Sub
Else
strSql = "delete from tBeforeLabdipColor where labdipNo='" & txtLabdipNo & "' and ColorName='" & txtColorName & "'"
objDatabase.ExecCmd strSql
strSql = "delete from tBeforeLabdipColorSub where LabdipNo='" & txtLabdipNo & "' and ColorName='" & txtColorName & "'"
objDatabase.ExecCmd strSql
MsgBox "刪除成功!", vbInformation, "提示"
End If
rs.Open "select Color from tBeforeLabdipColor where Color=0 and LabdipNo='" & txtLabdipNo & "'", Cn, 1, 3
If rs.BOF Or rs.EOF Then
frmBeforeInfo.chkColor.Value = 1
Else
frmBeforeInfo.chkColor.Value = 0
End If
rs.Close
Set rs = Nothing
frmBeforeInfo.FillMshf2 ("select * from tBeforeLabdipColor where LabdipNo='" & txtLabdipNo & "'")
frmBeforeInfo.FillMshf3 ("select * from tBeforeLabdipColorSub where LabdipNo='" & txtLabdipNo & "'")
Unload Me
Exit Sub
errHandle:
objDatabase.DatabaseError
End Sub
Public Sub InitInfo(strId As String, LabdipNo As String, OrderNo As String)
If newItem = False Then
Dim rs As ADODB.Recordset
SystemExecuteStart Me
' On Error GoTo errLabel
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
Set .ActiveConnection = Cn
End With
Dim strSql As String
strSql = "select * from tBeforeLabdipColor where id=" & strId
rs.Open strSql
If Not rs.EOF Then
txtLabdipNo.Text = NullValue(rs.Fields!LabdipNo)
txtOrderNo.Text = NullValue(rs.Fields!OrderNo)
ColorId = NullValue(rs.Fields!ID)
ComColor.Value = IIf(rs.Fields!Color, "1", "0")
txtColorName = NullValue(rs.Fields!ColorName)
txteColorName = NullValue(rs.Fields!eColorName)
txtColorNumber = NullValue(rs.Fields!ColorNumber)
txtLabdipDate = NullValue(rs.Fields!LabdipDate)
txtReviewsDate = NullValue(rs.Fields!ReviewsDate)
End If
rs.Close
Set rs = Nothing
SystemExecuteEnd Me
Exit Sub
Else
txtLabdipNo.Text = LabdipNo
txtOrderNo.Text = OrderNo
SystemExecuteEnd Me
Exit Sub
End If
errLabel:
SystemExecuteEnd Me
objDatabase.DatabaseError
End Sub
Private Sub Save(Optional blModi As Boolean)
Dim strSql As String
Dim strCdh, strZl, strSl As String
Dim rs As ADODB.Recordset
Dim mycomm As ADODB.Command
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
Set .ActiveConnection = Cn
End With
strSql = "select * from tBeforeLabdipColor where LabdipNo='" & txtLabdipNo & "'and ColorName='" & Trim$(txtColorName) & "'"
On Error GoTo errHandle
rs.Open strSql
If IsNumeric(txtColorNumber) = False Then
MsgBox "請在次數上填寫數字", vbCritical, "提示"
rs.Close
Set rs = Nothing
txtColorNumber.SetFocus
Exit Sub
End If
If blModi Then
If txtColorName = "" Or txtLabdipNo = "" Or txtOrderNo = "" Then
MsgBox "請將信息填寫完整 ", vbCritical, " 提示"
rs.Close
Set rs = Nothing
txtLabdipNo.SetFocus
Exit Sub
End If
If Not rs.EOF Then
MsgBox "此顏色已存在！", vbCritical, "提示"
txtColorName.Text = ""
txtColorName.SetFocus
rs.Close
Set rs = Nothing
Exit Sub
End If
If MsgBox("是否增加新顏色？", vbQuestion + vbYesNo, "询问") = vbNo Then
rs.Close
Set rs = Nothing
Exit Sub
End If
rs.AddNew '新建
Else
If rs.EOF Then '修改
MsgBox "没有可修改的信息!", vbExclamation, "修改"
rs.Close
Set rs = Nothing
txtLabdipNo.SetFocus
Exit Sub
End If
If MsgBox("是否修改记录？", vbYesNo + vbQuestion, "修改") = vbNo Then
rs.Close
Set rs = Nothing
Exit Sub
End If
End If
rs.Fields!LabdipNo = Trim$(txtLabdipNo)
rs.Fields!OrderNo = Trim$(txtOrderNo)
rs.Fields!ColorName = Trim$(txtColorName)
rs.Fields!eColorName = Trim$(txteColorName)
rs.Fields!Color = ComColor.Value
rs.Fields!ColorNumber = txtColorNumber
rs.Fields!LabdipDate = Trim$(txtLabdipDate)
rs.Fields!ReviewsDate = Trim$(txtReviewsDate)
rs.Update
MsgBox "操作成功！", vbInformation, "恭喜"
rs.Close
rs.Open "select Color from tBeforeLabdipColor where Color=0 and LabdipNo='" & txtLabdipNo & "'"
If rs.BOF Or rs.EOF Then
frmBeforeInfo.chkColor.Value = 1
Else
frmBeforeInfo.chkColor.Value = 0
End If
Set rs = Nothing
frmBeforeInfo.FillMshf2 ("select * from tBeforeLabdipColor where LabdipNo='" & txtLabdipNo & "'")
Unload Me
Exit Sub
errHandle:
Set rs = Nothing
objDatabase.DatabaseError
End Sub
Private Sub txtColorNumber_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> 46 Then
If KeyAscii < 48 Or KeyAscii > 57 Then
KeyAscii = 0
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -