home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Unleashed / Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso / source / chap35 / cover_sc.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-09-26  |  7.2 KB  |  227 lines
  1. VERSION 4.00
  2. Begin VB.Form Cover_scr 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Stand-Alone VB DB Application"
  5.    ClientHeight    =   5130
  6.    ClientLeft      =   900
  7.    ClientTop       =   1215
  8.    ClientWidth     =   8190
  9.    FillColor       =   &H00C0C0C0&
  10.    FillStyle       =   0  'Solid
  11.    BeginProperty Font 
  12.       name            =   "MS Sans Serif"
  13.       charset         =   1
  14.       weight          =   700
  15.       size            =   8.25
  16.       underline       =   0   'False
  17.       italic          =   0   'False
  18.       strikethrough   =   0   'False
  19.    EndProperty
  20.    ForeColor       =   &H80000008&
  21.    Height          =   5820
  22.    Icon            =   "COVER_SC.frx":0000
  23.    Left            =   840
  24.    LinkTopic       =   "Form2"
  25.    MaxButton       =   0   'False
  26.    Picture         =   "COVER_SC.frx":030A
  27.    ScaleHeight     =   5130
  28.    ScaleWidth      =   8190
  29.    Top             =   585
  30.    Width           =   8310
  31.    Begin VB.PictureBox Picture1 
  32.       Appearance      =   0  'Flat
  33.       BackColor       =   &H00C0C0C0&
  34.       BorderStyle     =   0  'None
  35.       ForeColor       =   &H80000008&
  36.       Height          =   1935
  37.       Left            =   3120
  38.       Picture         =   "COVER_SC.frx":0700
  39.       ScaleHeight     =   1935
  40.       ScaleWidth      =   1935
  41.       TabIndex        =   2
  42.       Top             =   1560
  43.       Width           =   1935
  44.    End
  45.    Begin VB.CommandButton btnExit 
  46.       Caption         =   "E&xit"
  47.       Height          =   615
  48.       Left            =   6240
  49.       TabIndex        =   1
  50.       Top             =   3960
  51.       Width           =   1455
  52.    End
  53.    Begin Threed.SSCommand btnAccounts 
  54.       Height          =   855
  55.       Left            =   5400
  56.       TabIndex        =   5
  57.       Top             =   360
  58.       Width           =   1455
  59.       _version        =   65536
  60.       _extentx        =   2566
  61.       _extenty        =   1508
  62.       _stockprops     =   78
  63.       caption         =   "&Accounts"
  64.       picture         =   "COVER_SC.frx":2E42
  65.    End
  66.    Begin Threed.SSCommand btnCustMain 
  67.       Height          =   855
  68.       Left            =   1320
  69.       TabIndex        =   4
  70.       Top             =   360
  71.       Width           =   1455
  72.       _version        =   65536
  73.       _extentx        =   2566
  74.       _extenty        =   1508
  75.       _stockprops     =   78
  76.       caption         =   "&Customer Files"
  77.       picture         =   "COVER_SC.frx":315C
  78.    End
  79.    Begin Threed.SSCommand btnCoInfo 
  80.       Height          =   855
  81.       Left            =   3360
  82.       TabIndex        =   3
  83.       Top             =   3840
  84.       Width           =   1455
  85.       _version        =   65536
  86.       _extentx        =   2566
  87.       _extenty        =   1508
  88.       _stockprops     =   78
  89.       caption         =   "Company &Info"
  90.       picture         =   "COVER_SC.frx":3476
  91.    End
  92.    Begin VB.Label Label1 
  93.       Appearance      =   0  'Flat
  94.       BackColor       =   &H00C0C0C0&
  95.       Caption         =   "Version 1.0"
  96.       ForeColor       =   &H00C00000&
  97.       Height          =   255
  98.       Left            =   6240
  99.       TabIndex        =   0
  100.       Top             =   4680
  101.       Width           =   1695
  102.    End
  103.    Begin VB.Menu mnuFile 
  104.       Caption         =   "&File"
  105.       Begin VB.Menu mnuCompany 
  106.          Caption         =   "&Company information"
  107.       End
  108.       Begin VB.Menu mnuBar1 
  109.          Caption         =   "-"
  110.       End
  111.       Begin VB.Menu mnuExit 
  112.          Caption         =   "E&xit"
  113.       End
  114.    End
  115.    Begin VB.Menu mnuEdit 
  116.       Caption         =   "&Edit"
  117.       Begin VB.Menu mnuEditCustomers 
  118.          Caption         =   "&Customers"
  119.       End
  120.       Begin VB.Menu mnuEditLine1 
  121.          Caption         =   "-"
  122.       End
  123.       Begin VB.Menu mnuEditAccounts 
  124.          Caption         =   "&Accounts"
  125.       End
  126.    End
  127.    Begin VB.Menu mnuHelp 
  128.       Caption         =   "&Help"
  129.       Begin VB.Menu mnuHelpGetStarted 
  130.          Caption         =   "How to get started"
  131.       End
  132.       Begin VB.Menu mnuHelpAbout 
  133.          Caption         =   "&About this application"
  134.       End
  135.    End
  136. Attribute VB_Name = "Cover_scr"
  137. Attribute VB_Creatable = False
  138. Attribute VB_Exposed = False
  139. Private Sub btnAccounts_Click()
  140.     MousePointer = 11 'hourglass
  141.     frmAccounts.Show 1 'modal
  142. End Sub
  143. Private Sub btnCoInfo_Click()
  144.     MousePointer = 11 ' hourglass
  145.     CoInfo.Show 1 'modal
  146. End Sub
  147. Private Sub btnExit_Click()
  148.     End
  149. End Sub
  150. Private Sub btnCustMain_Click()
  151.     MousePointer = 11 ' hourglass
  152.     Custinf.Show 1 'modal
  153. End Sub
  154. Private Sub Form_Activate()
  155.     ' Reset to the default  pointer when returning to this form.
  156.     MousePointer = 0
  157. End Sub
  158. Private Sub Form_Load()
  159.     Dim errmsg As String
  160.     Dim response As Integer
  161.     'Center the form
  162.     Left = (Screen.Width - Width) / 2
  163.     Top = (Screen.Height - Height) / 2
  164. ' You could add an API call to check an initialization file
  165. ' for a database name and location instead of defaulting to
  166. ' the names in this example.
  167.     App_location = "\source\chap35\" ' Remember backslash at end!
  168.     If Not Database_name Then
  169.         Database_name = App_location + "vb4db.mdb"
  170.     End If
  171.     On Error GoTo Error_db
  172. ' Open single user.
  173.     Set CustDB = OpenDatabase(Database_name)
  174.     Exit Sub
  175. Error_db:
  176.     Select Case Err
  177.         Case 3049 ' Possible corrupt database
  178.             errmsg = Err.Description & "  To attempt repairing the database, press OK.  To Abort, press CANCEL"
  179.             response = MsgBox(errmsg, vbOKCancel, "Database Error")
  180.             If response = vbOK Then
  181.                 MousePointer = 11
  182.                 DoEvents
  183.                 Cover_scr.Print "Re-indexing tables..."
  184.                 RepairDatabase Database_name
  185.                 Cover_scr.Print "Optimizing tables..."
  186.                 CompactDatabase Database_name, "\tmpdb.mdb"
  187.                 Cover_scr.Print "Resetting tables..."
  188.                 Kill Database_name
  189.                 Name "\tmpdb.mdb" As Database_name
  190.                 Cover_scr.Refresh
  191.                 MousePointer = 0
  192.                 Resume
  193.             End If
  194.             
  195.         Case Default
  196.             errmsg = Err.Description & "  Press Yes to continue anyway (could be risky), No to exit.  Continue anyway?"
  197.             response = MsgBox(errmsg, vbYesNo + vbDefaultButton2, "Database Error")
  198.             If response = vbYes Then
  199.                 Resume ' Attempt to continue
  200.             Else
  201.                 End ' Shut down the application
  202.             End If
  203.     End Select
  204. End Sub
  205. Private Sub mnuCompany_Click()
  206.     CoInfo.Show
  207. End Sub
  208. Private Sub mnuEditAccounts_Click()
  209.     Call btnAccounts_Click
  210. End Sub
  211. Private Sub mnuEditCustomers_Click()
  212.     Call btnCustMain_Click
  213. End Sub
  214. Private Sub mnuExit_Click()
  215.     End
  216. End Sub
  217. Private Sub mnuHelpAbout_Click()
  218.     Call Picture1_Click
  219. End Sub
  220. Private Sub mnuHelpGetStarted_Click()
  221. MsgBox ("This is the main screen for this application.  To access an area, move the mouse pointer to one of the buttons and 'double-click' on it, or click once and press the Enter key.  Press enter or click OK to continue.")
  222. End Sub
  223. Private Sub Picture1_Click()
  224.     MousePointer = 11 'Hourglass
  225.     About.Show 1 'modal
  226. End Sub
  227.