📄 parameterquery.frm
字号:
VERSION 5.00
Begin VB.Form frmMain
BackColor = &H00C0C0C0&
Caption = "Chapter 5.7 Example"
ClientHeight = 2685
ClientLeft = 1080
ClientTop = 1515
ClientWidth = 6300
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
PaletteMode = 1 'UseZOrder
ScaleHeight = 2685
ScaleWidth = 6300
Begin VB.Data dtaData
Caption = "Publisher's Titles By Author"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 1020
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 1680
Width = 5205
End
Begin VB.CommandButton cmdPublisher
Caption = "&Publisher"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 3840
TabIndex = 11
Top = 2160
Width = 1095
End
Begin VB.CommandButton cmdClose
Cancel = -1 'True
Caption = "&Close"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 5070
TabIndex = 10
Top = 2160
Width = 1155
End
Begin VB.TextBox txtPublisher
DataField = "Name"
DataSource = "dtaData"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 2340
TabIndex = 9
Top = 1290
Width = 3855
End
Begin VB.TextBox txtYearPublished
DataField = "Year Published"
DataSource = "dtaData"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1020
TabIndex = 8
Top = 1290
Width = 735
End
Begin VB.TextBox txtISBN
DataField = "ISBN"
DataSource = "dtaData"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1020
TabIndex = 5
Top = 900
Width = 2295
End
Begin VB.TextBox txtTitle
DataField = "Title"
DataSource = "dtaData"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1020
TabIndex = 3
Top = 510
Width = 5175
End
Begin VB.TextBox txtAuthor
DataField = "Author"
DataSource = "dtaData"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1020
TabIndex = 1
Top = 120
Width = 2595
End
Begin VB.Label lblQuery
AutoSize = -1 'True
BackColor = &H00C0C0C0&
Caption = "by:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 4
Left = 1950
TabIndex = 7
Top = 1350
Width = 210
End
Begin VB.Label lblQuery
AutoSize = -1 'True
BackColor = &H00C0C0C0&
Caption = "Published:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 3
Left = 120
TabIndex = 6
Top = 1350
Width = 735
End
Begin VB.Label lblQuery
AutoSize = -1 'True
BackColor = &H00C0C0C0&
Caption = "ISBN:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 2
Left = 120
TabIndex = 4
Top = 960
Width = 420
End
Begin VB.Label lblQuery
AutoSize = -1 'True
BackColor = &H00C0C0C0&
Caption = "Title:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 1
Left = 120
TabIndex = 2
Top = 570
Width = 345
End
Begin VB.Label lblQuery
AutoSize = -1 'True
BackColor = &H00C0C0C0&
Caption = "Author:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 0
Left = 120
TabIndex = 0
Top = 180
Width = 510
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'NOTE: The constant does NOT include the database name this time.
Const BIBLIO_PATH = "D:\Program Files\Microsoft Visual Studio\VB6"
'Because the variable is public (exposed for use by other objects),
'the naming conventions for variables do not apply here - treat
'as a property.
Public SelectedPubID As Integer
Private Sub Form_Load()
'Older versions of BIBLIO.MDB must be converted to the Jet 3.0 format
'before a parameter query can be saved to it.
CheckDatabaseVersion
dtaData.DatabaseName = BIBLIO_PATH & "\Biblio.MDB"
cmdPublisher_Click
End Sub
Private Sub cmdPublisher_Click()
frmSelectPublisher.Show vbModal
If SelectedPubID > 0 Then
RunQuery
Else
frmMain.Caption = "Chapter 5.7 Example - No Titles"
End If
End Sub
Sub RunQuery()
Dim dbfTemp As Database, recTemp As Recordset
Dim qdfTemp As QueryDef
Dim strSQL As String
Dim blnFoundQuery As Boolean
On Error GoTo QueryError
Set dbfTemp = Workspaces(0).OpenDatabase(BIBLIO_PATH & "\Biblio.MDB")
For Each qdfTemp In dbfTemp.QueryDefs
If qdfTemp.Name = "Publisher's Titles By Author" Then
blnFoundQuery = True
Exit For
End If
Next
If blnFoundQuery = False Then
strSQL = "PARAMETERS pintPubID Long; " & _
"SELECT Authors.Author, Titles.Title, Titles.ISBN, " & _
"Titles.[Year Published], Publishers.Name " & _
"FROM (Publishers INNER JOIN Titles ON "
strSQL = strSQL & "Publishers.PubID = Titles.PubID) INNER JOIN " & _
"(Authors INNER JOIN [Title Author] ON " & _
"Authors.Au_ID = [Title Author].Au_ID) ON " & _
"Titles.ISBN = [Title Author].ISBN WHERE Publishers.PubID " & _
"= pintPubID ORDER by Authors.Author;"
Set qdfTemp = dbfTemp.CreateQueryDef("Publisher's Titles By Author", strSQL)
Else
Set qdfTemp = dbfTemp.QueryDefs("Publisher's Titles By Author")
End If
qdfTemp.Parameters![pintPubID] = SelectedPubID
Set dtaData.Recordset = qdfTemp.OpenRecordset()
If dtaData.Recordset.RecordCount > 0 Then
frmMain.Caption = "Chapter 5.7 Example - " & _
Str$(dtaData.Recordset.RecordCount) & _
IIf(dtaData.Recordset.RecordCount = 1, " Title", " Titles")
Else
frmMain.Caption = frmMain.Caption = "Chapter 5.7 Example - No Titles"
End If
On Error GoTo 0
Exit Sub
QueryError:
MsgBox Err.Description, vbExclamation
Exit Sub
End Sub
Private Sub cmdClose_Click()
End
End Sub
Private Sub CheckDatabaseVersion()
Dim dbfTemp As Database, sngVersion As Single
Set dbfTemp = Workspaces(0).OpenDatabase(BIBLIO_PATH & "\Biblio.MDB")
'If the database's Version property is less than 3.0, then it needs
'to be converted before we can save a parameter query to it from 32-bit
'Visual Basic.
sngVersion = Val(dbfTemp.Version)
dbfTemp.Close: DBEngine.Idle dbFreeLocks
If Val(sngVersion) < 3 Then
'First, we'll back up the old database
FileCopy BIBLIO_PATH & "\Biblio.MDB", BIBLIO_PATH & "\BiblioBackup.MDB"
'Then, we'll use the CompactDatabase method to convert it to the
'version 3.0 format
CompactDatabase BIBLIO_PATH & "\Biblio.MDB", _
BIBLIO_PATH & "\BiblioNew.MDB", , dbVersion30
'Next, we'll delete the old database after we're sure the new one exists.
If Len(Dir("BiblioNew.MDB")) Then Kill BIBLIO_PATH & "\Biblio.MDB"
'Finally, we'll rename the new database to the old name, "Biblio.MDB".
If Len(Dir(BIBLIO_PATH)) = 0 Then
Name BIBLIO_PATH & "\BiblioNew.MDB" As BIBLIO_PATH & "\Biblio.MDB"
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -