home *** CD-ROM | disk | FTP | other *** search
/ An Introduction to Progr…l Basic 6.0 (4th Edition) / An Introduction to Programming using Visual Basic 6.0.iso / PROGRAMS / CH11 / 11-3-2.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-11-02  |  5.8 KB  |  178 lines
  1. VERSION 5.00
  2. Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
  3. Begin VB.Form frmSprdSht 
  4.    Caption         =   "Spreadsheet"
  5.    ClientHeight    =   1905
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   3450
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   1905
  11.    ScaleWidth      =   3450
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin MSFlexGridLib.MSFlexGrid msgSprdsht 
  14.       Height          =   735
  15.       Left            =   120
  16.       TabIndex        =   3
  17.       Top             =   1080
  18.       Width           =   2175
  19.       _ExtentX        =   3836
  20.       _ExtentY        =   1296
  21.       _Version        =   393216
  22.       FixedRows       =   0
  23.       FixedCols       =   0
  24.       ScrollBars      =   0
  25.    End
  26.    Begin VB.CommandButton cmdQuit 
  27.       Caption         =   "Quit"
  28.       Height          =   375
  29.       Left            =   2640
  30.       TabIndex        =   2
  31.       Top             =   240
  32.       Width           =   735
  33.    End
  34.    Begin VB.CommandButton cmdCols 
  35.       Caption         =   "Columns"
  36.       Height          =   375
  37.       Left            =   1680
  38.       TabIndex        =   1
  39.       Top             =   240
  40.       Width           =   855
  41.    End
  42.    Begin VB.CommandButton cmdRows 
  43.       Caption         =   "Rows"
  44.       Height          =   375
  45.       Left            =   720
  46.       TabIndex        =   0
  47.       Top             =   240
  48.       Width           =   855
  49.    End
  50.    Begin VB.Label lblMsg 
  51.       Caption         =   "Click on a cell to change its value"
  52.       Height          =   375
  53.       Left            =   120
  54.       TabIndex        =   5
  55.       Top             =   720
  56.       Width           =   5535
  57.    End
  58.    Begin VB.Label lblAdjust 
  59.       Caption         =   "Adjust"
  60.       Height          =   255
  61.       Left            =   120
  62.       TabIndex        =   4
  63.       Top             =   360
  64.       Width           =   495
  65.    End
  66. Attribute VB_Name = "frmSprdSht"
  67. Attribute VB_GlobalNameSpace = False
  68. Attribute VB_Creatable = False
  69. Attribute VB_PredeclaredId = True
  70. Attribute VB_Exposed = False
  71. Dim numRows As Integer    'number of rows
  72. Dim numCols As Integer    'number of columns
  73. Private Sub cmdCols_Click()
  74.   Dim temp As String
  75.   'Adjust number of columns in the spreadsheet
  76.   temp = InputBox("Enter new number of columns (2-7):")
  77.   If (Val(temp) >= 2) And (Val(temp) <= 7) Then
  78.       numCols = Val(temp)
  79.       Call SetUpGrid
  80.       Call ShowValues
  81.       Call ShowTotals
  82.   End If
  83. End Sub
  84. Private Sub cmdQuit_Click()
  85.   End
  86. End Sub
  87. Private Sub cmdRows_Click()
  88.   Dim temp As String
  89.   'Adjust the number of rows in the spreadsheet
  90.   temp = InputBox("Enter new number of rows (4-24):")
  91.   If (Val(temp) >= 4) And (Val(temp) <= 24) Then
  92.       numRows = Val(temp)
  93.       Call SetUpGrid
  94.       Call ShowValues
  95.       Call ShowTotals
  96.   End If
  97. End Sub
  98. Private Sub Form_Load()
  99.   'Set default number of rows and columns
  100.   numRows = 8 'row 0 is for headings, last 2 rows are for totals
  101.   numCols = 2 'column 0 is for category names
  102.   Call SetUpGrid
  103.   Call ShowValues
  104.   Call ShowTotals
  105. End Sub
  106. Private Sub msgSprdSht_Click()
  107.   Dim temp As String, message As String
  108.   'Obtain new value for cell if it is not in the "Total" row
  109.   If msgSprdsht.Row < numRows - 2 Then
  110.       message = "Enter new value for the row"
  111.       message = message & Str(msgSprdsht.Row + 1) & " column"
  112.       message = message & Str(msgSprdsht.Col + 1) & " cell:"
  113.       temp = InputBox(message, , msgSprdsht.Text) 'Propose old value as default
  114.       If msgSprdsht.Col = 0 Then
  115.           msgSprdsht.Text = temp
  116.         ElseIf msgSprdsht.Row = 0 Then
  117.           msgSprdsht.Text = temp
  118.         Else
  119.           msgSprdsht.Text = FormatNumber(Val(temp), , , , vbFalse)
  120.           Call ShowTotals
  121.       End If
  122.   End If
  123. End Sub
  124. Private Sub SetUpGrid()
  125.   Dim colNum As Integer
  126.   'Set up grid
  127.   msgSprdsht.Col = 0
  128.   msgSprdsht.Row = msgSprdsht.Rows - 1
  129.   msgSprdsht.Text = "" 'erase "Total" in case increasing rows
  130.   msgSprdsht.Rows = numRows
  131.   msgSprdsht.Cols = numCols
  132.   'Set column widths; right-justify columns with numeric data
  133.   msgSprdsht.ColWidth(0) = 2000   'space for category names
  134.   msgSprdsht.ColAlignment(0) = 1  'show data left-justified
  135.   For colNum = 1 To numCols - 1
  136.     msgSprdsht.ColWidth(colNum) = 1200  'space for dollar amounts
  137.     msgSprdsht.ColAlignment(colNum) = 7 'show data right-justified
  138.   Next colNum
  139.   'Set overall grid size to minimum needed for the data
  140.   msgSprdsht.Width = 2000 + (numCols - 1) * 1200 + 15 * (numCols + 1) + 8
  141.   msgSprdsht.Height = numRows * msgSprdsht.RowHeight(0) + 15 * (numRows + 1) + 8
  142.   'Adjust form to accommodate grid and other controls
  143.   frmSprdSht.Width = msgSprdsht.Left + msgSprdsht.Width + 200
  144.   frmSprdSht.Height = msgSprdsht.Top + msgSprdsht.Height + 500
  145.   frmSprdSht.Top = 0
  146.   frmSprdSht.Left = 0
  147. End Sub
  148. Private Sub ShowTotals()
  149.   Dim colNum As Integer, rowNum As Integer, total As Single
  150.   'Compute and display total of each numeric column
  151.   msgSprdsht.Row = numRows - 1
  152.   msgSprdsht.Col = 0
  153.   msgSprdsht.Text = "Total"
  154.   For colNum = 1 To numCols - 1
  155.     total = 0
  156.     For rowNum = 1 To numRows - 3
  157.       msgSprdsht.Row = rowNum
  158.       msgSprdsht.Col = colNum
  159.       total = total + Val(msgSprdsht.Text)
  160.     Next rowNum
  161.     msgSprdsht.Row = numRows - 2
  162.     msgSprdsht.Text = "----------------"
  163.     msgSprdsht.Row = numRows - 1
  164.     msgSprdsht.Text = FormatCurrency(total)
  165.   Next colNum
  166. End Sub
  167. Private Sub ShowValues()
  168.   Dim rowNum As Integer, colNum As Integer
  169.   'Refresh values displayed in cells
  170.   For rowNum = 1 To numRows - 1
  171.     For colNum = 1 To numCols - 1
  172.       msgSprdsht.Row = rowNum
  173.       msgSprdsht.Col = colNum
  174.       msgSprdsht.Text = FormatNumber(Val(msgSprdsht.Text))
  175.     Next colNum
  176.   Next rowNum
  177. End Sub
  178.