📄 frmele.frm
字号:
EndProperty
BeginProperty Column05
Object.Visible = 0 'False
EndProperty
BeginProperty Column06
ColumnWidth = 915.024
EndProperty
BeginProperty Column07
ColumnWidth = 870.236
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 555
Left = 0
TabIndex = 17
Top = 0
Width = 8295
_ExtentX = 14631
_ExtentY = 979
ButtonWidth = 979
ButtonHeight = 926
Appearance = 1
Style = 1
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 8
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "新 增"
Key = "new"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "保 存"
Key = "save"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "删 除"
Key = "dele"
ImageIndex = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "查 找"
Key = "find"
ImageIndex = 4
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Object.Visible = 0 'False
Style = 3
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Caption = "修 改"
Key = "print"
ImageIndex = 7
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退 出"
Key = "exit "
ImageIndex = 6
EndProperty
EndProperty
Begin MSComctlLib.ImageList ImageList1
Left = 6600
Top = 0
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 7
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmele.frx":3F60
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmele.frx":45DC
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmele.frx":4C58
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmele.frx":4D6C
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmele.frx":53E8
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmele.frx":5A64
Key = ""
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmele.frx":5CF8
Key = ""
EndProperty
EndProperty
End
End
End
Attribute VB_Name = "frmelement"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RsE As New Recordset
Dim Fcom As New Recordset
Dim rsC As New Recordset
Public InsertType As String
Private Sub CmdInsert_Click()
If frmelement.InsertType = "FRMIOorder" Then
frmioorder.lblprod = txtid
frmioorder.txtProd = txtEname
frmioorder.txttype = txttype
Unload Me
frmioorder.txtPrice.SetFocus
ElseIf frmelement.InsertType = "frmIFind" Then
If frmIFind.cmdE1 Or Frm_BuyFind.cmdE1 Then
frmIFind.txtele = txtEname
Frm_BuyFind.txtele = txtEname
frmIFind.lbltype = txttype
Frm_BuyFind.lbltype = txtypye
frmIFind.lbltype1 = txttype
Frm_BuyFind.lbltype1 = txttype
frmIFind.txtele1 = txtEname
Frm_BuyFind.txtele1 = txtEname
Unload Me
Else
frmIFind.txtele1 = txtEname
Frm_BuyFind.txtele1 = txtEname
frmIFind.lbltype1 = txttype
Frm_BuyFind.lbltype1 = txttype
Unload Me
End If
End If
If frmelement.InsertType = "Frmbuy" Then
Frmbuy.lblprod = txtid
Frmbuy.txtProd = txtEname
Frmbuy.txttype = txttype
Frmbuy.txtunit = txtunit
Unload Me
Frmbuy.txtPrice.SetFocus
End If
End Sub
Private Sub dtcompany_KeyPress(KeyAscii As Integer)
keysacii = 0
End Sub
Private Sub dtgrd_Click()
CmdInsert.Enabled = True
CmdInsert.Visible = True
On Error GoTo l
txtid = dtgrd.Columns(0).Text
Toolbar1.Buttons(6).Enabled = True
Exit Sub
l: Exit Sub
End Sub
Private Sub dtgrd_DblClick()
CmdInsert_Click
End Sub
Private Sub dtgrd_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
If Not (RsE.BOF Or RsE.EOF) Then
dtgrd_Click
End If
End Sub
'Private Sub Form_Activate()
' If RsE.State Then
' RsE.Close
' End If
' RsE.Open "select * from elestock order by id", cn, adOpenStatic, adLockBatchOptimistic
' RsE.Filter = ""
' Set dtgrd.DataSource = RsE
' Toolbar1.Buttons(2).Enabled = False
' bar.Panels(1).Text = "元件总数：" & RsE.RecordCount & " 个 "
'End Sub
Private Sub Form_Load()
If RsE.State Then
RsE.Close
End If
RsE.Open "select * from elestock order by id", cn, adOpenStatic, adLockBatchOptimistic
RsE.Filter = ""
Set dtgrd.DataSource = RsE
Toolbar1.Buttons(2).Enabled = False
bar.Panels(1).Text = "元件总数：" & RsE.RecordCount & " 个 "
End Sub
Private Sub Form_Unload(Cancel As Integer)
If RsE.State Then
RsE.Close
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo gl
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim Oldi As Integer
Dim Idadd As Integer
Dim NumId As Integer
Select Case Trim(Button.Key)
Case "new"
frmE.Enabled = True
txtid = ""
txtEname = ""
txtS = ""
txtunit = ""
txttype = ""
txtstock = ""
txtEname.SetFocus
Toolbar1.Buttons(1).Enabled = False
Toolbar1.Buttons(2).Enabled = True
Toolbar1.Buttons(6).Enabled = False
Toolbar1.Buttons(3).Enabled = False
Case "save"
If Toolbar1.Buttons(1).Enabled = False Then
If txttype = "" Then
MsgBox " 请输入元件型号！ ", , ginfo
txttype.SetFocus
Exit Sub
End If
If txtEname <> "" Then
RsE.Filter = "ename='" & txtEname & "'and etype='" & Trim(txttype) & "'"
If Not (RsE.BOF Or RsE.EOF) Then
MsgBox " 该元件已经存在! ", , ginfo
Toolbar1.Buttons(2).Enabled = False
Toolbar1.Buttons(3).Enabled = True
Toolbar1.Buttons(1).Enabled = True
RsE.Filter = ""
RsE.Requery
Exit Sub
End If
Else
MsgBox " 请输入产品名称！ ", , ginfo
Exit Sub
End If
RsE.Filter = ""
RsE.Requery
If RsE.RecordCount >= 0 Then
Idadd = RsE.RecordCount
Else
Idadd = 1
End If
RsE.AddNew
RsE!ID = Idadd + 1
RsE!ename = txtEname
If txtS <> "" Then RsE!Estandard = txtS
RsE!etype = txttype
If txtunit <> "" Then RsE!eunit = txtunit
RsE!estock = 0
If txtlow <> "" Then RsE!elowstock = txtlow
If txthigh <> "" Then RsE!ehighstock = txthigh
RsE!Xy = 0
RsE.UpdateBatch adAffectCurrent
RsE.Requery
RsE.MoveLast
Toolbar1.Buttons(2).Enabled = False
Toolbar1.Buttons(3).Enabled = True
Toolbar1.Buttons(1).Enabled = True
Else
If txtEname <> "" Then
RsE.Filter = "(ename='" & txtEname & "' and etype='" & Trim(txttype) & "') And ID <> " & txtid & " "
If Not (RsE.BOF Or RsE.EOF) Then
MsgBox " 该元件已经存在! ", , ginfo
Exit Sub
End If
Else
MsgBox " 请输入产品名称！ ", , ginfo
Exit Sub
End If
RsE.Close
Set RsE = Nothing
'Form_Activate
Form_Load
RsE.Find "id=" & txtid
If txtS <> "" Then RsE!Estandard = txtS
If txttype <> "" Then RsE!etype = txttype
If txtunit <> "" Then RsE!eunit = txtunit
RsE!ename = txtEname
RsE!Xy = 0
RsE!estock = 0
If txtlow <> "" Then RsE!elowstock = txtlow
If txthigh <> "" Then RsE!ehighstock = txthigh
RsE.UpdateBatch adAffectCurrent
RsE.Requery
RsE.Find "ename='" & txtEname & "'"
End If
frmE.Enabled = False
Toolbar1.Buttons(6).Enabled = True
Toolbar1.Buttons(2).Enabled = False
bar.Panels(1).Text = "元件总数：" & RsE.RecordCount & " 个 "
Case "dele"
On Error GoTo l
rs.Open "select * from iotbl", cn, adOpenKeyset, adLockBatchOptimistic
rs.Find "bh=" & dtgrd.Columns(0).Text
If Not (rs.BOF Or rs.EOF) Then
MsgBox " 单据中包含此记录，您无法删除！ ", , ginfo
rs.Close
Exit Sub
End If
Set rs = Nothing
Re = MsgBox(" 你确定要删除数据吗？ ", vbYesNo + vbQuestion + vbDefaultButton2, ginfo)
If Re = vbYes Then
If txtid = "" Then
txtid = dtgrd.Columns(0).Text
End If
RsE.Find "id=" & txtid
Oldi = RsE.RecordCount
cmd.ActiveConnection = cn
cmd.CommandText = "delete * from elestock where id =" & txtid
cmd.Execute
cmd.ActiveConnection = Nothing
RsE.MoveNext
If Not (RsE.EOF Or RsE.BOF) Then
Do While Not RsE.EOF
If Val(txtid) <= RsE.Fields!ID Then
RsE.Fields!ID = RsE.Fields!ID - 1
RsE.UpdateBatch adAffectCurrent
RsE.MoveNext
Else
Exit Do
End If
Loop
End If
RsE.Requery
End If
Exit Sub
l: MsgBox err.Description, , ginfo
Case "find"
Re = InputBox("请输入元件名称：", "查找信息", Default, 2500, 2500)
If Re <> "" Then
RsE.Filter = "ename like '%" & Trim(Re) & "%'"
If RsE.BOF Or RsE.EOF Then
MsgBox " 对不起，没找到该记录！", , ginfo
Set RsE = Nothing
' Form_Activate
Form_Load
Exit Sub
End If
End If
Case "print"
If txtEname.Text <> "" Then
frmE.Enabled = True
txtid_Change
Toolbar1.Buttons(6).Enabled = False
Toolbar1.Buttons(2).Enabled = True
Toolbar1.Buttons(1).Enabled = True
If txtunit.Enabled Then txtunit.SetFocus
End If
Case "exit"
Unload Me
End Select
Exit Sub
gl: MsgBox err.Description
End Sub
Private Sub OrderNumID(NumId As Integer, rs As ADODB.Recordset)
If Not rs.EOF Then
Do While Not rs.EOF
rs.Fields!ID = rs.Fields!ID - 1
rs.MoveNext
Loop
End If
End Sub
Private Sub txtid_Change()
If txtid <> "" Then
RsE.Find "id=" & txtid
If Not (RsE.BOF Or RsE.EOF) Then
txtEname = RsE!ename
txtS = RsE!Estandard & ""
txttype = RsE!etype & ""
txtunit = RsE!eunit & ""
txtEstock = RsE!estock
txtlow = RsE!elowstock
txthigh = RsE!ehighstock
End If
End If
End Sub
Private Function DateCheck() As String
If dtcompany = "" Then
DateCheck = " 请选择公司名称！ "
Exit Function
End If
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -