📄 frmtoolio.frm
字号:
Height = 255
Left = 6360
Style = 1 'Graphical
TabIndex = 15
Top = 240
Width = 852
End
Begin VB.TextBox txttype
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Enabled = 0 'False
Height = 276
Left = 960
TabIndex = 14
Top = 600
Width = 2292
End
Begin VB.CommandButton Command2
BackColor = &H00E0E0E0&
Caption = "查找"
Height = 255
Left = 2640
Style = 1 'Graphical
TabIndex = 13
Top = 240
Width = 615
End
Begin VB.Label lblcompid
Height = 252
Left = 5400
TabIndex = 27
Top = 240
Visible = 0 'False
Width = 732
End
Begin VB.Label lblprod
Height = 252
Left = 120
TabIndex = 26
Top = 360
Visible = 0 'False
Width = 732
End
Begin VB.Label lbl3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "备注:"
Height = 180
Left = 5520
TabIndex = 25
Top = 600
Width = 456
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "工具名称："
Height = 180
Left = 120
TabIndex = 24
Top = 240
Width = 900
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "数量："
Height = 180
Left = 3360
TabIndex = 23
Top = 600
Width = 540
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "单价："
Height = 180
Left = 3360
TabIndex = 22
Top = 240
Width = 900
End
Begin VB.Label lbltype
Caption = "Label7"
Height = 132
Left = -240
TabIndex = 21
Top = -360
Width = 732
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "工具型号："
Height = 180
Left = 120
TabIndex = 20
Top = 600
Width = 900
End
End
Begin MSComctlLib.StatusBar bar
Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 29
Top = 5205
Width = 9105
_ExtentX = 16060
_ExtentY = 450
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 2
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 1
Object.Width = 4304
MinWidth = 4304
Text = "工具"
TextSave = "工具"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
TextSave = "2003-04-30"
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "工具入库"
BeginProperty Font
Name = "隶书"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 300
Left = 4080
TabIndex = 28
Top = 120
Width = 1308
End
End
Attribute VB_Name = "frmtoolio"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Rsuse As New ADODB.Recordset
Dim RSToolM As New ADODB.Recordset
Dim RstoolD As New ADODB.Recordset
Private Sub CMDADDDTL_Click()
Dim RstF As New ADODB.Recordset
Dim AddId As Integer
On Error GoTo l
If Len(txtamount) = 0 Or Len(txtProd) = 0 Then
MsgBox " 数据不完整，请检查！", , ginfo
Exit Sub
End If
RSToolM!Date = dtptime.Value
If InStr(1, Label3.Caption, "入") <> 0 Then
RSToolM!ioflg = True
Else
RSToolM!ioflg = False
End If
RSToolM!HandleManid = Val(dtcmb.BoundText)
RSToolM.UpdateBatch adAffectCurrent
AddId = RstoolD.RecordCount
RstoolD.AddNew
RstoolD!ID = AddId + 1
' If RstoolD.RecordCount <= 1 Then
' RstoolD!ID = 1
' Else
' RstoolD!ID = RstoolD.RecordCount
' End If
RstoolD!bh = lblprod
RstoolD!ioid = txtid
If Trim(txtPrice) <> "" Then RstoolD!price = Val(txtPrice)
RstoolD!amount = Val(txtamount)
RstoolD!Memo = txtmemo
RstoolD.UpdateBatch adAffectCurrent
RstoolD.Requery
RstF.Open "select * from toolf where idm =" & txtid, cn, adOpenKeyset, adLockBatchOptimistic
RstF.Requery
Set dtgrdT.DataSource = RstF
dtgrdT.Refresh
Set RstF = Nothing
txtProd.Text = ""
txttype.Text = ""
txtPrice.Text = ""
txtamount.Text = ""
Exit Sub
l: MsgBox err.Description
End Sub
Private Sub Command1_Click()
On Error GoTo l
Dim RstoolD As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim RstF As New ADODB.Recordset
RstoolD.Open "select * from toolstock", cn, adOpenKeyset, adLockBatchOptimistic
If dtgrdT.row <> -1 Then
Re = MsgBox("您确定要删除表格中的记录吗?", vbYesNo + vbQuestion + vbDefaultButton2, ginfo)
If Re = 6 Then
RstoolD.Find "id=" & dtgrdT.Columns(0).Text
' txtid = dtgrdT.Columns(0).Text
' RstoolD.MoveNext
If Not RstoolD.BOF Or Not RstoolD.EOF Then
Set cmd.ActiveConnection = cn
cmd.CommandText = "delete * from tooliodetail where id =" & dtgrdT.Columns(0).Text
cmd.Execute
cmd.ActiveConnection = Nothing
RstoolD.Requery
RstF.Open "select * from toolf where idm=" & txtid, cn, adOpenKeyset, adLockBatchOptimistic
RstF.Requery
Set dtgrdT.DataSource = RstF
dtgrdT.Refresh
End If
End If
End If
Exit Sub
l: MsgBox err.Description
End Sub
Private Sub Command2_Click()
FrmtoolInfo.InsertType = "frmtoolio"
FrmtoolInfo.CmdInsert.Visible = True
FrmtoolInfo.Show 1
End Sub
Private Sub dtcmb_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Form_Load()
RSToolM.Open "select * from toolmain", cn, adOpenKeyset, adLockBatchOptimistic
RstoolD.Open "select * from tooliodetail", cn, adOpenKeyset, adLockBatchOptimistic
Rsuse.Open "select * from usertable", cn, adOpenKeyset, adLockBatchOptimistic
Set dtcmb.RowSource = Rsuse
Set dtcmb.DataSource = Rsuse
dtcmb.ListField = "username"
dtcmb.BoundColumn = "id"
dtcmb.Text = UsrName
Toolbar1.Buttons(2).Enabled = False
Toolbar1.Buttons(6).Enabled = False
If UsrName = Rsuse.Fields!UserName Then
Toolbar1.Buttons(3).Enabled = True
Else
Toolbar1.Buttons(3).Enabled = False
End If
dtptime.Value = Format(Now, "yy-mm-dd")
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim Str As String
If Toolbar1.Buttons(2).Enabled <> False And dtgrdT.row <> -1 Then
Str = MsgBox("你修改或添加的数据将不会被保存,你确定要退出吗？", vbYesNo, "提示信息")
If Str = vbYes Then
Unload Me
RSToolM.Delete adAffectCurrent
RSToolM.UpdateBatch adAffectCurrent
RSToolM.MoveNext
Else
Cancel = 1
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
RSToolM.Close
Rsuse.Close
RstoolD.Close
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo gl
Dim RstF As New ADODB.Recordset
Dim RsTool As New ADODB.Recordset
Select Case Trim(Button.Key)
Case "new"
Frame1.Enabled = True
frmio.Enabled = True
Toolbar1.Buttons(1).Enabled = False
Toolbar1.Buttons(2).Enabled = True
Toolbar1.Buttons(3).Enabled = False
Command2.SetFocus
RSToolM.AddNew
If RSToolM.RecordCount <= 1 Then
RSToolM!ID = 1
Else
RSToolM!ID = RSToolM.RecordCount
End If
txtid = RSToolM!ID
Case "save"
RsTool.Open "select * from toolstock", cn, adOpenKeyset, adLockBatchOptimistic
If txtid <> "" Then
RstF.Open "select * from toolf where idm =" & txtid, cn, adOpenKeyset, adLockBatchOptimistic
End If
dtgrdT.Refresh
If dtgrdT.row = -1 And dtgrdT.row = -1 Then
MsgBox " 请添加记录！ ", , ginfo
Exit Sub
End If
If Not (RstF.BOF Or RstF.EOF) Then
RstF.MoveFirst
Do While Not RstF.EOF
RsTool.Filter = "tname='" & RstF!tname & "' and etype='" & RstF!etype & "'"
If Not (RsTool.BOF Or RsTool.EOF) Then
If Label3.Caption = "工具入库" Then
RsTool!estock = RsTool!estock + RstF!amount
Else
RsTool!estock = RsTool!estock - RstF!amount
End If
RsTool.UpdateBatch adAffectCurrent
End If
RstF.MoveNext
Loop
Toolbar1.Buttons(1).Enabled = True
Toolbar1.Buttons(2).Enabled = False
Toolbar1.Buttons(3).Enabled = True
Toolbar1.Buttons(6).Enabled = True
Set dtgrdT.DataSource = Nothing
dtgrdT.Refresh
End If
Case "find"
Re = InputBox("请输入单据号：", "查询信息", , 1000, 1000)
If Re <> "" Then
If Label3.Caption = "工具入库" Then
RstF.Open "select * from toolf where idm =" & Val(Re) & " and ioflg= true", cn, adOpenKeyset, adLockBatchOptimistic
Else
RstF.Open "select * from toolf where idm =" & Val(Re) & " and ioflg= false", cn, adOpenKeyset, adLockBatchOptimistic
End If
txtid = Re
If Not (RstF.BOF Or RstF.EOF) Then
Set dtgrdT.DataSource = RstF
dtgrdT.Refresh
Set RstF = Nothing
Else
MsgBox " 没有找到相应记录！ ", , ginfo
Exit Sub
End If
End If
Toolbar1.Buttons(6).Enabled = True
Case "dele"
Dim cmd As New ADODB.Command
Toolbar1.Buttons(6).Enabled = False
If dtgrdT.row <> -1 Then
Re = MsgBox("您确定要删除表格中的记录吗?", vbYesNo + vbQuestion + vbDefaultButton2, ginfo)
If Re = 6 Then
RstoolD.Find "id=" & dtgrdT.Columns(0).Text
' txtid = dtgrdT.Columns(0).Text
RstoolD.MoveNext
If Not RstoolD.BOF Or Not RstoolD.EOF Then
Set cmd.ActiveConnection = cn
cmd.CommandText = "delete * from tooliodetail where id =" & dtgrdT.Columns(0).Text
cmd.Execute
cmd.ActiveConnection = Nothing
RstoolD.Requery
RstF.Open "select * from toolf where idm=" & txtid, cn, adOpenKeyset, adLockBatchOptimistic
RstF.Requery
Set dtgrdT.DataSource = RstF
dtgrdT.Refresh
End If
End If
End If
Case "exit"
Unload Me
Case "print"
Dim TOOLP As New ADODB.Recordset
If TOOLP.State <> 1 Then
TOOLP.Open "SELECT * from printtool", cn, adOpenKeyset, adLockBatchOptimistic
End If
If txtid <> "" Then
If Me.Label3.Caption = "工具入库" Then
TOOLP.Filter = "idm=" & Val(txtid) & " and ioflg=true"
Else
TOOLP.Filter = "idm=" & Val(txtid) & " and ioflg=false"
End If
TOOLP.Requery
dlg.Orientation = 2
dlg.ShowPrinter
Set toolprint.DataSource = TOOLP
toolprint.Title = "智源 " & Me.Label3.Caption & " 第" + txtid + "号 " + dtcmb.Text & ""
toolprint.Show
Set TOOLP = Nothing
End If
End Select
Exit Sub
gl: MsgBox err.Description
End Sub
Private Sub txtamount_KeyPress(KeyAscii As Integer)
If KeyAscii > 58 Or KeyAscii < 48 And KeyAscii <> 8 And KeyAscii <> 46 And KeyAscii <> 13 Then KeyAscii = 0
End Sub
Private Sub txtPrice_KeyPress(KeyAscii As Integer)
If KeyAscii > 58 Or KeyAscii < 48 And KeyAscii <> 8 And KeyAscii <> 46 And KeyAscii <> 13 Then KeyAscii = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -