home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code1
/
acces2vb
/
frmdemom.frm
< prev
next >
Wrap
Text File
|
1994-03-02
|
20KB
|
676 lines
VERSION 2.00
Begin Form frmDemoMain
BackColor = &H00C0C0C0&
Caption = "JET 2.0 VB3 Demo"
ClientHeight = 6390
ClientLeft = 1485
ClientTop = 1635
ClientWidth = 8970
Height = 7110
Icon = FRMDEMOM.FRX:0000
Left = 1410
LinkTopic = "Form1"
ScaleHeight = 6390
ScaleWidth = 8970
Top = 990
Width = 9120
Begin CommandButton cmdExit
Caption = "E&xit"
Height = 375
Left = 1980
TabIndex = 11
Top = 3420
Width = 1035
End
Begin CommandButton cmdGo
Caption = "&Go"
Height = 375
Left = 720
TabIndex = 10
Top = 3420
Width = 1095
End
Begin TextBox txtDBLocation
Height = 315
Left = 3780
TabIndex = 12
Text = "C:\VB\BIBLIO.MDB"
Top = 3480
Width = 5055
End
Begin SSFrame Frame3D1
Caption = "&Demo"
Height = 3255
Left = 120
TabIndex = 14
Top = 120
Width = 3495
Begin SSOption o3dDemo
Caption = "Other New Features"
Height = 195
Index = 20
Left = 180
TabIndex = 9
Top = 2820
Width = 2715
End
Begin SSOption o3dDemo
Caption = "Correlated Subqueries"
Height = 195
Index = 3
Left = 180
TabIndex = 3
Top = 1080
Width = 2715
End
Begin SSOption o3dDemo
Caption = "Top n Query"
Height = 195
Index = 2
Left = 180
TabIndex = 2
Top = 840
Width = 2715
End
Begin SSOption o3dDemo
Caption = "DDL Create Index"
Height = 195
Index = 12
Left = 180
TabIndex = 6
Top = 1980
Width = 2895
End
Begin SSOption o3dDemo
Caption = "Insert using Values clause"
Height = 195
Index = 14
Left = 180
TabIndex = 8
Top = 2460
Width = 2715
End
Begin SSOption o3dDemo
Caption = "DDL Drop Table"
Height = 195
Index = 13
Left = 180
TabIndex = 7
Top = 2220
Width = 2715
End
Begin SSOption o3dDemo
Caption = "DDL Alter Table - add column"
Height = 195
Index = 11
Left = 180
TabIndex = 5
Top = 1740
Width = 2895
End
Begin SSOption o3dDemo
Caption = "DDL Create Table"
Height = 195
Index = 10
Left = 180
TabIndex = 4
Top = 1500
Width = 2715
End
Begin SSOption o3dDemo
Caption = "Sub-Select Query"
Height = 195
Index = 1
Left = 180
TabIndex = 1
Top = 600
Width = 2715
End
Begin SSOption o3dDemo
Caption = "UNION Query"
Height = 195
Index = 0
Left = 180
TabIndex = 0
Top = 360
Width = 2715
End
End
Begin Grid grdDemo
Cols = 10
FixedCols = 0
Height = 2415
Left = 120
Rows = 10
TabIndex = 13
Top = 3840
Width = 8715
End
Begin Label Label2
BackStyle = 0 'Transparent
Caption = "SQL Command"
Height = 255
Left = 3900
TabIndex = 17
Top = 120
Width = 1935
End
Begin Label lblExampleText
BorderStyle = 1 'Fixed Single
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 2775
Left = 3780
TabIndex = 16
Top = 300
Width = 4935
End
Begin Label Label1
BackStyle = 0 'Transparent
Caption = "Sample DB Location"
Height = 255
Left = 3780
TabIndex = 15
Top = 3240
Width = 2175
End
Begin Shape Shape1
BackColor = &H00808080&
BackStyle = 1 'Opaque
BorderStyle = 0 'Transparent
Height = 2775
Left = 3840
Top = 360
Width = 4935
End
Begin Menu mnuFile
Caption = "F&ile"
Begin Menu mnuFileCommands
Caption = "&About"
Index = 0
End
Begin Menu mnuFileCommands
Caption = "E&xit"
Index = 1
End
End
End
Option Explicit
Dim gDefaultDatabase As database
Dim DBOpen_OK As Integer
Sub ClearGrid ()
Dim i As Integer
Dim j As Integer
For i = 0 To 9
For j = 0 To 9
grdDemo.Col = i
grdDemo.Row = j
grdDemo.Text = ""
Next j
Next i
End Sub
Sub cmdExit_Click ()
Unload Me
End Sub
Sub cmdGo_Click ()
On Error Resume Next
Dim ds As dynaset
Dim i As Integer
If Not DBOpen_OK Then
Set gDefaultDatabase = OpenDatabase(txtDBLocation.Text)
If Err <> 0 Then
MsgBox "Error Opening: " & txtDBLocation.Text
Exit Sub
End If
DBOpen_OK = True
End If
ClearGrid
ResetGridWidths
'UNION Query
If o3dDemo(0).Value = -1 Then
Me.MousePointer = 11
grdDemo.ColWidth(1) = 2000
grdDemo.ColWidth(2) = 1500
grdDemo.Row = 0
grdDemo.Col = 0
grdDemo.Text = "ID"
grdDemo.Col = 1
grdDemo.Text = "Name"
grdDemo.Col = 2
grdDemo.Text = "Type"
Set ds = gDefaultDatabase.CreateDynaset(lblExampleText)
If ds.RecordCount <> 0 Then
i = 1
Do Until ds.EOF
grdDemo.Row = (i)
grdDemo.Col = 0
grdDemo.Text = ds(0)
grdDemo.Col = 1
grdDemo.Text = ds(1)
grdDemo.Col = 2
grdDemo.Text = ds(2)
ds.MoveNext
i = i + 1
If i > 9 Then
Exit Do
End If
Loop
End If
Me.MousePointer = 0
End If
'Sub-Select Query
If o3dDemo(1).Value = -1 Then
Me.MousePointer = 11
grdDemo.ColWidth(1) = 2000
grdDemo.ColWidth(2) = 2500
grdDemo.Row = 0
grdDemo.Col = 0
grdDemo.Text = "Pub ID"
grdDemo.Col = 1
grdDemo.Text = "Name"
grdDemo.Col = 2
grdDemo.Text = "Company Name"
Set ds = gDefaultDatabase.CreateDynaset(lblExampleText)
If ds.RecordCount <> 0 Then
i = 1
Do Until ds.EOF
grdDemo.Row = (i)
grdDemo.Col = 0
grdDemo.Text = ds("PubID")
grdDemo.Col = 1
grdDemo.Text = ds("Name")
grdDemo.Col = 2
grdDemo.Text = ds("Company Name")
ds.MoveNext
i = i + 1
If i > 9 Then
Exit Do
End If
Loop
End If
Me.MousePointer = 0
End If
'Top n query
If o3dDemo(2).Value = -1 Then
Me.MousePointer = 11
grdDemo.ColWidth(0) = 1400
grdDemo.ColWidth(1) = 2000
grdDemo.ColWidth(2) = 2000
grdDemo.ColWidth(3) = 4000
grdDemo.Row = 0
grdDemo.Col = 0
grdDemo.Text = "Year Published"
grdDemo.Col = 1
grdDemo.Text = "Author"
grdDemo.Col = 2
grdDemo.Text = "Name"
grdDemo.Col = 3
grdDemo.Text = "Title"
Set ds = gDefaultDatabase.CreateDynaset(lblExampleText)
If ds.RecordCount <> 0 Then
i = 1
Do Until ds.EOF
grdDemo.Row = (i)
grdDemo.Col = 0
grdDemo.Text = ds("Year Published")
grdDemo.Col = 1
grdDemo.Text = ds("Author")
grdDemo.Col = 2
grdDemo.Text = ds("Name")
grdDemo.Col = 3
grdDemo.Text = ds("Title")
ds.MoveNext
i = i + 1
If i > 9 Then
Exit Do
End If
Loop
End If
Me.MousePointer = 0
End If
'Corellated sub-query
If o3dDemo(3).Value = -1 Then
Me.MousePointer = 11
grdDemo.ColWidth(0) = 800
grdDemo.ColWidth(1) = 1800
grdDemo.ColWidth(2) = 3500
grdDemo.Row = 0
grdDemo.Col = 0
grdDemo.Text = "Pub ID"
grdDemo.Col = 1
grdDemo.Text = "Author"
grdDemo.Col = 2
grdDemo.Text = "Title"
Set ds = gDefaultDatabase.CreateDynaset(lblExampleText)
If ds.RecordCount <> 0 Then
i = 1
Do Until ds.EOF
grdDemo.Row = (i)
grdDemo.Col = 0
grdDemo.Text = ds("PubID")
grdDemo.Col = 1
grdDemo.Text = ds("Author")
grdDemo.Col = 2
grdDemo.Text = ds("Title")
ds.MoveNext
i = i + 1
If i > 9 Then
Exit Do
End If
Loop
End If
Me.MousePointer = 0
End If
'Create Table
If o3dDemo(10).Value = -1 Then
If TableExists("My Test Table") Then
MsgBox "Table [My Test Table] already exists. Try doing a DROP TABLE command"
Exit Sub
End If
On Error Resume Next
gDefaultDatabase.Execute lblExampleText
If Err <> 0 Then
MsgBox "error creating Test Table"
End If
On Error GoTo 0
End If
'Add column
If o3dDemo(11).Value = -1 Then
If Not TableExists("My Test Table") Then
MsgBox "Table [My Test Table] does not exist. Try doing a CREATE TABLE command"
Exit Sub
End If
On Error Resume Next
gDefaultDatabase.Execute lblExampleText
If Err <> 0 Then
MsgBox "Error adding column to My Test Table."
End If
On Error GoTo 0
End If
'Create Index
If o3dDemo(12).Value = -1 Then
If Not TableExists("My Test Table") Then
MsgBox "Table [My Test Table] does not exist. Try doing a CREATE TABLE command"
Exit Sub
End If
On Error Resume Next
gDefaultDatabase.Execute lblExampleText
If Err <> 0 Then
MsgBox "Error creating PrimaryKey index on My Test Table."
End If
On Error GoTo 0
End If
'Drop Table
If o3dDemo(13).Value = -1 Then
If Not TableExists("My Test Table") Then
MsgBox "Table [My Test Table] does not exist. Try doing a CREATE TABLE command"
Exit Sub
End If
On Error Resume Next
gDefaultDatabase.Execute lblExampleText
If Err <> 0 Then
MsgBox "Error dropping table My Test Table."
End If
On Error GoTo 0
End If
'Insert Values...
If o3dDemo(14).Value = -1 Then
If Not TableExists("My Test Table") Then
MsgBox "Table [My Test Table] does not exist. Try doing a CREATE TABLE command"
Exit Sub
End If
On Error Resume Next
gDefaultDatabase.Execute lblExampleText
If Err <> 0 Then
MsgBox "Error inserting values into My Test Table."
End If
On Error GoTo 0
End If
End Sub
Sub Form_Load ()
Dim i As Integer
Me.Top = (screen.Height - Me.Height) / 2
Me.Left = (screen.Width - Me.Width) / 2
ResetGridWidths
o3dDemo(0).Value = 1
End Sub
Sub Form_Unload (Cancel As Integer)
If DBOpen_OK Then
gDefaultDatabase.Close
End If
End
End Sub
Sub mnuFileCommands_Click (index As Integer)
Select Case index
Case 0: frmAbout.Show 1
Case 1: Unload Me
End Select
End Sub
Sub o3dDemo_Click (index As Integer, Value As Integer)
Dim strNewText As String
Dim crlf As String
crlf = Chr$(13) & Chr$(10)
Select Case index
Case 0' UNION
strNewText = "SELECT DISTINCTROW " & crlf
strNewText = strNewText & "Authors.Au_ID as IDNum , " & crlf
strNewText = strNewText & "Authors.Author as IDName, " & crlf
strNewText = strNewText & "'Author' as ColType " & crlf
strNewText = strNewText & "FROM Authors " & crlf
strNewText = strNewText & "UNION SELECT DISTINCTROW " & crlf
strNewText = strNewText & "Publishers.PubID, " & crlf
strNewText = strNewText & "Publishers.Name, " & crlf
strNewText = strNewText & "'Publisher' as ColType " & crlf
strNewText = strNewText & "FROM Publishers " & crlf
strNewText = strNewText & "ORDER BY IDName; "
Case 1' Sub-Select Query
strNewText = "SELECT DISTINCTROW Publishers.* " & crlf
strNewText = strNewText & "FROM Publishers " & crlf
strNewText = strNewText & "where Publishers.PubID in " & crlf
strNewText = strNewText & "(SELECT DISTINCT Titles.PubID " & crlf
strNewText = strNewText & "FROM Titles " & crlf
strNewText = strNewText & "WHERE ((Titles.Title Like '*SQL*'))) " & crlf
strNewText = strNewText & "ORDER BY [Company Name]; "
Case 2' Top n Query
strNewText = "SELECT DISTINCTROW TOP 5 " & crlf
strNewText = strNewText & "Titles.[Year Published], " & crlf
strNewText = strNewText & "Authors.Author, " & crlf
strNewText = strNewText & "Publishers.Name, " & crlf
strNewText = strNewText & "Titles.Title " & crlf
strNewText = strNewText & "FROM (Titles INNER JOIN Authors ON Titles.Au_ID = Authors.Au_ID) " & crlf
strNewText = strNewText & "INNER JOIN Publishers ON Titles.PubID = Publishers.PubID " & crlf
strNewText = strNewText & "ORDER BY Titles.[Year Published], Authors.Author; "
Case 3' Corellated subqueries:
strNewText = "SELECT DISTINCTROW " & crlf
strNewText = strNewText & "A.PubID, Authors.Author, A.Title " & crlf
strNewText = strNewText & "FROM Titles as A " & crlf
strNewText = strNewText & "INNER JOIN Authors ON A.Au_ID = Authors.Au_ID " & crlf
strNewText = strNewText & "WHERE " & crlf
strNewText = strNewText & "(1 < (SELECT count(*) from Titles as B " & crlf
strNewText = strNewText & "where A.PubID = B.PubID)) " & crlf
strNewText = strNewText & "ORDER BY A.PubID, Authors.Author; "
Case 10' DDL Create Table
strNewText = "CREATE TABLE [My Test Table] " & crlf
strNewText = strNewText & "([Last Name] text (20), " & crlf
strNewText = strNewText & "[First Name] text (20), " & crlf
strNewText = strNewText & "[Department] text (2), " & crlf
strNewText = strNewText & "[Date Added] DateTime) "
Case 11 'DDL Alter Table - add column
strNewText = strNewText & "ALTER TABLE [My Test Table] " & crlf
strNewText = strNewText & "ADD COLUMN RecID COUNTER; "
Case 12' DDL Create Index
strNewText = strNewText & "CREATE INDEX 'PrimaryKey' " & crlf
strNewText = strNewText & "ON [My Test Table] " & crlf
strNewText = strNewText & "(RecID) WITH PRIMARY; "
Case 13' DDL Drop Table
strNewText = "DROP TABLE [My Test Table]"
Case 14' Insert values...
strNewText = "INSERT INTO [My Test Table] " & crlf
strNewText = strNewText & "( [Last Name], " & crlf
strNewText = strNewText & "[First Name], " & crlf
strNewText = strNewText & "[Department], " & crlf
strNewText = strNewText & "[Date Added] ) " & crlf
strNewText = strNewText & "VALUES " & crlf
strNewText = strNewText & "('Smith', " & crlf
strNewText = strNewText & "'John', " & crlf
strNewText = strNewText & "'20', " & crlf
strNewText = strNewText & "#04/1/94#);"
Case 20' other features
strNewText = "* Cascading updates and deletes " & crlf
strNewText = strNewText & "* Update non-joined fields on 'one' side of a join " & crlf
strNewText = strNewText & "* Fill in the blank rows of a LEFT JOIN " & crlf
strNewText = strNewText & "* Support for Paradox 4.x format"
End Select
lblExampleText = strNewText
End Sub
Sub ResetGridWidths ()
Dim i As Integer
For i = 0 To 9
grdDemo.ColWidth(i) = 835
Next i
End Sub
Function TableExists (tname As Variant) As Integer
TableExists = False
Dim ss As snapshot
Set ss = gDefaultDatabase.ListTables()
If ss.RecordCount <> 0 Then
ss.MoveFirst
Do Until ss.EOF
'Debug.Print ss("Name")
If ss("Name") = tname Then
TableExists = True
Exit Do
End If
ss.MoveNext
Loop
End If
End Function
