📄 cpselect.frm
字号:
VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form cpselect
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "请选择产品"
ClientHeight = 5265
ClientLeft = 45
ClientTop = 330
ClientWidth = 6555
Icon = "cpselect.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5265
ScaleWidth = 6555
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.TextBox Numtext
Height = 270
Left = -435
TabIndex = 9
Top = 135
Visible = 0 'False
Width = 420
End
Begin VB.TextBox FindstrX
Height = 300
Left = 2295
MaxLength = 30
TabIndex = 0
Top = 300
Width = 2490
End
Begin VB.Frame Frame1
Caption = " 使用说明"
Height = 2325
Left = 5070
TabIndex = 6
Top = 1425
Width = 1200
Begin VB.Label Label2
Caption = "选产品： 在品名处双击。 清除所选： 在品名处按Shift 键,再单击。"
Height = 1815
Left = 180
TabIndex = 7
Top = 450
Width = 960
WordWrap = -1 'True
End
End
Begin VB.CommandButton closeform
Caption = "放弃"
Height = 375
Left = 5175
TabIndex = 3
Top = 4410
Width = 1095
End
Begin VB.CommandButton sure
Caption = "确认"
Default = -1 'True
Height = 375
Left = 5175
TabIndex = 2
Top = 3945
Width = 1095
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 345
Left = 7320
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 1635
Visible = 0 'False
Width = 1770
End
Begin MSDBGrid.DBGrid DBGrid1
Bindings = "cpselect.frx":0442
Height = 4005
Left = 300
OleObjectBlob = "cpselect.frx":0452
TabIndex = 1
Top = 840
Width = 4530
End
Begin VB.Line Line2
BorderColor = &H000000FF&
X1 = 4635
X2 = 5100
Y1 = 1635
Y2 = 750
End
Begin VB.Label Label3
AutoSize = -1 'True
BackColor = &H00808000&
BackStyle = 0 'Transparent
Caption = "请输入产品名称查询："
ForeColor = &H00FF0000&
Height = 180
Left = 435
TabIndex = 8
Top = 360
Width = 1800
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "没选定为：0"
ForeColor = &H0080FFFF&
Height = 180
Index = 1
Left = 5160
TabIndex = 5
Top = 825
Width = 990
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "选定为 ：-1"
ForeColor = &H0080FFFF&
Height = 180
Index = 0
Left = 5160
TabIndex = 4
Top = 585
Width = 990
End
Begin VB.Shape Shape1
BorderColor = &H00FFFF80&
FillColor = &H00000080&
FillStyle = 0 'Solid
Height = 645
Left = 5085
Top = 465
Width = 1200
End
Begin VB.Line Line1
BorderColor = &H000000FF&
X1 = 4635
X2 = 5085
Y1 = 1455
Y2 = 990
End
End
Attribute VB_Name = "cpselect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub closeform_Click()
Unload Me
End Sub
Private Sub DBGrid1_DblClick()
Dim db As Database, Str As String, Bt As String, Book As String
Book = DBGrid1.Text
'设定所选的标志
If DBGrid1.Col = 0 Then
Bt = DBGrid1.Text
'********************
'加入选定数量
cpselect.MousePointer = 11
Load NumForm
cpselect.MousePointer = 0
NumForm.Show 1
If Val(Numtext.Text) <= 0 Then
'没有数量时退出
Exit Sub
End If
'***************************
'继续执行
Set db = OpenDatabase(appData)
Str = "update cpk set 选定=(-1),数量=" & Val(Numtext.Text)
Str = Str + " where 品名=" + "'" + Bt + "'"
db.Execute Str
db.Close
End If
Data1.Refresh
If DBGrid1.Col = 0 Then
Book = "品名='" & Book & "'"
End If
If Trim(FindstrX.Text) <> "" Then
RecordStr = "select 品名,单价,数量,选定 from cpk where "
RecordStr = RecordStr & "品名 Like '" & Trim(FindstrX.Text) & "*'"
Data1.RecordSource = RecordStr
Data1.Refresh
End If
'复位
Data1.Recordset.FindFirst Book
End Sub
Private Sub DBGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim db2 As Database, Str2 As String, Bt2 As String, Book2 As String
Book2 = DBGrid1.Text
'放弃选定
If Button = 1 And Shift = 1 And DBGrid1.Col = 0 Then
Bt2 = DBGrid1.Text
Set db2 = OpenDatabase(appData)
Str2 = "update cpk set 选定=(0),数量=0"
Str2 = Str2 + " where 品名=" + "'" + Bt2 + "'"
db2.Execute Str2
db2.Close
Data1.Refresh
End If
Book2 = "品名='" & Book2 & "'"
If Trim(FindstrX.Text) <> "" Then
RecordStr = "select 品名,单价,数量,选定 from cpk where "
RecordStr = RecordStr & "品名 Like '" & Trim(FindstrX.Text) & "*'"
Data1.RecordSource = RecordStr
Data1.Refresh
End If
'恢复选定
Data1.Recordset.FindFirst Book2
End Sub
Private Sub FindstrX_Change()
RecordStr = "select 品名,单价,数量,选定 from cpk where "
RecordStr = RecordStr & "品名 Like '" & Trim(FindstrX.Text) & "*'"
Data1.RecordSource = RecordStr
Data1.Refresh
End Sub
Private Sub Form_Load()
'声明数据库路径
Data1.DatabaseName = appData
Data1.RecordSource = "cpk"
'清除所选的标记
'初始化数量为0
Dim db As Database, ef As Recordset, Str As String, Bt As String
Set db = OpenDatabase(appData)
Set ef = db.OpenRecordset("cpk", dbOpenDynaset)
Str = "update cpk set 选定=(0),数量=0"
db.Execute Str
db.Close
Data1.Refresh
Numtext.Text = ""
End Sub
Private Sub Sure_Click()
On Error GoTo inserterr
'添加至临时库
Dim db As Database, ef As Recordset, Jh As Recordset, Str As String
Set db = OpenDatabase(appData)
Str = "insert into tempk select 品名,单价,数量 from cpk where 选定=(-1)"
db.Execute Str
db.Close
main.Temp.Refresh
'卸载
Unload Me
Exit Sub
inserterr:
MsgBox "操作失误，放弃选择！", vbOKOnly + 32, "操作错误"
Exit Sub
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -