📄 frmbuyorder.frm
字号:
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmBuyOrder.frx":1D98
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 555
Left = 0
TabIndex = 29
Top = 0
Width = 9210
_ExtentX = 16245
_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}
Enabled = 0 'False
Caption = "保 存"
Key = "save"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.Visible = 0 'False
Caption = "删 除"
Key = "dele"
ImageIndex = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.Visible = 0 'False
Caption = "查 找"
Key = "find"
ImageIndex = 4
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "打 印"
Key = "print"
ImageIndex = 5
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
End
End
Attribute VB_Name = "Frmbuy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Addi As Integer
Dim RsbuydTmp As New ADODB.Recordset
Dim Rsbuyd As New ADODB.Recordset
Dim RsBuyInfo As New ADODB.Recordset
Dim RsbuyDt As New ADODB.Recordset
Private Sub Command1_Click()
frmcompany.InsertType = "Frmbuy"
frmcompany.CmdInsert.Visible = True
frmcompany.Show 1
End Sub
Private Sub Command2_Click()
If txtCustomId <> "" Then
frmelement.InsertType = "Frmbuy"
frmelement.Show 1
Else
MsgBox " 请先选择客户名称！ ", vbQuestion, ginfo
Exit Sub
End If
End Sub
Private Sub Command3_Click()
RsbuydTmp.Filter = " ename='" & Trim(dtgrd.Columns(0).Text) & "' And etype = '" & Trim(dtgrd.Columns(1).Text) & "'"
Toolbar1.Buttons(6).Enabled = False
If dtgrd.row <> -1 Then
Re = MsgBox("您确定要删除表格中的记录吗?", vbYesNo + vbQuestion + vbDefaultButton2, ginfo)
If Re = 6 Then
RsbuydTmp.Delete adAffectCurrent
RsbuydTmp.UpdateBatch adAffectCurrent
RsbuydTmp.Requery
End If
End If
Ado.RecordSource = "select * from grdbuy"
Ado.CursorLocation = adUseClient
Ado.Refresh
Set dtgrd.DataSource = Ado
dtgrd.Refresh
RsbuydTmp.Filter = ""
RsbuydTmp.Requery
End Sub
Private Sub Command4_Click()
RsbuydTmp.Filter = " idstock=" & Val(lblprod) & " And buyid = " & Val(txtid)
If RsbuydTmp.EOF Or RsbuydTmp.BOF Then
RsbuydTmp.AddNew
RsbuydTmp.Fields!idstock = Val(lblprod)
RsbuydTmp.Fields!buyid = Val(txtid)
RsbuydTmp.Fields!price = Val(txtPrice)
RsbuydTmp.Fields!buyamount = Val(txtamount)
RsbuydTmp.Fields!ename = Trim(txtProd)
RsbuydTmp.Fields!etype = Trim(txttype)
RsbuydTmp.Fields!eunit = txtunit
RsbuydTmp.Fields!buymoney = RsbuydTmp.Fields!buyamount * RsbuydTmp.Fields!price
RsbuydTmp.UpdateBatch adAffectCurrent
RsbuydTmp.Filter = ""
RsbuydTmp.Requery
txtProd = ""
txttype = ""
txtPrice = ""
txtamount = ""
txtcompname = ""
txtunit = ""
Ado.RecordSource = "select * from grdbuy where buyid = " & Val(txtid)
Ado.Refresh
Set dtgrd.DataSource = Ado
Else
MsgBox " 选择元件重复，请检查！ ", vbQuestion, ginfo
Exit Sub
End If
End Sub
Private Sub Form_Load()
Ado.ConnectionString = cn
RsBuyInfo.Open "select * from buyinfo", cn, adOpenKeyset, adLockBatchOptimistic
RsbuydTmp.Open "select * from grdbuy ", cn, adOpenStatic, adLockBatchOptimistic
RsbuyDt.Open "select * from buydetail", cn, adOpenStatic, adLockBatchOptimistic
End Sub
Private Sub MSFgd_Compare(ByVal Row1 As Long, ByVal Row2 As Long, Cmp As Integer)
Addi = Row1
MSFgd.BackColorSel = &HE0E0E0
End Sub
Private Sub MSFgd_GotFocus()
Addi = MSFgd.row
MSFgd.BackColorSel = &HE0E0E0
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim Str As String
If Toolbar1.Buttons(2).Enabled = True Then
Str = MsgBox("你修改或添加的数据将不会被保存,你确定要退出吗？", vbYesNo, "提示信息")
If Str = vbYes Then
Unload Me
RsbuyDt.Filter = "buyid = " & Val(txtid)
RsbuyDt.Requery
Do Until RsbuyDt.EOF
RsbuyDt.Delete adAffectCurrent
RsbuyDt.MoveNext
RsbuyDt.UpdateBatch adAffectCurrent
Loop
Do Until RsbuydTmp.EOF
RsbuydTmp.Delete adAffectCurrent
RsbuydTmp.UpdateBatch adAffectCurrent
RsbuydTmp.MoveNext
Loop
'RsBuyInfo.Delete adAffectCurrent
'RsBuyInfo.UpdateBatch adAffectCurrent
'RsBuyInfo.MoveNext
Else
Cancel = 1
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
RsBuyInfo.Close
Set RsBuyInfo = Nothing
RsbuydTmp.Close
Set Rsbuyd = Nothing
RsbuyDt.Close
Set RsbuyDt = Nothing
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim Grdbuy1 As New ADODB.Recordset
Select Case Trim(Button.Key)
Case "new"
On Error GoTo newerr
frmio.Enabled = True
Frameorder.Enabled = True
Toolbar1.Buttons(1).Enabled = False
Toolbar1.Buttons(2).Enabled = True
Toolbar1.Buttons(3).Enabled = False
RsBuyInfo.AddNew
Ioadd = RsBuyInfo.RecordCount
RsBuyInfo!ID = Ioadd + 1
txtid = RsBuyInfo!ID
Exit Sub
newerr: MsgBox err.Description
Case "save"
dtgrd.Refresh
If dtgrd.row = -1 Then
MsgBox " 没有定货数据，请添加记录！ ", , ginfo
Exit Sub
End If
RsBuyInfo!buydate = dtpbuydate
RsBuyInfo!PayDate = dtppaydate
RsBuyInfo!buyman = txtBuyman
If txtCustomId <> "" Then
RsBuyInfo!Compid = txtCustomId
End If
RsBuyInfo.UpdateBatch adAffectCurrent
' RsbuyDt.Filter = " idstock=" & Val(lblprod) & " And buyid = " & Val(txtid)
' If RsbuyDt.EOF Or RsbuyDt.BOF Then
RsbuydTmp.MoveFirst
Do While Not RsbuydTmp.EOF
RsbuyDt.AddNew
RsbuyDt.Fields!idstock = RsbuydTmp.Fields!idstock
RsbuyDt.Fields!buyid = RsbuydTmp.Fields!buyid
RsbuyDt.Fields!price = RsbuydTmp.Fields!price
RsbuyDt.Fields!buyamount = RsbuydTmp.Fields!buyamount
RsbuyDt.Fields!buymoney = RsbuydTmp.Fields!buymoney
RsbuyDt.UpdateBatch adAffectCurrent
RsbuyDt.MoveNext
RsbuydTmp.MoveNext
Loop
RsbuydTmp.MoveFirst
Do While Not RsbuydTmp.EOF
RsbuydTmp.Delete adAffectCurrent
RsbuydTmp.UpdateBatch adAffectCurrent
RsbuydTmp.MoveNext
Loop
' End If
RsbuydTmp.Requery
If Trim(txtid) <> "" Then
txtPrice = ""
txtcompname = ""
txtamount = ""
txtProd = ""
'txtid = ""
txtCustomId = ""
txtCustomName = ""
txtBuyman = ""
End If
Ado.Refresh
Set dtgrd.DataSource = Ado
Toolbar1.Buttons(1).Enabled = True
Toolbar1.Buttons(2).Enabled = False
Toolbar1.Buttons(3).Enabled = True
Case "find"
Re = InputBox("请输定货日期：", "查找信息", Default, 2500, 2500)
If Re <> "" Then
Grdbuy1.Open "SELECT * from grdbuy1 where buydate=# " & Re & " # ", cn, adOpenKeyset, adLockBatchOptimistic
txtid = Grdbuy1.Fields!ID
dtpbuydate.Value = Grdbuy1.Fields!buydate
Else
End If
Case "print"
If Grdbuy1.State <> 1 Then
Grdbuy1.Open "SELECT * from grdbuy1 ", cn, adOpenKeyset, adLockBatchOptimistic
End If
If txtid <> "" Then
Grdbuy1.Filter = "id=" & Val(txtid)
Grdbuy1.Requery
dlg.Orientation = 2
dlg.ShowPrinter
Set Buyprint.DataSource = Grdbuy1
Buyprint.Title = "智源 " & Me.Caption & " 第 " + txtid + " 号 "
Buyprint.Show 1
Grdbuy1.Close
Set Grdbuy1 = Nothing
End If
Case "exit"
Unload Me
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -