VERSION 5.00
Begin VB.Form frmDisplayFile 
   Caption         =   "Display File"
   ClientHeight    =   5292
   ClientLeft      =   3048
   ClientTop       =   1812
   ClientWidth     =   5976
   LinkTopic       =   "Form1"
   ScaleHeight     =   5292
   ScaleWidth      =   5976
   Begin VB.CommandButton cmdCreateProfile 
      Caption         =   "Create Profile"
      Height          =   372
      Left            =   4560
      TabIndex        =   5
      Top             =   1320
      Width           =   1212
   End
   Begin VB.CommandButton cmdLoadProfile 
      Caption         =   "Load Profile"
      Height          =   372
      Left            =   4560
      TabIndex        =   4
      Top             =   840
      Width           =   1212
   End
   Begin VB.DirListBox dirDirectory 
      Height          =   1800
      Left            =   240
      TabIndex        =   1
      Top             =   600
      Width           =   1692
   End
   Begin VB.FileListBox filFilename 
      Height          =   2184
      Left            =   2040
      TabIndex        =   2
      Top             =   240
      Width           =   2292
   End
   Begin VB.DriveListBox drvDrive 
      Height          =   288
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   1692
   End
   Begin VB.CommandButton cmdReadFile 
      Caption         =   "Read File"
      Height          =   372
      Left            =   4560
      TabIndex        =   3
      Top             =   240
      Width           =   1212
   End
   Begin VB.CommandButton cmdDone 
      Caption         =   "Done"
      Height          =   372
      Left            =   4560
      TabIndex        =   6
      Top             =   1920
      Width           =   1212
   End
   Begin VB.TextBox txtViewFile 
      BackColor       =   &H00FFFFFF&
      ForeColor       =   &H00000000&
      Height          =   2292
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   7
      Top             =   2760
      Width           =   5532
   End
   Begin VB.Line linDividerLine1 
      BorderWidth     =   2
      X1              =   4560
      X2              =   5760
      Y1              =   720
      Y2              =   720
   End
   Begin VB.Line linDividerLine2 
      BorderWidth     =   2
      X1              =   4560
      X2              =   5760
      Y1              =   1800
      Y2              =   1800
   End
End
Attribute VB_Name = "frmDisplayFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'   Chapter 11 Display File Case Study
'   3/99

Option Explicit

Private Sub drvDrive_Change()
    dirDirectory.Path = drvDrive.Drive
End Sub

Private Sub dirDirectory_Change()
    filFilename.Path = dirDirectory.Path
End Sub

Private Sub filFilename_Click()
    txtViewFile.Text = ""
End Sub

Private Sub filFilename_DblClick()
    Call cmdReadFile_Click
End Sub

Private Sub cmdReadFile_Click()
    Dim intFileNum As Integer
    Dim strTextLine As String, strFilename As String

    'Assign strFilename the appropriate filename
    If Right(dirDirectory.Path, 1) = "\" Then
        strFilename = filFilename.Path & filFilename.filename
    Else
        strFilename = filFilename.Path & "\" & filFilename.filename
    End If

    'Open file for reading
    intFileNum = FreeFile
    Open strFilename For Input As #intFileNum

    'Display file in text box
    txtViewFile.Text = ""   'Clear any existing text
    Do While Not EOF(intFileNum)
        Line Input #intFileNum, strTextLine
        txtViewFile.Text = txtViewFile.Text & strTextLine & vbCrLf
    Loop

    'Close file
    Close #intFileNum
End Sub

'**********************************************************************************************
' Applies a user's text box styles to txtViewFile
'
' pre: intProfileNum file has records with fields UserID, Backcolor, TextColor, and TextSize
' post: txtViewFile.BackColor = BackColor, txtViewFile.ForeColor = TextColor, and
' txtViewFile.Font.Size = TextSize
'**********************************************************************************************
Private Sub cmdLoadProfile_Click()
    Dim intProfileNum As Integer
    Dim strID As String, strUserID As String
    Dim strBackColor As String, strTextColor As String, intTextSize As Integer

    'Open file for reading
    intProfileNum = FreeFile
    Open "Dfprofile.txt" For Input As #intProfileNum

    'Apply profile if one exists
    strID = InputBox("Enter your User ID:", "Profile")
    If Not EOF(intProfileNum) Then                      'get first record
        Input #intProfileNum, strUserID, strBackColor, strTextColor, intTextSize
    End If
    Do While (Not EOF(intProfileNum)) And strID <> strUserID
        Input #intProfileNum, strUserID, strBackColor, strTextColor, intTextSize
    Loop
    If strID = strUserID Then
        txtViewFile.BackColor = strBackColor
        txtViewFile.ForeColor = strTextColor
        txtViewFile.Font.Size = intTextSize
    Else
        MsgBox "No profile found."
    End If

    'Close file
    Close #intProfileNum
End Sub

'******************************************************************
' Stores a user's desired text box styles in Dfprofile.txt
'
' post: Dfprofile.txt contains a new record with fields UserID,
' BackColor, TextColor, and TextSize
'******************************************************************
Private Sub cmdCreateProfile_Click()
    Dim intProfileNum As Integer
    Dim strID As String
    Dim strBackColor As String, strTextColor As String, intTextSize As Integer

    'Get user's ID
    strID = InputBox("Enter your User ID:", "Profile")

    'Open file for appending
    intProfileNum = FreeFile
    Open "Dfprofile.txt" For Append As #intProfileNum
    strBackColor = GetBackColor
    strTextColor = GetTextColor
    intTextSize = GetTextSize
    Write #intProfileNum, strID, strBackColor, strTextColor, intTextSize
    MsgBox "Profile created."

    'Close file
    Close #intProfileNum
End Sub

'************************************************************************
' Returns a Visual Basic built-in color constant for the BackColor
'
' post: a Visual Basic built-in color constant returned for BackColor
'************************************************************************
Function GetBackColor() As String
    Dim intColor As Integer

    intColor = InputBox("Enter a background color: 1 - White, 2 - Blue, 3 - Green, 4 - Black", "BackColor")
    If intColor = 1 Then
        GetBackColor = vbWhite
    ElseIf intColor = 2 Then
        GetBackColor = vbBlue
    ElseIf intColor = 3 Then
        GetBackColor = vbGreen
    ElseIf intColor = 4 Then
        GetBackColor = vbBlack
    Else                                            'default color
        GetBackColor = vbWhite
    End If
End Function

'******************************************************************
' Returns an integer for font size
'
' post: an integer returned for font size
'******************************************************************
Function GetTextSize() As Integer
    Dim intSize As Integer

    intSize = InputBox("Enter a text size: 9, 10, 11, 12, 13, 14, 15, 16, 17, 18", "TextSize")
    If intSize >= 9 And intSize <= 18 Then
        GetTextSize = intSize
    Else                                            'default size
        GetTextSize = 12
    End If
End Function

'************************************************************************
' Returns a Visual Basic built-in color constant for TextColor
'
' post: a Visual Basic built-in color constant returned for TextColor
'************************************************************************
Function GetTextColor() As String
    Dim intColor As Integer

    intColor = InputBox("Enter a text color: 1 - Black, 2 - Yellow, 3 - Red, 4 - White", "TextColor")
    If intColor = 1 Then
        GetTextColor = vbBlack
    ElseIf intColor = 2 Then
        GetTextColor = vbYellow
    ElseIf intColor = 3 Then
        GetTextColor = vbRed
    ElseIf intColor = 4 Then
        GetTextColor = vbWhite
    Else                                            'default color
        GetTextColor = vbBlack
    End If
End Function

Private Sub cmdDone_Click()
    Unload Me
End Sub