📄 frmhwbmquery.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Begin VB.Form frmHwbmQuery
Caption = "货物查询"
ClientHeight = 4950
ClientLeft = 1935
ClientTop = 1380
ClientWidth = 8805
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 4950
ScaleWidth = 8805
Begin VB.CommandButton Command
Caption = "删除(&D)"
Height = 345
Index = 4
Left = 7500
TabIndex = 12
Top = 1440
Width = 1125
End
Begin VB.CommandButton Command
Caption = "修改(&C)"
Height = 345
Index = 3
Left = 7500
TabIndex = 11
Top = 1020
Width = 1125
End
Begin VB.CommandButton Command
Caption = "新增(&A)"
Height = 345
Index = 2
Left = 7500
TabIndex = 10
Top = 600
Width = 1125
End
Begin VB.CommandButton Command
Caption = "退出(&X)"
Height = 345
Index = 1
Left = 7500
TabIndex = 9
Top = 1860
Width = 1125
End
Begin VB.CommandButton Command
Caption = "查询(&R)"
Height = 345
Index = 0
Left = 7500
TabIndex = 7
Top = 180
Width = 1125
End
Begin VB.Frame Frame
Caption = "查询条件"
Height = 1275
Left = 120
TabIndex = 1
Top = 90
Width = 7245
Begin VB.ComboBox Combo
Height = 300
Index = 0
Left = 1110
Style = 2 'Dropdown List
TabIndex = 8
Top = 300
Width = 1725
End
Begin VB.TextBox Text
Height = 330
Index = 1
Left = 4230
TabIndex = 5
Top = 690
Width = 2025
End
Begin VB.TextBox Text
Height = 330
Index = 0
Left = 4230
TabIndex = 3
Top = 270
Width = 2025
End
Begin VB.Label Label
Caption = "货物分类:"
Height = 195
Index = 2
Left = 150
TabIndex = 6
Top = 330
Width = 825
End
Begin VB.Label Label
Caption = "货物名称:"
Height = 195
Index = 1
Left = 3180
TabIndex = 4
Top = 750
Width = 825
End
Begin VB.Label Label
Caption = "货物编码:"
Height = 195
Index = 0
Left = 3180
TabIndex = 2
Top = 330
Width = 825
End
End
Begin MSFlexGridLib.MSFlexGrid Flex
Height = 3405
Left = 150
TabIndex = 0
Top = 1440
Width = 7215
_ExtentX = 12726
_ExtentY = 6006
_Version = 393216
Cols = 6
AllowUserResizing= 3
FormatString = "|<货物分类码|<货物分类名称|<货物编码|<货物名称|>货物单价"
End
End
Attribute VB_Name = "frmHwbmQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Conn As ADODB.Connection
Const CbxHwBmFlCode = 0
Const TxtHwBmCode = 0
Const TxtHwBmMc = 1
Const CmdQuery = 0
Const CmdAdd = 2
Const CmdChg = 3
Const CmdDel = 4
Const CmdExit = 1
Private Sub Command_Click(Index As Integer)
On Error GoTo Errorhandle
Select Case Index
Case CmdQuery
LoadData
Case CmdAdd
frmHwbm.Show vbModal
Case CmdChg
ChgRecord
Case CmdDel
DelRecord
Case CmdExit
Unload Me
End Select
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub ChgRecord()
On Error GoTo Errorhandle
If Flex.Rows > 1 Then
frmHwbm.LetHwbm Trim(Flex.TextMatrix(Flex.Row, 1)), Trim(Flex.TextMatrix(Flex.Row, 3)), Trim(Flex.TextMatrix(Flex.Row, 4)), Val(Flex.TextMatrix(Flex.Row, 5))
frmHwbm.Show vbModal
End If
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub DelRecord()
Dim SqlStr As String
On Error GoTo Errorhandle
If Flex.Rows > 1 Then
Conn.BeginTrans
SqlStr = "DELETE HWBMREC WHERE HWBMCODE='" & Trim(Flex.TextMatrix(Flex.Row, 3)) & "'"
Conn.Execute SqlStr
Conn.CommitTrans
Flex.RemoveItem Flex.Row
End If
Exit Sub
Errorhandle:
Conn.RollbackTrans
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub LoadData()
Dim ItemStr As String
Dim WhereStr As String
Dim SqlStr As String
Dim Rs As ADODB.Recordset
On Error GoTo Errorhandle
Flex.Rows = 1
WhereStr = ""
If Trim(Combo(CbxHwBmFlCode).Text) <> "" Then
WhereStr = WhereStr & " AND HWFLCODE='" & Trim(Left(Combo(CbxHwBmFlCode).Text, InStr(1, Combo(CbxHwBmFlCode).Text, vbTab) - 1)) & "'"
End If
If Trim(Text(TxtHwBmCode).Text) <> "" Then
WhereStr = WhereStr & " AND HWBMCODE LIKE '" & Trim(Text(TxtHwBmCode).Text) & "%'"
End If
If Trim(Text(TxtHwBmMc).Text) <> "" Then
WhereStr = WhereStr & " AND HWBMMC LIKE '%" & Trim(Text(TxtHwBmMc).Text) & "%'"
End If
Set Rs = New ADODB.Recordset
Set Rs.ActiveConnection = Conn
SqlStr = "SELECT HWFLCODE,HWFLMC,HWBMCODE,HWBMMC,HWBMPRICE FROM HWBMREC,HWFLREC WHERE HWFLCODE=HWBMFLCODE "
SqlStr = SqlStr & WhereStr
SqlStr = SqlStr & " ORDER BY HWBMFLCODE,HWBMCODE"
Rs.Open SqlStr
Do While Not Rs.EOF
ItemStr = vbTab & Rs("HWFLCODE") & vbTab & Rs("HWFLMC") & vbTab & Rs("HWBMCODE") & vbTab & Rs("HWBMMC") & vbTab & Rs("HWBMPRICE")
Flex.AddItem ItemStr
Rs.MoveNext
Loop
Rs.Close
Set Rs = Nothing
Exit Sub
Errorhandle:
Set Rs = Nothing
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Form_Load()
On Error GoTo Errorhandle
Flex.Rows = 1
Connection
LoadHwFl
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Connection()
Dim ConnStr As String
On Error GoTo Errorhandle
ConnStr = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Password=;Initial Catalog=fiterp;Data Source=ERP002"
Set Conn = New ADODB.Connection
Conn.ConnectionString = ConnStr
Conn.Open
Conn.CursorLocation = adUseClient
Exit Sub
Errorhandle:
Set Conn = Nothing
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub LoadHwFl()
Dim Rs As ADODB.Recordset
On Error GoTo Errorhandle
Combo(CbxHwBmFlCode).Clear
Combo(CbxHwBmFlCode).AddItem ""
Set Rs = New ADODB.Recordset
Set Rs.ActiveConnection = Conn
Rs.Open "SELECT HWFLCODE,HWFLMC FROM HWFLREC ORDER BY HWFLCODE"
Do While Not Rs.EOF
Combo(CbxHwBmFlCode).AddItem Rs("HWFLCODE") & vbTab & Rs("HWFLMC")
Rs.MoveNext
Loop
Rs.Close
Set Rs = Nothing
Exit Sub
Errorhandle:
Set Rs = Nothing
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Errorhandle
Conn.Close
Set Conn = Nothing
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -