home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code1
/
mdi_demo
/
titles.frm
< prev
next >
Wrap
Text File
|
1994-04-07
|
10KB
|
405 lines
VERSION 2.00
Begin Form Titles
BackColor = &H00C0C0C0&
Caption = "Titles"
ClientHeight = 1350
ClientLeft = 1935
ClientTop = 3705
ClientWidth = 5265
Height = 2040
Icon = TITLES.FRX:0000
Left = 1875
LinkTopic = "Form2"
MDIChild = -1 'True
ScaleHeight = 1350
ScaleWidth = 5265
Top = 3075
Width = 5385
Begin Data PublishData
Caption = "Data2"
Connect = ""
DatabaseName = ""
Exclusive = 0 'False
Height = 270
Left = 1665
Options = 0
ReadOnly = 0 'False
RecordSource = "Publishers"
Top = 1170
Visible = 0 'False
Width = 1140
End
Begin SSDataCombo Publisher
Prop110 = TITLES.FRX:0302
AllowInput = 0 'False
BevelOuter = 0 'None
DataField = "PubID"
DataSource = "Data1"
DataSourceList = "PublishData"
Height = 300
Left = 1665
RowHeight = 150
TabIndex = 4
Text = "SSDataCombo1"
Top = 855
Width = 1275
End
Begin Data AuthorData
Caption = "Data2"
Connect = ""
DatabaseName = ""
Exclusive = 0 'False
Height = 270
Left = 135
Options = 0
ReadOnly = 0 'False
RecordSource = "Authors"
Top = 1170
Visible = 0 'False
Width = 1140
End
Begin SSDataCombo Author
Prop110 = TITLES.FRX:0389
AllowInput = 0 'False
BevelOuter = 0 'None
DataField = "Au_ID"
DataSource = "Data1"
DataSourceList = "AuthorData"
Height = 300
Left = 135
RowHeight = 150
TabIndex = 0
Text = "SSDataCombo1"
Top = 855
Width = 1275
End
Begin TextBox Title
DataField = "Title"
DataSource = "Data1"
Height = 285
Left = 135
TabIndex = 1
Top = 315
Width = 4920
End
Begin Data Data1
Caption = "Data1"
Connect = ""
DatabaseName = ""
Exclusive = 0 'False
Height = 285
Left = 3555
Options = 0
ReadOnly = 0 'False
RecordSource = "Titles"
Top = 855
Width = 1140
End
Begin Label FormCommand
Caption = "FormCommand"
Height = 240
Left = 3555
TabIndex = 6
Top = 1080
Visible = 0 'False
Width = 1185
End
Begin Label PubLabel
BackStyle = 0 'Transparent
Caption = "Publisher ID"
Height = 195
Left = 1665
TabIndex = 5
Top = 675
Width = 1680
End
Begin Label AuthorLabel
BackStyle = 0 'Transparent
Caption = "Author ID"
Height = 195
Left = 135
TabIndex = 2
Top = 675
Width = 1680
End
Begin Label Label1
BackStyle = 0 'Transparent
Caption = "Title"
Height = 195
Index = 0
Left = 135
TabIndex = 3
Top = 135
Width = 555
End
Begin Menu FileMenu
Caption = "&File"
Begin Menu OpenMenu
Caption = "&Open"
End
Begin Menu SaveMenu
Caption = "&Save"
End
Begin Menu NewMenu
Caption = "&New"
End
Begin Menu CloseMenu
Caption = "&Close"
End
Begin Menu sep
Caption = "-"
End
Begin Menu ExitMenu
Caption = "E&xit"
End
End
Begin Menu EditMenu
Caption = "&Edit"
Begin Menu RestoreMenu
Caption = "&Restore"
End
Begin Menu DeleteMenu
Caption = "&Delete"
End
End
Begin Menu WindowMenu
Caption = "&Window"
WindowList = -1 'True
Begin Menu WindowTileMenu
Caption = "&Tile"
End
Begin Menu WindowCascadeMenu
Caption = "&Cascade"
End
Begin Menu WindowArrangeIconsMenu
Caption = "&Arrange Icons"
End
End
End
Option Explicit
Option Compare Text
Sub AuthorLabel_Click ()
If Val(Author) > 0 Then
' we have a valid author to dsiplay
NewForm "Authors", "FindFirst Au_ID = " & Author
Else
' just show the author form
NewForm "Authors", ""
End If
End Sub
Function CheckData () As Integer
If Author = "" Then
MsgBox "Unable to save record. Author is blank"
Exit Function
End If
CheckData = True
End Function
Sub CloseMenu_Click ()
Unload Me
End Sub
Sub Data1_Error (DataErr As Integer, Response As Integer)
DataError DataErr, Error$(DataErr)
End Sub
Sub Data1_Reposition ()
Dim sql As String
If Data1.EditMode = Data_EditAdd Then
Caption = "Adding New Title"
ElseIf Data1.Recordset.BOF Or Data1.Recordset.EOF Then
Caption = "No Title Records Found"
Else
Caption = "Titles"
End If
End Sub
Sub Data1_Validate (Action As Integer, Save As Integer)
Select Case Action
Case Data_ActionDelete
' this is due to a delete command
' calling routine should confirm deletion
Case Data_ActionUpdate
' make sure data is valid
If CheckData() Then
Save = True
Else
Action = Data_ActionCancel
Save = False
End If
Case Else
If Save Then
' this is due to an implicit save command
' make sure they actually want to save it
If MainMdi.WindowState = Minimized Then MainMdi.WindowState = Normal
If Me.WindowState = Minimized Then Me.WindowState = Normal
Me.Show
Select Case MsgBox("Do you want to save the changes to this Title?", MB_YesNoCancel)
Case IDYes
' they want to save it
' make sure data is valid
If Not CheckData() Then
Action = Data_ActionCancel
Save = False
End If
Case IDNo
Save = False
Case Else
Save = False
Action = Data_ActionCancel
End Select
End If
End Select
End Sub
Sub DeleteMenu_Click ()
On Error GoTo DeleteError
If MsgBox("Are you sure that you want to delete this Title?", MB_YesNo + MB_DefButton2) = IDYes Then
Data1.Recordset.Delete
Data1.Refresh
End If
Exit Sub
DeleteError:
DataError Err, Error$
Exit Sub
End Sub
Sub ExitMenu_Click ()
Unload MainMdi
End Sub
Sub Form_Load ()
' Height and Width are set at run time because
' MDI child forms have their default sizes set by system
Height = 2040
Width = 5385
Data1.DatabaseName = gDatabaseName
Data1.Refresh
AuthorData.DatabaseName = gDatabaseName
AuthorData.Refresh
PublishData.DatabaseName = gDatabaseName
PublishData.Refresh
End Sub
Sub FormCommand_Change ()
Dim Cmd As String, Parameter As String
Dim i As Integer
If FormCommand = "" Then Exit Sub
Cmd = Trim$(FormCommand) & " "
i = InStr(Cmd, " ")
Parameter = Trim$(Mid$(Cmd, i + 1))
Cmd = Left$(Cmd, i - 1)
Select Case Cmd
Case "Refresh"
Select Case Parameter
Case Author: AuthorData.Refresh
Case Publisher: PublishData.Refresh
End Select
End Select
FormCommand = ""
End Sub
Sub NewMenu_Click ()
Data1.Recordset.AddNew
End Sub
Sub OpenMenu_Click ()
OpenDialog.Show 1
End Sub
Sub PubLabel_Click ()
If Val(Publisher) > 0 Then
' we have a valid author to dsiplay
NewForm "Publishers", "FindFirst PubID = " & Publisher
Else
' just show the author form
NewForm "Publishers", ""
End If
End Sub
Sub RestoreMenu_Click ()
Data1.UpdateControls
End Sub
Sub SaveMenu_Click ()
On Error GoTo SaveMenuError
If CheckData() Then
Data1.UpdateRecord
' the following line is neccessary because when
' a new record is saved the first record becomes
' the current record, not the new record
Data1.Recordset.Bookmark = Data1.Recordset.LastModified
End If
Exit Sub
SaveMenuError:
Select Case Err
Case Else
DataError Err, Error$
End Select
Exit Sub
End Sub
Sub WindowArrangeIconsMenu_Click ()
MainMdi.Arrange Arrange_Icons
End Sub
Sub WindowCascadeMenu_Click ()
MainMdi.Arrange Cascade
End Sub
Sub WindowTileMenu_Click ()
MainMdi.Arrange Tile_Horizontal
End Sub