Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/mdidem/publish.frm

Visual Basic Form | 1995-05-02 | 6.6 KB | 240 lines

VERSION 2.00
Begin Form Publish
   BackColor       =   &H00C0C0C0&
   Caption         =   "Publishers"
   ClientHeight    =   1245
   ClientLeft      =   3690
   ClientTop       =   2460
   ClientWidth     =   3990
   Height          =   1935
   Icon            =   PUBLISH.FRX:0000
   Left            =   3630
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   1245
   ScaleWidth      =   3990
   Top             =   1830
   Width           =   4110
   Begin TextBox PubName
      DataField       =   "Name"
      DataSource      =   "Data1"
      Height          =   285
      Left            =   135
      MaxLength       =   40
      TabIndex        =   0
      Top             =   315
      Width           =   3615
   End
   Begin Data Data1
      Caption         =   "Data1"
      Connect         =   ""
      DatabaseName    =   ""
      Exclusive       =   0   'False
      Height          =   285
      Left            =   2610
      Options         =   0
      ReadOnly        =   0   'False
      RecordSource    =   "Publishers"
      Top             =   720
      Width           =   1140
   End
   Begin Label FormCommand
      Caption         =   "FormCommand"
      Height          =   240
      Left            =   1440
      TabIndex        =   2
      Top             =   765
      Visible         =   0   'False
      Width           =   1185
   End
   Begin Label Label1
      BackStyle       =   0  'Transparent
      Caption         =   "Name"
      Height          =   240
      Index           =   0
      Left            =   135
      TabIndex        =   1
      Top             =   135
      Width           =   1005
   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
Const RecordType = "Publisher"
Sub DeleteMenu_Click ()
On Error GoTo DeleteError
If MsgBox("Are you sure that you want to delete this " & LCase$(RecordType) & "?", 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 = 1935
Width = 4110
Data1.DatabaseName = gDatabaseName
Data1.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 "FindFirst"
        Data1.Recordset.FindFirst Parameter
End Select
FormCommand = ""
End Sub
Sub NewMenu_Click ()
Data1.Recordset.AddNew
End Sub
Sub OpenMenu_Click ()
OpenDialog.Show 1
End Sub
Sub RestoreMenu_Click ()
Data1.UpdateControls
End Sub
Sub SaveMenu_Click ()
On Error GoTo SaveMenuError
If CheckData() Then
    Data1.UpdateRecord
    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
Function CheckData () As Integer
If PubName = "" Then
    MsgBox "Unable to save record. Publisher name is blank."
    CheckData = False
    CheckData = True
End If
End Function
Sub CloseMenu_Click ()
Unload Me
End Sub
Sub Data1_Reposition ()
If Data1.EditMode = Data_EditAdd Then
    Caption = "Adding New Publisher"
ElseIf Data1.Recordset.BOF Or Data1.Recordset.EOF Then
    Caption = "No Publisher Records Found"
    Caption = "Publisher #" & Data1.Recordset("PubID")
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 " & RecordType & "?", 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
If Save Then
    On Error GoTo ValidateError
    ' perform the save manually
    Save = False
    Data1.UpdateRecord
    Data1.Recordset.Bookmark = Data1.Recordset.LastModified
    SendAll "Refresh Publisher"
End If
Exit Sub
ValidateError:
    DataError Err, Error$
    Action = Data_ActionCancel
    Exit Sub
End Sub