📄 frmcustomer.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{FDAC2480-F4ED-4632-AA78-DCA210A74E49}#6.0#0"; "SPR32X60.ocx"
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "Actbar2.ocx"
Begin VB.Form frmCustomer
BackColor = &H00C0C0C0&
Caption = "进货列表"
ClientHeight = 6195
ClientLeft = 60
ClientTop = 345
ClientWidth = 8295
Icon = "frmCustomer.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 6195
ScaleWidth = 8295
WindowState = 2 'Maximized
Begin ActiveBar2LibraryCtl.ActiveBar2 Abar
Align = 1 'Align Top
Height = 6195
Left = 0
TabIndex = 0
Top = 0
Width = 8295
_LayoutVersion = 1
_ExtentX = 14631
_ExtentY = 10927
_DataPath = ""
Bands = "frmCustomer.frx":08CA
Begin VB.PictureBox Pic
Height = 6255
Left = 30
ScaleHeight = 6195
ScaleWidth = 8805
TabIndex = 1
Top = 210
Width = 8865
Begin VB.Frame Frame2
Caption = "Frame2"
Height = 5145
Left = 4320
TabIndex = 3
Top = 300
Width = 3555
Begin VB.VScrollBar VSsl
Height = 375
LargeChange = 10
Left = 1530
Max = 1
Min = 20
TabIndex = 9
Top = 2280
Value = 4
Width = 285
End
Begin VB.TextBox Tsl
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Enabled = 0 'False
ForeColor = &H00000000&
Height = 345
Left = 1050
TabIndex = 8
Text = "1"
Top = 2310
Width = 495
End
Begin VB.ComboBox Combo2
Height = 300
Left = 1140
TabIndex = 7
Text = "Combo2"
Top = 960
Width = 1455
End
Begin VB.ComboBox Combo1
Height = 300
Left = 1140
TabIndex = 6
Text = "Combo1"
Top = 510
Width = 1455
End
Begin VB.TextBox txtDJ
BackColor = &H00FFFFFF&
ForeColor = &H000000FF&
Height = 300
Left = 1065
MaxLength = 8
TabIndex = 5
ToolTipText = "禁止修改"
Top = 1830
Width = 1365
End
Begin VB.TextBox txtDW
BackColor = &H00E0E0E0&
ForeColor = &H000000FF&
Height = 300
Left = 1080
Locked = -1 'True
TabIndex = 4
TabStop = 0 'False
ToolTipText = "禁止修改"
Top = 1425
Width = 1290
End
Begin MSComCtl2.DTPicker tpDate
Height = 300
Left = 1020
TabIndex = 10
Top = 2760
Width = 1290
_ExtentX = 2275
_ExtentY = 529
_Version = 393216
Format = 53411841
CurrentDate = 36847
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "物品名称:"
Height = 180
Index = 0
Left = 300
TabIndex = 16
Top = 1020
Width = 810
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "所购数量:"
Height = 180
Left = 150
TabIndex = 15
Top = 2400
Width = 810
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "单价(元):"
Height = 180
Left = 180
TabIndex = 14
Top = 1920
Width = 810
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "物品分类:"
ForeColor = &H000000FF&
Height = 180
Left = 330
TabIndex = 13
Top = 555
Width = 810
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "单位:"
Height = 180
Index = 1
Left = 555
TabIndex = 12
Top = 1470
Width = 450
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "日期:"
Height = 180
Index = 2
Left = 495
TabIndex = 11
Top = 2850
Width = 450
End
End
Begin VB.Data siteData
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 420
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 6540
Width = 1140
End
Begin FPSpread.vaSpread vaSpread1
Bindings = "frmCustomer.frx":0B2A
Height = 5055
Left = 180
TabIndex = 2
Top = 390
Width = 4005
_Version = 393216
_ExtentX = 7064
_ExtentY = 8916
_StockProps = 64
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
SpreadDesigner = "frmCustomer.frx":0B41
End
End
End
End
Attribute VB_Name = "frmCustomer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sDJ As String, sDW As String
Private Sub cmbPM_Change()
If txtCatalog.Text = "" Or cmbPM.Text = "" Or Val(txtDJ.Text) = 0 Or Val(txtSl.Text) = 0 Then
cmdAdd.Enabled = False
Else
cmdAdd.Enabled = True
End If
'查询到名称时
txtDJ = GetDJ(cmbPM, txtCatalog)
sDJ = txtDJ
txtDW = sDW '给出单位
End Sub
Private Sub cmbPM_GotFocus()
SetItFocus cmbPM
'刷新数据
ConfigPM (txtCatalog.Text)
End Sub
Private Sub cmbPM_KeyDown(KeyCode As Integer, Shift As Integer)
DirectFocus txtCatalog, txtDJ, txtCatalog, txtDJ, KeyCode
End Sub
Private Sub cmbPM_KeyPress(KeyAscii As Integer)
'On Error GoTo Err_dj
If KeyAscii = 13 And Trim(cmbPM) <> "" Then
KeyAscii = 0
txtDJ.SetFocus
ElseIf KeyAscii = 13 And Trim(cmbPM) = "" Then
SSCommand1.Value = True
Else
Exit Sub
End If
Exit Sub
Err_dj:
MsgBox "给出品名错误! " & vbCrLf & vbCrLf & err.Description, vbCritical
End Sub
Private Sub cmbPM_LostFocus()
'查询到名称时
If Val(txtDJ) = 0 Then '名称查找
cmbPM = GetPm(cmbPM) '代码查找
txtDJ = GetDJ(cmbPM, txtCatalog)
sDJ = txtDJ
txtDW = sDW '给出单位
End If
End Sub
Private Sub cmdAdd_Click()
'On Error GoTo Err_Add
If cmbPM = "" Then
txtDW = ""
txtDJ = ""
cmbPM.SetFocus
Exit Sub ' 名称为空时退出
End If
If Val(txtSl) > 0 And Val(txtDJ) > 0 Then '有值时
'先检查临时库是否已经存在该物品
Dim sReturn As String
sReturn = CheckProduct("tmpEnterList", "代码", GetCode(cmbPM), 2)
If sReturn = "" Then
' 添加记录
AddRecord txtCatalog.Text, "MenuType", GetCode(cmbPM), "代码", cmbPM.Text, "名称", Val(txtDJ), "单价", txtDW.Text, "单位", Val(txtSl), "数量", Val(txtDJ) * Val(txtSl), "金额", Date, "日期", "tmpEnterList"
Else
'合并记录
UpDateIt sReturn, Val(txtSl.Text), Val(txtSl.Text) * Val(txtDJ.Text)
End If
' 刷新
ConfigGrid
' 返回
cmbPM = ""
txtDW = ""
txtDJ = ""
cmbPM.SetFocus
End If
Exit Sub
Err_Add:
MsgBox "添加记录或配置网格错误! " & vbCrLf & vbCrLf & err.Description, vbCritical
End Sub
Private Sub cmdCancel_Click()
If Grid1.Text <> "" Then
Dim sTmp As Integer
sTmp = MsgBox("对不起，您已经添加物品了，是否入库。 " & vbCrLf & vbCrLf & " 如果不入库将不保存刚才所输入的内容，按(N)；否则保存，按(Y)？ ", vbInformation + vbYesNoCancel, "提示：By Yusilong")
Select Case sTmp
Case vbYes
cmdPast.Value = True '保存
Unload Me
Case vbNo
'删除临时文件
DeleteRecord "tmpEnterList"
Unload Me
Case vbCancel
Exit Sub
End Select
Else
Unload Me
End If
End Sub
Private Sub ConfigGrid()
'On Error GoTo Err_grid
sJE = 0
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 8
Grid1.FormatString = "^ .. |^ 物品类别 |^ 物品名称 |^ 单价 |^ 单位 |^ 数量 |^ 金额 |^ 日期 "
Grid1.ColWidth(0) = 800
Grid1.ColWidth(1) = 2000
Grid1.ColWidth(2) = 3000
Grid1.ColWidth(3) = 1200
Grid1.ColWidth(4) = 1200
Grid1.ColWidth(5) = 1200
Grid1.ColWidth(6) = 1200
Grid1.ColWidth(7) = 1150
Dim GridColor As Long
Dim DB As Database, EF As Recordset, HH As Integer, DelNO As Long
Dim shiftStr As String, shiftStrL As String, shiftStrR As String, shiftNum As Integer, ili As Integer, tempStr As String, SureStr As String, Qy As Integer
Set DB = OpenDatabase(ConData, False, False, Constr)
Set EF = DB.OpenRecordset("tmpEnterList", dbOpenTable)
DelNO = EF.RecordCount
Grid1.Rows = EF.RecordCount + 2
Set EF = DB.OpenRecordset("Select * From tmpEnterList", dbOpenDynaset)
HH = 1
Do While Not EF.EOF()
Grid1.Row = HH
Grid1.Col = 0
Grid1.CellAlignment = 4
Grid1.CellForeColor = GridColor
If Not IsNull(EF.Fields(0).Value) Then
Grid1.Text = EF.Fields(0).Value
End If
Grid1.Row = HH
Grid1.Col = 1
Grid1.CellAlignment = 1
Grid1.CellForeColor = GridColor
If Not IsNull(EF.Fields(1).Value) Then
Grid1.Text = EF.Fields(1).Value
End If
Grid1.Row = HH
Grid1.Col = 2
Grid1.CellAlignment = 1
Grid1.CellForeColor = GridColor
If Not IsNull(EF.Fields(3).Value) Then
Grid1.Text = EF.Fields(3).Value
End If
Grid1.Row = HH
Grid1.Col = 3
Grid1.CellAlignment = 1
Grid1.CellForeColor = GridColor
If Not IsNull(EF.Fields(4).Value) Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -