Programmer 7500/MAX_PROGRAMMERS.iso/VISUAL_B/CODIGO_1/MDI_DEMO/TITLES.FRM

Visual Basic Form | 1994-04-07 | 9.6 KB | 333 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
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
    ' 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"
    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
    ' 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