home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Unleashed / Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso / source / chap35 / cover_sc.frm < prev    next >
Text File  |  1995-09-26  |  7KB  |  250 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. End
  137. Attribute VB_Name = "Cover_scr"
  138. Attribute VB_Creatable = False
  139. Attribute VB_Exposed = False
  140.  
  141. Private Sub btnAccounts_Click()
  142.     MousePointer = 11 'hourglass
  143.     frmAccounts.Show 1 'modal
  144. End Sub
  145.  
  146. Private Sub btnCoInfo_Click()
  147.     MousePointer = 11 ' hourglass
  148.     CoInfo.Show 1 'modal
  149. End Sub
  150.  
  151.  
  152. Private Sub btnExit_Click()
  153.     End
  154. End Sub
  155. Private Sub btnCustMain_Click()
  156.     MousePointer = 11 ' hourglass
  157.     Custinf.Show 1 'modal
  158. End Sub
  159.  
  160.  
  161.  
  162. Private Sub Form_Activate()
  163.     ' Reset to the default  pointer when returning to this form.
  164.     MousePointer = 0
  165. End Sub
  166. Private Sub Form_Load()
  167.     Dim errmsg As String
  168.     Dim response As Integer
  169.     
  170.     
  171.     'Center the form
  172.     
  173.     Left = (Screen.Width - Width) / 2
  174.     Top = (Screen.Height - Height) / 2
  175. ' You could add an API call to check an initialization file
  176. ' for a database name and location instead of defaulting to
  177. ' the names in this example.
  178.  
  179.     App_location = "\source\chap35\" ' Remember backslash at end!
  180.     
  181.     If Not Database_name Then
  182.         Database_name = App_location + "vb4db.mdb"
  183.     End If
  184.  
  185.     On Error GoTo Error_db
  186.  
  187. ' Open single user.
  188.     Set CustDB = OpenDatabase(Database_name)
  189.     Exit Sub
  190.  
  191. Error_db:
  192.     Select Case Err
  193.         Case 3049 ' Possible corrupt database
  194.             errmsg = Err.Description & "  To attempt repairing the database, press OK.  To Abort, press CANCEL"
  195.             response = MsgBox(errmsg, vbOKCancel, "Database Error")
  196.             If response = vbOK Then
  197.                 MousePointer = 11
  198.                 DoEvents
  199.                 Cover_scr.Print "Re-indexing tables..."
  200.                 RepairDatabase Database_name
  201.                 Cover_scr.Print "Optimizing tables..."
  202.                 CompactDatabase Database_name, "\tmpdb.mdb"
  203.                 Cover_scr.Print "Resetting tables..."
  204.                 Kill Database_name
  205.                 Name "\tmpdb.mdb" As Database_name
  206.                 Cover_scr.Refresh
  207.                 MousePointer = 0
  208.                 Resume
  209.             End If
  210.             
  211.         Case Default
  212.             errmsg = Err.Description & "  Press Yes to continue anyway (could be risky), No to exit.  Continue anyway?"
  213.             response = MsgBox(errmsg, vbYesNo + vbDefaultButton2, "Database Error")
  214.             If response = vbYes Then
  215.                 Resume ' Attempt to continue
  216.             Else
  217.                 End ' Shut down the application
  218.             End If
  219.     End Select
  220. End Sub
  221. Private Sub mnuCompany_Click()
  222.     CoInfo.Show
  223. End Sub
  224. Private Sub mnuEditAccounts_Click()
  225.     Call btnAccounts_Click
  226. End Sub
  227.  
  228. Private Sub mnuEditCustomers_Click()
  229.     Call btnCustMain_Click
  230. End Sub
  231.  
  232. Private Sub mnuExit_Click()
  233.     End
  234. End Sub
  235.  
  236. Private Sub mnuHelpAbout_Click()
  237.     Call Picture1_Click
  238. End Sub
  239.  
  240. Private Sub mnuHelpGetStarted_Click()
  241. 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.")
  242. End Sub
  243.  
  244. Private Sub Picture1_Click()
  245.     MousePointer = 11 'Hourglass
  246.     About.Show 1 'modal
  247. End Sub
  248.  
  249.  
  250.