📄 frmvproducts.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{935C9182-411B-4FFB-9512-97C8745743BC}#2.4#0"; "AResize.ocx"
Begin VB.Form FrmVProducts
BackColor = &H00FF8080&
Caption = "View All Products"
ClientHeight = 10620
ClientLeft = 960
ClientTop = 585
ClientWidth = 11805
Icon = "FrmVProducts.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 10620
ScaleWidth = 11805
WindowState = 2 'Maximized
Begin VB.Frame Frame1
BackColor = &H00FF8080&
Caption = "Controls"
BeginProperty Font
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 1335
Left = 3360
TabIndex = 6
Top = 8280
Width = 5775
Begin VB.CommandButton cmdClose
BackColor = &H00FFFFFF&
Caption = "&Close"
Height = 795
Left = 4320
Picture = "FrmVProducts.frx":08CA
Style = 1 'Graphical
TabIndex = 9
Top = 360
Width = 1215
End
Begin VB.CommandButton cmdSearch
BackColor = &H00FFFFFF&
Caption = "&Search"
Height = 795
Left = 600
Picture = "FrmVProducts.frx":0DCE
Style = 1 'Graphical
TabIndex = 8
Top = 360
Width = 1215
End
Begin VB.CommandButton Command1
BackColor = &H00FFFFFF&
Caption = "&Refresh"
Height = 795
Left = 2400
Picture = "FrmVProducts.frx":1251
Style = 1 'Graphical
TabIndex = 7
Top = 360
Width = 1215
End
End
Begin VB.ComboBox cmbSearch
Height = 315
Left = 3600
Style = 2 'Dropdown List
TabIndex = 1
Top = 9960
Width = 2535
End
Begin VB.TextBox txtSearchText
Height = 315
Left = 7680
TabIndex = 0
Top = 9960
Width = 2535
End
Begin MSComctlLib.ListView ListView1
Height = 6855
Left = 840
TabIndex = 2
Top = 1200
Width = 10215
_ExtentX = 18018
_ExtentY = 12091
View = 3
Arrange = 2
Sorted = -1 'True
LabelWrap = -1 'True
HideSelection = 0 'False
AllowReorder = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ColHdrIcons = "ImageList1"
ForeColor = 0
BackColor = -2147483624
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 7
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Product ID"
Object.Width = 4304
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "Product Name"
Object.Width = 4304
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "Category ID"
Object.Width = 6068
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "Supplier ID"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Text = "Unit Stock"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 5
Text = "Units Price"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 6
Text = "Reorder Level"
Object.Width = 2540
EndProperty
End
Begin ActiveResizeCtl.ActiveResize ActiveResize1
Left = 0
Top = 240
_ExtentX = 847
_ExtentY = 847
Resolution = 4
ScreenHeight = 1024
ScreenWidth = 1280
ScreenHeightDT = 1024
ScreenWidthDT = 1280
FormHeightDT = 11130
FormWidthDT = 11925
FormScaleHeightDT= 10620
FormScaleWidthDT= 11805
ResizeFormBackground= -1 'True
ResizePictureBoxContents= -1 'True
End
Begin VB.Label Label6
Alignment = 2 'Center
AutoSize = -1 'True
BackColor = &H00FF8080&
Caption = "VIEW ALL PRODUCTS"
BeginProperty Font
Name = "Verdana"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 435
Left = 3600
TabIndex = 5
Top = 240
Width = 4305
End
Begin VB.Label Label1
BackColor = &H00FF8080&
Caption = "Search For"
BeginProperty Font
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 2280
TabIndex = 4
Top = 9960
Width = 1215
End
Begin VB.Label Label2
BackColor = &H00FF8080&
Caption = "Search Text"
BeginProperty Font
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 6360
TabIndex = 3
Top = 9960
Width = 1215
End
End
Attribute VB_Name = "FrmVProducts"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strCol As Variant
Private Sub cmbSearch_Click()
cmdFind_Click
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdFind_Click()
Dim rsFind As Recordset
Dim strSQl As String
Dim SQL As String
Dim LItem As ListItem
'if there is nothing to search for then exit
If txtSearchText = "" Then
Exit Sub
End If
ListView1.ListItems.clear
Set rsFind = New ADODB.Recordset
SQL = "SELECT * FROM Products"
SQL = SQL & " WHERE ProductID LIKE '*" & txtSearchText & "*'"
'make the search
strSQl = "SELECT * FROM Products WHERE "
strSQl = strSQl & cmbSearch & " Like " & "'%" & txtSearchText & "%'"
'SQL = strSQl & " WHERE language LIKE '*" & Text1.Text & "*'"
'strSQl = strSQl & SQL
Debug.Print strSQl
Debug.Print SQL
'show the found records
rsFind.Open strSQl, cnPatients, adOpenDynamic, adLockPessimistic
Debug.Print rsFind.RecordCount
Debug.Print rsFind.Fields.Count
If Not (rsFind.BOF And rsFind.EOF) Then
While rsFind.EOF = False
Set LItem = ListView1.ListItems.add(, , rsFind(0))
If rsFind(1) <> "" Then
LItem.SubItems(1) = rsFind(1)
End If
If rsFind(2) <> "" Then
LItem.SubItems(2) = rsFind(2)
End If
If rsFind(3) <> "" Then
LItem.SubItems(3) = rsFind(3)
End If
If rsFind(4) <> "" Then
LItem.SubItems(4) = rsFind(4)
End If
If rsFind(5) <> "" Then
LItem.SubItems(5) = rsFind(5)
End If
If rsFind(6) <> "" Then
LItem.SubItems(6) = rsFind(6)
End If
rsFind.MoveNext
Wend
End If
'show number of records found
Me.Caption = CStr(rsFind.RecordCount) & " records found"
'close the recordset
rsFind.Close
End Sub
Private Sub cmdSearch_Click()
Dim LItem As ListItem
FindItem = InputBox("Enter Patient ID", "Find Patient Details")
If Not FindItem = "" Then
Set LItem = ListView1.FindItem(FindItem, lvwText, lvwSubItem)
If LItem Is Nothing Then
NotFound = True
End If
If NotFound Then
MsgBox "Item not found", vbInformation, "Search Result"
Else
LItem.EnsureVisible
LItem.Selected = True
End If
End If
End Sub
Private Sub Command1_Click()
txtSearchText = ""
Form_Load
End Sub
Private Sub Form_Activate()
Me.WindowState = vbMaximized
txtSearchText.SetFocus
End Sub
Private Sub Form_Load()
Dim LItem As ListItem
Dim i As Integer
Dim rsPatientID As Recordset
Set rsPatientID = New ADODB.Recordset
Dim rsPatient As Recordset
Set rsPatient = New ADODB.Recordset
rsPatientID.Open "select * from Medicine_Details", cnPatients, adOpenDynamic, adLockPessimistic
rsPatient.Open "select * from Medicine_Details", cnPatients, adOpenDynamic, adLockPessimistic
For i = 0 To rsPatientID.Fields.Count - 1 Step 1
cmbSearch.AddItem rsPatientID(i).name, i
Next i
rsPatientID.Close
ListView1.ListItems.clear
If Not (rsPatient.BOF And rsPatient.EOF) Then
While rsPatient.EOF = False
Set LItem = ListView1.ListItems.add(, , rsPatient(0))
If rsPatient(1) <> "" Then
LItem.SubItems(1) = rsPatient(1)
End If
If rsPatient(2) <> "" Then
LItem.SubItems(2) = rsPatient(2)
End If
If rsPatient(3) <> "" Then
LItem.SubItems(3) = rsPatient(3)
End If
If rsPatient(4) <> "" Then
LItem.SubItems(4) = rsPatient(4)
End If
If rsPatient(5) <> "" Then
LItem.SubItems(5) = rsPatient(5)
End If
If rsPatient(6) <> "" Then
LItem.SubItems(6) = rsPatient(6)
End If
rsPatient.MoveNext
Wend
End If
rsPatient.Close
cmbSearch.Text = cmbSearch.List(0)
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
If strCol <> ColumnHeader Then
ListView1.SortOrder = lvwAscending
ListView1.SortKey = ColumnHeader.Index - 1
strCol = ColumnHeader
Else
ListView1.SortOrder = lvwDescending
ListView1.SortKey = ColumnHeader.Index - 1
strCol = ""
End If
End Sub
Private Sub txtSearchText_Change()
cmdFind_Click
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -