cd-rom express 12

home *** CD-ROM | disk | FTP | other *** search

/ cd-rom express 12 / CDRE12.ISO / Utilities / Kyn / VB5Code.ZIP / frmMain.frm (.txt) < prev next >

Wrap

Visual Basic Form | 2001-10-07 | 40.3 KB | 1,196 lines

VERSION 5.00 Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX" Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX" Begin VB.Form frmMain Caption = "Main Screen" ClientHeight = 5715 ClientLeft = 60 ClientTop = 630 ClientWidth = 6450 HelpContextID = 20 Icon = "frmMain.frx":0000 LinkTopic = "Form1" ScaleHeight = 5715 ScaleWidth = 6450 StartUpPosition = 2 'CenterScreen Begin ComctlLib.Toolbar tlbMain Align = 1 'Align Top Height = 660 Left = 0 TabIndex = 0 Top = 0 Width = 6450 _ExtentX = 11377 _ExtentY = 1164 ButtonWidth = 1032 ButtonHeight = 1005 Appearance = 1 ImageList = "imgMain" _Version = 327682 BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7} NumButtons = 12 BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "new" Object.Tag = "" ImageIndex = 1 EndProperty BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "" Object.Tag = "" Style = 3 MixedState = -1 'True EndProperty BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "save" Object.Tag = "" ImageIndex = 3 EndProperty BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "print" Object.Tag = "" ImageIndex = 4 EndProperty BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "" Object.Tag = "" Style = 3 MixedState = -1 'True EndProperty BeginProperty Button6 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "search" Object.Tag = "" ImageIndex = 6 EndProperty BeginProperty Button7 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "delete" Object.Tag = "" ImageIndex = 7 EndProperty BeginProperty Button8 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "clear" Object.Tag = "" ImageIndex = 8 EndProperty BeginProperty Button9 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "" Object.Tag = "" Style = 3 EndProperty BeginProperty Button10 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "help" Object.Tag = "" ImageIndex = 10 EndProperty BeginProperty Button11 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "" Object.Tag = "" Style = 3 EndProperty BeginProperty Button12 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "exit" Object.Tag = "" ImageIndex = 12 EndProperty EndProperty End Begin MSComDlg.CommonDialog dlgMain Left = 5280 Top = 3600 _ExtentX = 847 _ExtentY = 847 _Version = 327680 End Begin VB.Timer tmrMain Interval = 100 Left = 5880 Top = 1680 End Begin VB.CheckBox chkMain Caption = "X-Mas" Height = 255 Left = 3960 TabIndex = 7 Top = 4920 Visible = 0 'False Width = 855 End Begin VB.Frame fraMisc Caption = "Misc" ForeColor = &H00800080& Height = 1575 Left = 240 TabIndex = 4 Top = 3600 Visible = 0 'False Width = 3495 Begin VB.TextBox txtEmail Height = 285 Left = 600 MaxLength = 30 TabIndex = 36 Top = 960 Visible = 0 'False Width = 2175 End Begin VB.TextBox txtWed Height = 285 Left = 600 MaxLength = 8 TabIndex = 35 Top = 600 Visible = 0 'False Width = 855 End Begin VB.TextBox txtBirth Height = 285 Left = 600 MaxLength = 8 TabIndex = 34 Top = 240 Visible = 0 'False Width = 855 End Begin VB.Label lblEmail AutoSize = -1 'True Caption = "Email:" Height = 195 Left = 60 TabIndex = 22 Top = 960 Visible = 0 'False Width = 420 End Begin VB.Label lblWed AutoSize = -1 'True Caption = "Wed:" Height = 195 Left = 90 TabIndex = 21 Top = 600 Visible = 0 'False Width = 390 End Begin VB.Label lblBirth AutoSize = -1 'True Caption = "Birth:" Height = 195 Left = 120 TabIndex = 20 Top = 240 Visible = 0 'False Width = 360 End End Begin VB.Frame fraStatus Caption = "Status" ForeColor = &H00008000& Height = 1095 Left = 3840 TabIndex = 5 Top = 3600 Visible = 0 'False Width = 1215 Begin VB.OptionButton optFamily Caption = "Family" Height = 255 Left = 120 TabIndex = 19 Top = 720 Visible = 0 'False Width = 855 End Begin VB.OptionButton optFriend Caption = "Friend" Height = 255 Left = 120 TabIndex = 18 Top = 360 Visible = 0 'False Width = 975 End End Begin VB.Frame fraPhone Caption = "Phone" ForeColor = &H00FF0000& Height = 2295 Left = 3600 TabIndex = 3 Top = 960 Visible = 0 'False Width = 2055 Begin VB.TextBox txtFax Height = 285 Left = 600 MaxLength = 12 TabIndex = 33 Top = 1800 Visible = 0 'False Width = 1215 End Begin VB.TextBox txtCell Height = 285 Left = 600 MaxLength = 12 TabIndex = 32 Top = 1440 Visible = 0 'False Width = 1215 End Begin VB.TextBox txtExt Height = 285 Left = 600 MaxLength = 5 TabIndex = 31 Top = 1080 Visible = 0 'False Width = 615 End Begin VB.TextBox txtWork Height = 285 Left = 600 MaxLength = 12 TabIndex = 30 Top = 720 Visible = 0 'False Width = 1215 End Begin VB.TextBox txtHome Height = 285 Left = 600 MaxLength = 12 TabIndex = 29 Top = 360 Visible = 0 'False Width = 1215 End Begin VB.Label lblFax AutoSize = -1 'True Caption = "Fax:" Height = 195 Left = 240 TabIndex = 17 Top = 1800 Visible = 0 'False Width = 300 End Begin VB.Label lblCell AutoSize = -1 'True Caption = "Cell:" Height = 195 Left = 240 TabIndex = 16 Top = 1440 Visible = 0 'False Width = 300 End Begin VB.Label lblExt AutoSize = -1 'True Caption = "Ext:" Height = 195 Left = 270 TabIndex = 15 Top = 1080 Visible = 0 'False Width = 270 End Begin VB.Label lblWork AutoSize = -1 'True Caption = "Work:" Height = 195 Left = 105 TabIndex = 14 Top = 720 Visible = 0 'False Width = 435 End Begin VB.Label lblHome AutoSize = -1 'True Caption = "Home:" Height = 195 Left = 75 TabIndex = 13 Top = 360 Visible = 0 'False Width = 465 End End Begin VB.Frame fraPerson Caption = "Person" ForeColor = &H000000C0& Height = 2535 Left = 240 TabIndex = 2 Top = 960 Visible = 0 'False Width = 3255 Begin VB.TextBox txtZip Height = 285 Left = 840 MaxLength = 10 TabIndex = 28 Top = 2040 Visible = 0 'False Width = 975 End Begin VB.TextBox txtState Height = 285 Left = 840 MaxLength = 2 TabIndex = 27 Top = 1680 Visible = 0 'False Width = 375 End Begin VB.TextBox txtCity Height = 285 Left = 840 MaxLength = 20 TabIndex = 26 Top = 1320 Visible = 0 'False Width = 1455 End Begin VB.TextBox txtAddress2 Height = 285 Left = 840 MaxLength = 30 TabIndex = 25 Top = 960 Visible = 0 'False Width = 2295 End Begin VB.TextBox txtAddress Height = 285 Left = 840 MaxLength = 30 TabIndex = 24 Top = 600 Visible = 0 'False Width = 2295 End Begin VB.TextBox txtName Height = 285 Left = 840 MaxLength = 20 TabIndex = 23 Top = 240 Visible = 0 'False Width = 1695 End Begin VB.Label lblZip AutoSize = -1 'True Caption = "Zip/Postal:" Height = 195 Left = 45 TabIndex = 12 Top = 2040 Visible = 0 'False Width = 780 End Begin VB.Label lblState AutoSize = -1 'True Caption = "State:" Height = 195 Left = 405 TabIndex = 11 Top = 1680 Visible = 0 'False Width = 420 End Begin VB.Label lblCity AutoSize = -1 'True Caption = "City:" Height = 195 Left = 525 TabIndex = 10 Top = 1320 Visible = 0 'False Width = 300 End Begin VB.Label lblAddress2 AutoSize = -1 'True Caption = "Address:" Height = 195 Left = 210 TabIndex = 9 Top = 960 Visible = 0 'False Width = 615 End Begin VB.Label lblAddress AutoSize = -1 'True Caption = "Address:" Height = 195 Left = 210 TabIndex = 8 Top = 600 Visible = 0 'False Width = 615 End Begin VB.Label lblName AutoSize = -1 'True Caption = "Name:" Height = 195 Left = 360 TabIndex = 6 Top = 240 Visible = 0 'False Width = 465 End End Begin ComctlLib.StatusBar staMain Align = 2 'Align Bottom Height = 255 Left = 0 TabIndex = 1 Top = 5460 Width = 6450 _ExtentX = 11377 _ExtentY = 450 SimpleText = "" _Version = 327682 BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} NumPanels = 3 BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} AutoSize = 2 Bevel = 0 Text = "KT Software" TextSave = "KT Software" Key = "" Object.Tag = "" EndProperty BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} Style = 6 Bevel = 0 TextSave = "10/7/01" Key = "" Object.Tag = "" EndProperty BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7} Style = 5 Bevel = 0 TextSave = "7:35 PM" Key = "" Object.Tag = "" EndProperty EndProperty End Begin VB.Label lblMain AutoSize = -1 'True Caption = "Please select a course of action by clicking a menu or a button." ForeColor = &H000000FF& Height = 195 Left = 960 TabIndex = 37 Top = 2280 Width = 4485 End Begin ComctlLib.ImageList imgMain Left = 5760 Top = 960 _ExtentX = 1005 _ExtentY = 1005 BackColor = -2147483643 ImageWidth = 32 ImageHeight = 32 MaskColor = 12632256 _Version = 327682 BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} NumListImages = 12 BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":0442 Key = "" EndProperty BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":075C Key = "" EndProperty BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":0A76 Key = "" EndProperty BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":0D90 Key = "" EndProperty BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":10AA Key = "" EndProperty BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":13C4 Key = "" EndProperty BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":16DE Key = "" EndProperty BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":19F8 Key = "" EndProperty BeginProperty ListImage9 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":1D12 Key = "" EndProperty BeginProperty ListImage10 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":202C Key = "" EndProperty BeginProperty ListImage11 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":2346 Key = "" EndProperty BeginProperty ListImage12 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":2660 Key = "" EndProperty EndProperty End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuFNew Caption = "&New" End Begin VB.Menu mnuFSave Caption = "&Save" End Begin VB.Menu mnuFPrint Caption = "&Print" End Begin VB.Menu mnuFSlash Caption = "-" End Begin VB.Menu mnuFExit Caption = "E&xit" End End Begin VB.Menu mnuEdit Caption = "&Edit" Begin VB.Menu mnuESearch Caption = "S&earch" End Begin VB.Menu mnuEDelete Caption = "&Delete" End Begin VB.Menu mnuEClear Caption = "&Clear" End End Begin VB.Menu mnuHelp Caption = "&Help" Begin VB.Menu mnuHContents Caption = "C&ontents" End Begin VB.Menu mnuHAbout Caption = "&About" End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit '****************************** ' date: 01-18-01 ' name: Keep Your Names 'purpose: To allow the user to keep names and addresses in a simple, easy ' yet efficient way. ' Program notes ' 1). In this program I have used sequential files instead of Random ' Access. The reason being is that they're much, much easier to use ' and I think that most people will keep track of no more than 100 ' people. I don't think that this will cause any problems with HD ' space. ' 2). I am using a code snippet that allows you to press the Enter/Retrun ' key to navigate the screen instead of having to use the Tab key. I ' can't believe I didn't use this in my other programs. It's one of ' those things you're sooo use to you don't think about it. ' 3). The code in the menu items and the toolbar are the same. I like to ' have the different controls point to one module. I think it makes ' for tighter code, which makes it easier to read, study and de-bug. '****************************** 'strGPanel = status panel[staMain.panels(1).text] 'strGFileName = string variable used in several routines 'strGExist = used in the FindFile routine Dim strGPanel As String, strGFileName As String, strGExist As String Private Sub Form_Load() 'This code was added by VB HelpWriter. It was the program I used to write 'the Help file. Call SetAppHelp(Me.hWnd) End Sub Private Sub Form_Unload(Cancel As Integer) 'this code was added by VB HelpWriter QuitHelp End Sub '****************************** ' name: EClear 'purpose: Clear the screen for a fresh start. '****************************** Private Sub mnuEClear_Click() Call FramesEnabled strGPanel = "(create a new entry)" Call ShowPanel Call ClearBoxes End Sub '****************************** ' name: mnuEDelete 'purpose: To delete a name from the program. '****************************** Private Sub mnuEDelete_Click() Call FramesEnabled strGPanel = "(delete a name)" Call ShowPanel Call DeleteFile End Sub '****************************** ' name: ESearch 'purpose: Lets the user find a file. '****************************** Private Sub mnuESearch_Click() strGPanel = "(search for a name)" Call ShowPanel Call LookForFile End Sub '****************************** ' name: FExit 'purpose: Allows the user to gracefully exit the program. '****************************** Private Sub mnuFExit_Click() strGPanel = "(exit the program)" Call ShowPanel Call UnLoadAllForms End Sub '****************************** ' name: FNew 'purpose: To create a new entry. '****************************** Private Sub mnuFNew_Click() Call FramesEnabled strGPanel = "(create a new entry)" Call ShowPanel Call ClearBoxes End Sub '****************************** ' name: FPrint 'purpose: Allows the user to make a hardcopy of the data on the screen. '****************************** Private Sub mnuFPrint_Click() Call FramesEnabled strGPanel = "(print the current screen)" Call ShowPanel Call PrintFile End Sub '****************************** ' name: FSave 'purpose: Allows the user to save the data on the screen to a data file (.txt). '****************************** Private Sub mnuFSave_Click() Call FramesEnabled strGPanel = "(save the current screen)" Call ShowPanel Call SaveFile End Sub '****************************** ' name: HAbout 'purpose: Show the user a simple 'About' screen. It informs the user how to ' get in touch with me concerning my programs and directions to my ' website. '****************************** Private Sub mnuHAbout_Click() frmMain.Hide frmAbout.Show End Sub Private Sub mnuHContents_Click() strGPanel = "(show the contents screen)" Call ShowPanel ShowHelpContents End Sub '****************************** ' name: tlbMain 'purpose: Allows the user an alternative way to navigate the program. ' note: The Button.Key is the word you entered in the 'key' textbox on the ' property sheet of either the imagelist or the toolbar. (Mine are ' entered on the toolbar property sheet.) '****************************** Private Sub tlbMain_ButtonClick(ByVal Button As ComctlLib.Button) Select Case Button.Key Case "new" Call FramesEnabled strGPanel = "(create a new entry)" Call ShowPanel Call ClearBoxes Case "save" Call FramesEnabled strGPanel = "(save the current screen)" Call ShowPanel Call SaveFile Case "print" Call FramesEnabled strGPanel = "(print the current screen)" Call ShowPanel Call PrintFile Case "search" strGPanel = "(search for a name)" Call ShowPanel Call LookForFile Case "delete" Call FramesEnabled strGPanel = "(delete a name)" Call ShowPanel Call DeleteFile Case "clear" Call FramesEnabled strGPanel = "(clear the screen)" Call ShowPanel Call ClearBoxes Case "help" strGPanel = "(show the contents screen)" Call ShowPanel Call ShowHelpContents Case "exit" strGPanel = "(exit the program)" Call ShowPanel Call UnLoadAllForms Case Else '"falls thru" if none of the 'Case' keywords are selected Call FramesEnabled strGPanel = "KT Software" Call ShowPanel End Select End Sub '****************************** ' name: ShowPanel 'purpose: To display, in the panel, a message for the user. I like tooltips but ' they can be annoying when you're used to using the program. This way ' you know what this item is for but it's unobtrusive. '****************************** Private Sub ShowPanel() lblMain.Visible = False 'this label is the red message you see when you first 'start the program staMain.Panels(1).Text = strGPanel End Sub '****************************** ' name: UnLoadAllForms 'purpose: To unload all of the forms at the same time, IF the user wants to ' exit the program. '****************************** Private Sub UnLoadAllForms() Dim Form As Form Dim strMsg As String, strTitle As String, strAnswer As String Dim intStyle As Integer Call FramesUnEnabled 'char$(13) - carriage return strMsg = "You have indicated you wish to exit the program." + Chr$(13) strMsg = strMsg + "Is this correct?" strTitle = "Confirm" 'vbSystemModal - the user HAS to click a button intStyle = vbQuestion + vbOKCancel + vbSystemModal strAnswer = MsgBox(strMsg, intStyle, strTitle) If strAnswer = vbOK Then For Each Form In Forms Unload Form Set Form = Nothing Next Form Else Call FramesEnabled Exit Sub 'simply returns to the state you were before you clicked 'exit' End If End Sub '****************************** ' name: FramesEnabled 'purpose: To enable ALL frames, labels and textboxes. '****************************** Private Sub FramesEnabled() fraPerson.Visible = True lblName.Visible = True: txtName.Visible = True lblAddress.Visible = True: txtAddress.Visible = True lblAddress2.Visible = True: txtAddress2.Visible = True lblCity.Visible = True: txtCity.Visible = True lblState.Visible = True: txtState.Visible = True lblZip.Visible = True: txtZip.Visible = True fraPhone.Visible = True lblHome.Visible = True: txtHome.Visible = True lblWork.Visible = True: txtWork.Visible = True lblExt.Visible = True: txtExt.Visible = True lblCell.Visible = True: txtCell.Visible = True lblFax.Visible = True: txtFax.Visible = True fraStatus.Visible = True optFriend.Visible = True: optFamily.Visible = True fraMisc.Visible = True lblBirth.Visible = True: txtBirth.Visible = True lblWed.Visible = True: txtWed.Visible = True lblemail.Visible = True: txtEmail.Visible = True chkMain.Visible = True txtName.SetFocus End Sub '****************************** ' name: FramesUnEnabled 'purpose: To DISable all frames, labels and textboxes. '****************************** Private Sub FramesUnEnabled() fraPerson.Visible = False lblName.Visible = False: txtName.Visible = False lblAddress.Visible = False: txtAddress.Visible = False lblAddress2.Visible = False: txtAddress2.Visible = False lblCity.Visible = False: txtCity.Visible = False lblState.Visible = False: txtState.Visible = False lblZip.Visible = False: txtZip.Visible = False fraPhone.Visible = False lblHome.Visible = False: txtHome.Visible = False lblWork.Visible = False: txtWork.Visible = False lblExt.Visible = False: txtExt.Visible = False lblCell.Visible = False: txtCell.Visible = False lblFax.Visible = False: txtFax.Visible = False fraStatus.Visible = False optFriend.Visible = False: optFamily.Visible = False fraMisc.Visible = False lblBirth.Visible = False: txtBirth.Visible = False lblWed.Visible = False: txtWed.Visible = False lblemail.Visible = False: txtEmail.Visible = False chkMain.Visible = False End Sub '****************************** ' name: ClearBoxes 'purpose: To clear all of the textboxes, on a form, quickly. '****************************** Private Sub ClearBoxes() Dim intCCounter As Integer For intCCounter = 0 To frmMain.Controls.Count - 1 If TypeOf frmMain.Controls(intCCounter) Is TextBox Then frmMain.Controls(intCCounter).Text = "" End If Next intCCounter txtName.SetFocus End Sub '****************************** ' name: FindFile 'purpose: To see if the file exists. ' note: I picked this little gem off the net but I can't remember where. This ' uses the Dir$ function to see if the file exists. The idea is that if ' strGFileName equals anything other than "", then it should be the file ' you're looking for. '****************************** Private Sub FindFile() If Dir(App.Path + "\" + strGFileName) <> "" Then 'the file was not found strGExist = "yes" Else strGExist = "no" End If End Sub '****************************** ' name: DeleteFile 'purpose: To allow the user to delete a name. You are actually deleteing the ' data file. '****************************** Private Sub DeleteFile() Dim strEMsg As String, strETitle As String, strEAnswer As String Dim intEStyle As Integer strGFileName = txtName.Text Call FindFile Call FramesUnEnabled If strGExist = "yes" Then 'file was found strEMsg = "Do you wish to delete: " & strGFileName + "?" strETitle = "Confirm" intEStyle = vbOKCancel + vbCritical + vbSystemModal strEAnswer = MsgBox(strEMsg, intEStyle, strETitle) If strEAnswer = vbOK Then 'user wants to delete the file Kill (App.Path + "\" + strGFileName) 'I think that you MUST give the full 'path for this to work. I kept getting 'an error (path not found) until I 'added the app.path Call FramesEnabled Call ClearBoxes Exit Sub Else 'Cancel was clicked Call FramesEnabled Exit Sub End If Else 'file doesn't exist strEMsg = "This file DOESN'T exist." strETitle = "Error" intEStyle = vbOKOnly + vbInformation + vbSystemModal strEAnswer = MsgBox(strEMsg, intEStyle, strETitle) If strEAnswer = vbOK Then Call FramesEnabled Exit Sub End If End If 'strGExist End Sub '****************************** ' name: SaveFile 'purpose: Allows the user to save the data on the screen. It will use the name ' entered in the txtName.text as the filename. ' note: FreeFile is a vbfunction that keeps track of file numbers for you. ' Using this function, you won't have to worry about conflicting file ' numbers. '****************************** Private Sub SaveFile() Dim strName As String, strAddress As String, strAddress2 As String Dim strCity As String, strState As String, strZip As String Dim strHome As String, strWork As String, strExt As String, strCell As String Dim strFax As String, strBirth As String, strWed As String Dim strEmail As String Dim intFileNumber As Integer, intFriend As Integer, intFamily As Integer Dim intCheckBox As Integer strName = txtName.Text strAddress = txtAddress.Text strAddress2 = txtAddress2.Text strCity = txtCity.Text strState = txtState.Text strZip = txtZip.Text strHome = txtHome.Text strWork = txtWork.Text strExt = txtExt.Text strCell = txtCell.Text strFax = txtFax.Text strBirth = txtBirth.Text strWed = txtWed.Text strEmail = txtEmail.Text 'option boxes If optFriend.Value = True Then 'it's checked intFriend = 1 intFamily = 0 'un-checked Else intFamily = 1 intFriend = 0 End If 'checkbox -- 0 = un-checked 1 = checked 2 = dimmed If chkMain.Value = 1 Then intCheckBox = 1 Else intCheckBox = 0 End If strGFileName = txtName.Text intFileNumber = FreeFile Open (App.Path + "\" + strGFileName) For Output As #intFileNumber Write #intFileNumber, strName, strAddress, strAddress2, strCity, strState, _ strZip, strHome, strWork, strExt, strCell, strFax, _ strBirth, strWed, strEmail, intFriend, intFamily, _ intCheckBox Close #intFileNumber End Sub '****************************** ' name: LookForFile 'purpose: To find the file, if it exists, and display the data on the screen. ' note: I used an Input box because I couldn't think of a different but classy ' way of getting the input from the user. '****************************** Private Sub LookForFile() 'input box Dim strIMsg As String, strITitle As String 'msgbox Dim strLMsg As String, strLTitle, strLAnswer As String Dim intLStyle As Integer 'file Dim strName As String, strAddress As String, strAddress2 As String Dim strCity As String, strState As String, strZip As String Dim strHome As String, strWork As String, strExt As String, strCell As String Dim strFax As String, strBirth As String, strWed As String Dim strEmail As String Dim intFileNumber As Integer, intFriend As Integer, intFamily As Integer Dim intCheckBox As Integer Call FramesUnEnabled 'Char$(13) = line feed 'this is used to lower the strIMsg string closer to the text box strIMsg = Chr$(13) + Chr$(13) + Chr$(13) + Chr$(13) + Chr$(13) strIMsg = strIMsg + "Please enter the name you wish to look for:" strITitle = "Search" strGFileName = InputBox(strIMsg, strITitle) If strGFileName = "" Then 'Cancel was clicked Call FramesEnabled Exit Sub End If Call FindFile If strGExist = "yes" Then intFileNumber = FreeFile Open (App.Path + "\" + strGFileName) For Input As #intFileNumber Do While Not EOF(intFileNumber) Input #intFileNumber, strName, strAddress, strAddress2, strCity, _ strState, strZip, strHome, strWork, strExt, _ strCell, strFax, strBirth, strWed, strEmail, _ intFriend, intFamily, intCheckBox Loop Close #intFileNumber 'display the data on the screen txtName.Text = strName txtAddress.Text = strAddress txtAddress2.Text = strAddress2 txtCity.Text = strCity txtState.Text = strState txtZip.Text = strZip txtHome.Text = strHome txtWork.Text = strWork txtExt.Text = strExt txtCell.Text = strCell txtFax.Text = strFax txtBirth.Text = strBirth txtWed.Text = strWed txtEmail.Text = strEmail 'option boxes If intFriend = 1 Then optFriend.Value = True Else optFamily.Value = True End If 'checkbox If intCheckBox = 1 Then chkMain.Value = 1 Else chkMain.Value = 0 End If Call FramesEnabled Else 'strGExist = "no" strLMsg = "This file DOESN'T exist." strLTitle = "Error" intLStyle = vbOKOnly + vbInformation + vbSystemModal strLAnswer = MsgBox(strLMsg, intLStyle, strLTitle) If strLAnswer = vbOK Then Call FramesEnabled Exit Sub End If End If 'strGExist End Sub '****************************** ' name: PrintFile 'purpose: Allows the user to make a hard copy of the current screen data. ' note: .Flags = &H40 will show the user the print setup page. This serves ' to allow the user to make adjustments, such as the number of copies ' etc, and as a silent reminder to the user to have the printer turned ' on and full of paper. '****************************** Private Sub PrintFile() On Error GoTo dlgError With dlgMain .CancelError = True 'if the user clicks 'Cancel' no error will occur .Flags = &H40 .ShowPrinter End With 'person Printer.Print 'blank line Printer.Print "Date: " & Date Printer.Print Printer.Print " Name: " & txtName.Text Printer.Print " Address: " & txtAddress.Text Printer.Print "Address2: " & txtAddress2.Text Printer.Print " City: " & txtCity.Text Printer.Print " State: " & txtState.Text Printer.Print " Zip: " & txtZip.Text 'phones Printer.Print Printer.Print " Home: " & txtHome.Text Printer.Print " Work: " & txtWork.Text Printer.Print " Ext: " & txtExt.Text Printer.Print " Cell: " & txtCell.Text Printer.Print " Fax: " & txtFax.Text 'staus Printer.Print If optFriend.Value = True Then Printer.Print " Friend" Else Printer.Print " Family" End If Printer.Print If chkMain.Value = 1 Then Printer.Print "This name is on your X-mas list" End If 'misc Printer.Print Printer.Print " Birth: " & txtBirth.Text Printer.Print " Wedding: " & txtWed.Text Printer.Print " Email: " & txtEmail.Text 'end print session Printer.EndDoc dlgError: Exit Sub End Sub '****************************** ' name: KeyPress 'purpose: The purpose of the following code is to allow the user to press the ' Return/Enter key instead of the Tab key. '****************************** Private Sub txtAddress_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtAddress2_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtBirth_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtCell_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtCity_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtEmail_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtExt_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtFax_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtHome_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtName_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtState_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtWed_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtWork_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub txtZip_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub