main_thgl_bhgth.frm
来自「完整的物资管理系统源码」· FRM 代码 · 共 765 行 · 第 1/2 页
FRM
765 行
Enabled = 0 'False
ForeColor = &H80000012&
Height = 270
Left = 1065
Locked = -1 'True
TabIndex = 3
Top = 210
Width = 5370
End
Begin VB.TextBox txt1
Appearance = 0 'Flat
Height = 270
Index = 1
Left = 7305
TabIndex = 2
Top = 525
Width = 3315
End
Begin VB.Label Lbl1
BackStyle = 0 'Transparent
Caption = "经手人"
Height = 315
Index = 3
Left = 6540
TabIndex = 9
Top = 570
Width = 720
End
Begin VB.Label Lbl1
BackStyle = 0 'Transparent
Caption = "收货单位"
Height = 195
Index = 1
Left = 75
TabIndex = 8
Top = 570
Width = 945
End
Begin VB.Label Lbl1
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "退货日期"
Height = 180
Index = 2
Left = 6510
TabIndex = 7
Top = 240
Width = 885
End
Begin VB.Label Lbl1
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "退货单据号"
Height = 180
Index = 0
Left = 75
TabIndex = 6
Top = 270
Width = 990
End
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid flex1
Height = 4110
Left = 0
TabIndex = 0
Top = 900
Width = 10770
_ExtentX = 18997
_ExtentY = 7250
_Version = 393216
BackColorFixed = 15128532
BackColorBkg = 16777215
GridColor = -2147483633
GridLinesUnpopulated= 1
_NumberOfBands = 1
_Band(0).Cols = 2
End
Begin VB.Label lblSum
BackStyle = 0 'Transparent
ForeColor = &H000000FF&
Height = 210
Left = 2655
TabIndex = 14
Top = 5265
Width = 1365
End
Begin VB.Label lblCount
BackStyle = 0 'Transparent
ForeColor = &H000000FF&
Height = 210
Left = 930
TabIndex = 15
Top = 5265
Width = 690
End
Begin VB.Label Lbl1
BackStyle = 0 'Transparent
Caption = "退货数量: 退货金额:"
Height = 225
Index = 4
Left = 75
TabIndex = 16
Top = 5265
Width = 2610
End
Begin VB.Menu edit
Caption = "编辑"
Visible = 0 'False
Begin VB.Menu delone
Caption = "消除当前记录"
End
End
End
Attribute VB_Name = "main_thgl_bhgth"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public rs1 As New ADODB.Recordset, rs2 As New ADODB.Recordset '定义数据集对象
Dim i As Integer, j As Integer
Sub EditKeyCode(MSHFlexGrid As Control, Edt As Control, KeyCode As Integer, Shift As Integer)
'标准编辑控件处理。
Select Case KeyCode
Case 27 'ESC:隐藏焦点并将其返回 MSFlexGrid
Edt.Visible = False
MSHFlexGrid.SetFocus
Case 13 'ENTER 将焦点返回 MSFlexGrid。
MSHFlexGrid.SetFocus
DoEvents
If MSHFlexGrid.Col < MSHFlexGrid.Cols - 1 Then
MSHFlexGrid.Col = MSHFlexGrid.Col + 1
Else
If MSHFlexGrid.Col = MSHFlexGrid.Cols - 1 Then
MSHFlexGrid.Row = MSHFlexGrid.Row + 1
MSHFlexGrid.Col = 1
End If
End If
Case 38 '向上
MSHFlexGrid.SetFocus
DoEvents
If MSFlexGrid.Row > MSFlexGrid.FixedRows Then
MSFlexGrid.Row = MSFlexGrid.Row - 1
End If
End Select
End Sub
Sub view_DP()
If flex1.Col = 6 Or flex1.Col = 7 Or flex1.Col = 8 Then
flex1.TextMatrix(flex1.Row, 7) = Format(flex1.TextMatrix(flex1.Row, 7), "0.00")
flex1.TextMatrix(flex1.Row, 8) = Val(flex1.TextMatrix(flex1.Row, 6)) * Val(flex1.TextMatrix(flex1.Row, 7))
flex1.TextMatrix(flex1.Row, 8) = Format(flex1.TextMatrix(flex1.Row, 8), "0.00")
End If
Dim A, B As Single '声明单精度浮点型变量
On Error Resume Next
For i = 1 To flex1.Rows - 1
If flex1.TextMatrix(i, 1) <> "" And flex1.TextMatrix(i, 6) <> "" And flex1.TextMatrix(i, 7) <> "" Then
A = Val(flex1.TextMatrix(i, 8)) + A '求合计金额
B = Val(flex1.TextMatrix(i, 6)) + B '求合计数量
End If
Next i
lblCount = B
lblSum = Format(A, "0.00") '格式化合计金额
End Sub
Sub SetButtons(bVal As Boolean)
cmdRegister.Enabled = Not bVal
cmdSave.Enabled = bVal
cmdCancel.Enabled = bVal
flex1.Enabled = bVal
Frame1.Enabled = bVal
End Sub
Private Sub DataGrid3_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
txt1(1) = Adodc3.Recordset.Fields("经手人姓名")
flex1.Col = 1
flex1.Row = 1
flex1.SetFocus
DataGrid3.Visible = False
End If
End Sub
Private Sub delone_Click()
For i = 1 To flex1.Cols - 1
flex1.TextMatrix(flex1.Row, i) = ""
Next i
view_DP
End Sub
Private Sub flex1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'利用PopupMenu方法
If Button And vbRightButton Then
PopupMenu Edit '弹出菜单
End If
End Sub
Private Sub Form_Load()
Me.Caption = text
Dim i As Integer
'使第一列较窄。
flex1.ColWidth(0) = flex1.ColWidth(0) / 2
'初始化编辑框
txtEdit = ""
flex1.Rows = 101
flex1.Cols = 10
'设置列标头。
s$ = "^|^物资名称 |^物资编号|^规格型号元 |^计量单位|^材质 |^数量 |^单价 |^金额 |^备注 "
flex1.FormatString = s$
End Sub
Private Sub flex1_KeyPress(KeyAscii As Integer)
MSHFlexGridEdit flex1, txtEdit, KeyAscii
End Sub
'添加下列例程以初始化文本框，并将焦点从 Hierarchical FlexGrid 传递到 TextBox 控件：
Sub MSHFlexGridEdit(MSHFlexGrid As Control, Edt As Control, KeyAscii As Integer)
'使用已输入的字符。
Select Case KeyAscii
'空格表示编辑当前的文本。
Case 0 To 32
Edt = MSHFlexGrid
Edt.SelStart = 1000
'其它所有字符表示取代当前的文本。
Case Else
Edt = Chr(KeyAscii)
Edt.SelStart = 1
End Select
'在合适的位置显示 Edt。
Edt.Move MSHFlexGrid.Left + MSHFlexGrid.CellLeft - 15, _
MSHFlexGrid.Top + MSHFlexGrid.CellTop - 15, _
MSHFlexGrid.CellWidth, _
MSHFlexGrid.CellHeight
Edt.Visible = True
'启动工作。
Edt.SetFocus
End Sub
Private Sub flex1_DblClick()
MSHFlexGridEdit flex1, txtEdit, 32 '模拟一个空格。
End Sub
Private Sub txt1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn And Index = 0 Then
Adodc1.RecordSource = "tb_gys where 供应商编号 like +'%'+'" + txt1(0) + "'+'%'or 供应商全称 like +'%'+'" + txt1(0) + "'+'%'or 简称 like +'%'+'" + txt1(0) + "'+'%'"
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then
DataGrid1.Visible = True
DataGrid1.SetFocus
Else
Adodc1.RecordSource = "tb_gys"
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then
DataGrid1.Visible = True
DataGrid1.SetFocus
Else
MsgBox "无可选的供应商信息，请首先录入供应商数据！", , "提示窗口"
End If
End If
End If
If KeyCode = vbKeyReturn And Index = 1 Then
Adodc3.RecordSource = "tb_jsr where 经手人编号 like +'%'+'" + txt1(1) + "'+'%'or 经手人姓名 like +'%'+'" + txt1(1) + "'+'%'"
Adodc3.Refresh
If Adodc3.Recordset.RecordCount > 0 Then
DataGrid3.Visible = True
DataGrid3.SetFocus
Else
Adodc3.RecordSource = "tb_jsr"
Adodc3.Refresh
If Adodc3.Recordset.RecordCount > 0 Then
DataGrid3.Visible = True
DataGrid3.SetFocus
Else
MsgBox "无可选的经手人信息，请首先录入经手人数据！", , "提示窗口"
End If
End If
End If
End Sub
Private Sub DataGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
txt1(0) = Adodc1.Recordset.Fields("供应商全称")
txt1(1).SetFocus
DataGrid1.Visible = False
End If
End Sub
Private Sub txtEdit_KeyPress(KeyAscii As Integer)
'删除回车符，以消除嘟嘟声。
If KeyAscii = Asc(vbCr) Then KeyAscii = 0
End Sub
Private Sub txtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
EditKeyCode flex1, txtEdit, KeyCode, Shift
End Sub
'当输入数据并按下 ENTER 键，或用鼠标单击MSHFlexGrid 控件中的另一个单元时，
'焦点将返回此控件。这时 TextBox 中的文本被复制到活动单元中
Private Sub flex1_GotFocus()
If txtEdit.Visible = False Then Exit Sub
flex1 = txtEdit
txtEdit.Visible = False
view_DP
End Sub
Private Sub flex1_LeaveCell()
If txtEdit.Visible = False Then Exit Sub
flex1 = txtEdit
txtEdit.Visible = False
End Sub
Private Sub cmdCancel_Click()
For i = 1 To flex1.Rows - 1
For j = 1 To flex1.Cols - 1
flex1.TextMatrix(i, j) = ""
Next j
Next i
SetButtons False
txtEdit.Visible = False
view_DP
End Sub
Private Sub cmdRegister_Click()
Dim lsph As Integer '声明一个整型变量
'创建入库票号
rs1.Open "select * from tb_rk order by 进货票号", cnn, adOpenStatic
If rs1.RecordCount > 0 Then
If Not rs1.EOF Then rs1.MoveLast
If rs1.Fields("进货票号") <> "" Then
lsph = Val(Right(Trim(rs1.Fields("进货票号")), 4)) + 1
txtph.text = Date & "th" & Format(lsph, "0000")
End If
Else
txtph.text = Date & "th" & "0001"
End If
rs1.Close
txtDate.text = Date
'设置控件有效或无效
SetButtons True
For i = 1 To flex1.Rows - 1
For j = 1 To flex1.Cols - 1
flex1.TextMatrix(i, j) = ""
Next j
Next i
txt1(0) = ""
txt1(1) = ""
txt1(0).SetFocus
view_DP
End Sub
Private Sub cmdSave_Click()
Dim js As Integer
For i = 1 To flex1.Rows - 1
If flex1.TextMatrix(i, 1) <> "" And flex1.TextMatrix(i, 2) <> "" And flex1.TextMatrix(i, 3) = "" Then
MsgBox "第" & i & "行录入错误！", , "提示窗口"
Exit Sub
End If
If flex1.TextMatrix(i, 1) = "" Then
js = js + 1
End If
Next i
If js = flex1.Rows - 1 Then
MsgBox "没有要保存的数据！", , "提示窗口"
Exit Sub
End If
rs1.Open "select * from tb_rkth", cnn, adOpenKeyset, adLockOptimistic
For i = 1 To flex1.Rows - 1
If flex1.TextMatrix(i, 1) <> "" And flex1.TextMatrix(i, 2) <> "" And flex1.TextMatrix(i, 3) <> "" Then
'添加新记录到"tb_rk"中
rs1.AddNew
If flex1.TextMatrix(i, 1) <> "" Then rs1.Fields("物资名称") = flex1.TextMatrix(i, 1)
If flex1.TextMatrix(i, 2) <> "" Then rs1.Fields("物资编号") = flex1.TextMatrix(i, 2)
If flex1.TextMatrix(i, 3) <> "" Then rs1.Fields("规格型号") = flex1.TextMatrix(i, 3)
If flex1.TextMatrix(i, 4) <> "" Then rs1.Fields("计量单位") = flex1.TextMatrix(i, 4)
If flex1.TextMatrix(i, 5) <> "" Then rs1.Fields("材质") = flex1.TextMatrix(i, 5)
rs1.Fields("数量") = Val(flex1.TextMatrix(i, 6))
rs1.Fields("单价") = Val(flex1.TextMatrix(i, 7))
rs1.Fields("金额") = Val(flex1.TextMatrix(i, 8))
If flex1.TextMatrix(i, 9) <> "" Then rs1.Fields("备注") = flex1.TextMatrix(i, 9)
If txt1(0).text <> "" Then rs1.Fields("收货单位") = txt1(0)
If txt1(1).text <> "" Then rs1.Fields("经手人") = txt1(1)
rs1.Fields("退货票号") = Trim(txtph.text)
rs1.Fields("退货日期") = txtDate
rs1.Fields("检验和试验结果") = "不合格"
rs1.Update
End If
Next i
rs1.Close
'设置控件有效或无效
SetButtons False
End Sub
Private Sub cmdQuit_Click()
Unload Me
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?