home *** CD-ROM | disk | FTP | other *** search
VERSION 2.00 Begin Form intro BackColor = &H00808080& Caption = "FarPoint Technologies Appointment Book" ClientHeight = 6105 ClientLeft = 480 ClientTop = 750 ClientWidth = 8430 Height = 6795 Icon = INTRO.FRX:0000 Left = 420 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 6105 ScaleWidth = 8430 Top = 120 Width = 8550 Begin Data Data2 Caption = "Data2" Connect = "" DatabaseName = "" Exclusive = 0 'False Height = 270 Left = 1800 Options = 0 ReadOnly = 0 'False RecordSource = "" Top = 6210 Width = 1140 End Begin AwareBinary fpBinary3 BackColor = &H00C0C0C0& BorderGrayAreaColor= &H00C0C0C0& BorderStyle = 0 'No Border FontBold = -1 'True FontItalic = 0 'False FontName = "System" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 975 Left = 0 TabIndex = 9 ThreeDFrameWidth= 5 ThreeDInsideHighlightColor= &H00FFFFFF& ThreeDInsideShadowColor= &H00808080& ThreeDInsideStyle= 2 'Raised ThreeDInsideWidth= 2 ThreeDOutsideHighlightColor= &H00FFFFFF& ThreeDOutsideShadowColor= &H00808080& ThreeDOutsideStyle= 2 'Raised Top = 5175 Width = 8415 Begin AwareBoolean fpBoolean8 BackColor = &H00C0C0C0& BooleanMode = 2 'Button-Like BooleanPicture = 4 'User Defined BorderStyle = 2 'Rounded BorderWidth = 1 FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00FF0000& Height = 645 Left = 240 PictureFalse = INTRO.FRX:0302 PictureFalseDisabled= INTRO.FRX:0604 TabIndex = 13 TextFalse = "About" ThreeDOutsideStyle= 2 'Raised ThreeDOutsideWidth= 3 ThreeDText = 2 'Embossed w/ shading Top = 50 Width = 1650 End Begin AwareBoolean fpBoolean7 BackColor = &H00C0C0C0& BooleanMode = 2 'Button-Like BooleanPicture = 4 'User Defined BorderStyle = 2 'Rounded BorderWidth = 1 FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00FF0000& Height = 645 Left = 2145 PictureFalse = INTRO.FRX:0906 PictureFalseDisabled= INTRO.FRX:0B40 TabIndex = 12 TextFalse = "Customize" ThreeDOutsideStyle= 2 'Raised ThreeDOutsideWidth= 3 ThreeDText = 2 'Embossed w/ shading Top = 50 Width = 1860 End Begin AwareBoolean fpBoolean6 BackColor = &H00C0C0C0& BooleanMode = 2 'Button-Like BooleanPicture = 4 'User Defined BorderStyle = 2 'Rounded BorderWidth = 1 FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00FF0000& Height = 645 Left = 4320 PictureFalse = INTRO.FRX:0D7A PictureFalseDisabled= INTRO.FRX:107C TabIndex = 11 TextFalse = "Help!" ThreeDOutsideStyle= 2 'Raised ThreeDOutsideWidth= 3 ThreeDText = 2 'Embossed w/ shading Top = 50 Width = 1650 End Begin AwareBoolean fpBoolean4 BackColor = &H00C0C0C0& BooleanMode = 2 'Button-Like BooleanPicture = 4 'User Defined BorderStyle = 2 'Rounded BorderWidth = 1 FontBold = -1 'True FontItalic = 0 'False FontName = "Times New Roman" FontSize = 12 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00FF0000& Height = 645 Left = 6240 PictureFalse = INTRO.FRX:137E PictureFalseDisabled= INTRO.FRX:1680 PictureTrue = INTRO.FRX:1982 TabIndex = 10 TextFalse = "Exit" ThreeDOutsideStyle= 2 'Raised ThreeDOutsideWidth= 3 ThreeDText = 2 'Embossed w/ shading Top = 50 Width = 1650 End End Begin AwareBinary Imprint2 BackColor = &H00C0C0C0& BorderGrayAreaColor= &H00C0C0C0& BorderStyle = 0 'No Border FontBold = -1 'True FontItalic = 0 'False FontName = "System" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 5175 Left = 0 TabIndex = 0 ThreeDFrameWidth= 5 ThreeDInsideHighlightColor= &H00FFFFFF& ThreeDInsideShadowColor= &H00808080& ThreeDInsideStyle= 2 'Raised ThreeDInsideWidth= 2 ThreeDOutsideHighlightColor= &H00FFFFFF& ThreeDOutsideShadowColor= &H00808080& ThreeDOutsideStyle= 2 'Raised Top = 0 Width = 8415 Begin Data Data3 Caption = "Data3" Connect = "" DatabaseName = "" Exclusive = 0 'False Height = 315 Left = 4800 Options = 0 ReadOnly = 0 'False RecordSource = "" Top = 75 Visible = 0 'False Width = 1140 End Begin AwareText whoscal AlignTextH = 1 'Center AlignTextV = 1 'Center BackColor = &H00C0C0C0& BorderStyle = 0 'No Border FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H000000FF& Height = 315 Left = 675 TabIndex = 14 Text = "whoscal" ThreeDOutsideStyle= 1 'Lowered ThreeDText = 2 'Embossed w/ shading ThreeDTextHighlightColor= &H00FFFFFF& ThreeDTextShadowColor= &H00000010& Top = 75 Width = 4065 End Begin Data Data1 Caption = "Data1" Connect = "" DatabaseName = "" Exclusive = 0 'False Height = 270 Left = 5580 Options = 0 ReadOnly = 0 'False RecordSource = "" Top = 4830 Visible = 0 'False Width = 1455 End Begin AwareBinary fpBinary2 BackColor = &H00C0C0C0& FontBold = -1 'True FontItalic = 0 'False FontName = "System" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 2895 Left = 5400 TabIndex = 4 ThreeDInsideWidth= 3 ThreeDOutsideStyle= 2 'Raised ThreeDOutsideWidth= 2 Top = 1920 Width = 2625 Begin AwareBoolean fpBoolean5 AlignTextH = 1 'Center BackColor = &H00C0C0C0& BooleanMode = 2 'Button-Like BooleanPicture = 4 'User Defined BorderColor = &H00000000& BorderStyle = 2 'Rounded BorderWidth = 1 FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H000000FF& Height = 600 Left = 50 PictureFalse = INTRO.FRX:1C84 PictureFalseDisabled= INTRO.FRX:1F86 TabIndex = 8 TextFalse = "Set Alarm" ThreeDInsideHighlightColor= &H00FFFFFF& ThreeDInsideShadowColor= &H00808080& ThreeDInsideWidth= 0 ThreeDOutsideShadowColor= &H00808080& ThreeDOutsideStyle= 2 'Raised ThreeDOutsideWidth= 3 ThreeDTextShadowColor= &H00808080& Top = 2150 Width = 2430 End Begin AwareBoolean fpBoolean3 AlignTextH = 1 'Center BackColor = &H00C0C0C0& BooleanMode = 2 'Button-Like BooleanPicture = 4 'User Defined BorderStyle = 2 'Rounded BorderWidth = 1 FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H000000FF& Height = 600 Left = 50 MultiLine = -1 'True PictureFalse = INTRO.FRX:2288 PictureFalseDisabled= INTRO.FRX:258A TabIndex = 7 TextFalse = "Review Today's Schedule" ThreeDInsideHighlightColor= &H00FFFFFF& ThreeDInsideShadowColor= &H00808080& ThreeDInsideWidth= 0 ThreeDOutsideStyle= 2 'Raised ThreeDOutsideWidth= 3 Top = 1450 Width = 2430 End Begin AwareBoolean fpBoolean1 AlignTextH = 1 'Center BackColor = &H00C0C0C0& BooleanMode = 2 'Button-Like BooleanPicture = 4 'User Defined BorderColor = &H00000000& BorderStyle = 2 'Rounded BorderWidth = 1 DropShadowColor = &H00C0C0C0& FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H000000FF& Height = 600 Left = 50 MultiLine = -1 'True PictureFalse = INTRO.FRX:288C PictureFalseDisabled= INTRO.FRX:2B8E PictureTrue = INTRO.FRX:2E90 TabIndex = 6 TextFalse = "Add an Appointment" ThreeDInsideHighlightColor= &H00FFFFFF& ThreeDInsideShadowColor= &H00808080& ThreeDInsideWidth= 0 ThreeDOutsideShadowColor= &H00808080& ThreeDOutsideStyle= 2 'Raised ThreeDOutsideWidth= 3 ThreeDTextHighlightColor= &H00C0C0C0& Top = 45 Width = 2445 End Begin AwareBoolean fpBoolean2 AlignTextH = 1 'Center BackColor = &H00C0C0C0& BooleanMode = 2 'Button-Like BooleanPicture = 4 'User Defined BorderStyle = 2 'Rounded BorderWidth = 1 FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H000000FF& Height = 600 Left = 50 MultiLine = -1 'True PictureFalse = INTRO.FRX:3192 PictureFalseDisabled= INTRO.FRX:3494 TabIndex = 5 TextFalse = "Delete Day's Appointments" ThreeDInsideHighlightColor= &H00FFFFFF& ThreeDInsideShadowColor= &H00808080& ThreeDInsideWidth= 0 ThreeDOutsideStyle= 2 'Raised ThreeDOutsideWidth= 3 Top = 720 Width = 2430 End End Begin AwareBinary fpBinary1 BackColor = &H00C0C0C0& FontBold = -1 'True FontItalic = 0 'False FontName = "System" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 1695 Left = 5880 TabIndex = 2 ThreeDFrameWidth= 1 ThreeDInsideStyle= 2 'Raised ThreeDOutsideStyle= 2 'Raised ThreeDOutsideWidth= 5 Top = 120 Width = 1935 Begin AwareClock fpClock1 AlarmTime = "1193:02:47.29" AllowMoveHand = 2 'Right Button AnalogHourFillColor= &H000000FF& BackColor = &H0080FFFF& ClockStyle = 2 'Analog CurrentTime = "00:00:00.00" FontBold = -1 'True FontItalic = 0 'False FontName = "Times New Roman" FontSize = 13.5 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00FFFFFF& Height = 1470 Interval = "00:00:01.00" Left = 0 TabIndex = 3 ThreeDFrameWidth= 2 ThreeDInsideStyle= 1 'Lowered ThreeDInsideWidth= 3 ThreeDOutsideStyle= 2 'Raised ThreeDOutsideWidth= 3 TimeString1159 = "" TimeString2359 = "" Top = 0 Width = 1695 End End Begin AwareCalendar cal1 BorderGrayAreaColor= &H00C0C0C0& BorderStyle = 2 'Rounded CurrentDate = "19940303" DropShadowWidth = 5 Element3DShadowWidth= 1 FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False GrayAreaBackColor= &H00C0C0C0& GrayAreaForeColor= &H00FFFFFF& Height = 4395 Left = 75 TabIndex = 1 ThreeDFrameWidth= 1 ThreeDInsideShadowColor= &H00808080& ThreeDInsideStyle= 2 'Raised ThreeDInsideWidth= 3 ThreeDOutsideStyle= 2 'Raised ThreeDOutsideWidth= 3 Top = 450 Width = 5175 End End Begin Menu menu_mnu Caption = "&File" Begin Menu Run_Mnu Caption = "&Minimize" End Begin Menu Quit_Mnu Caption = "&End" End End Begin Menu cal_mnu Caption = "&Calendar" Begin Menu choose_mnu Caption = "&Choose Person" End Begin Menu add_Mnu Caption = "&Add Person" End Begin Menu del_mnu Caption = "&Delete Person" End End End Sub add_Mnu_Click () person.cancelbt.Visible = True person.addbt.Visible = True person.OKbt.Visible = False person.deletebt.Visible = False person.descbox.Visible = True person.namebox.Visible = True person.fpText3(0).Visible = True person.fpText3(1).Visible = True person.fpText3(2).Visible = True person.password.Visible = True person.fpComboBox1.Visible = False person.fpText1.Text = "Enter a name and brief description below to add a new person to the list:" person.Show End Sub Sub cal1_Change (oldmonth As Integer, OldDay As Integer, oldyear As Integer, newmonth As Integer, NewDay As Integer, newyear As Integer, cancel As Integer) 'Sets the current day that has been selected for 'the database selection. SelectDay = NewDay SelectMonth = newmonth SelectYear = newyear DaySelected = True DbDate = cal1.CurrentDate SDate = "Date = " + "'" + DbDate + "'" 'If a change has been made then update the calendar If (oldmonth <> newmonth Or oldyear <> newyear) Then UpdateCal End If End Sub Sub choose_mnu_Click () person.OKbt.Visible = True person.cancelbt.Visible = True person.addbt.Visible = False person.deletebt.Visible = False person.descbox.Visible = False person.namebox.Visible = False person.fpText3(0).Visible = False person.fpText3(1).Visible = False person.fpText3(2).Visible = False person.password.Visible = False person.fpComboBox1.Visible = True person.Show End Sub Sub del_mnu_Click () person.cancelbt.Visible = True person.deletebt.Visible = True person.OKbt.Visible = False person.addbt.Visible = False person.descbox.Visible = False person.namebox.Visible = False person.fpText3(0).Visible = False person.fpText3(1).Visible = False person.fpText3(2).Visible = False person.password.Visible = False person.fpComboBox1.Visible = True person.fpText1.Text = "Choose a person and press the button to remove the person..." person.Show End Sub Sub Form_Activate () screen.MousePointer = 11 whoscal.Text = selectedname + "'s Calendar" Data1.RecordSource = "Select * From Custom Where Name = " + "'" + selectedname + "'" Data1.Refresh 'Update the calendar with new appointment days UpdateCal 'Initialize both calendars with the information that has 'previously been saved in the database. Refresh InitCal Intro.cal1, Data1 InitCal Custom.CustCal, Data1 screen.MousePointer = 0 End Sub Sub Form_Load () Reviewing = False selectedname = "default" centerform Me Refresh 'Initialize database Data1.DatabaseName = App.Path + "\calendar.mdb" Data1.Connect = "" Data1.RecordSource = "Select * From Custom Where Name = " + "'" + selectedname + "'" Data1.Refresh data2.Connect = "" data2.DatabaseName = App.Path & "\appoint.mdb" data2.RecordSource = "appoint" DaySelected = False MonName$(1) = "Jan." MonName$(2) = "Feb." MonName$(3) = "March" MonName$(4) = "April" MonName$(5) = "May" MonName$(6) = "June" MonName$(7) = "July" MonName$(8) = "Aug." MonName$(9) = "Sept." MonName$(10) = "Oct." MonName$(11) = "Nov." MonName$(12) = "Dec." cal1.CurrentDate = Str(Now) 'Load all icons fpBoolean1.PictureFalse = LoadPicture(App.Path + "\book01a.ico") fpBoolean2.PictureFalse = LoadPicture(App.Path + "\erase02.ico") fpBoolean3.PictureFalse = LoadPicture(App.Path + "\book03.ico") fpBoolean5.PictureFalse = LoadPicture(App.Path + "\clock03.ico") fpBoolean8.PictureFalse = LoadPicture(App.Path + "\note04.ico") fpBoolean7.PictureFalse = LoadPicture(App.Path + "\calup.bmp") fpBoolean6.PictureFalse = LoadPicture(App.Path + "\misc02.ico") fpBoolean4.PictureFalse = LoadPicture(App.Path + "\exit01.ico") End Sub Sub fpBoolean1_Click (Button As Integer) If Data1.Recordset("name") = "default" Then MsgBox "Appointments can not be added on the default Calendar. Please choose a person from the Calendar menu!" Exit Sub End If 'Initialize which text and buttons are to be displayed 'in the Schedule form. Schedule.Caption = "Add an Appointment on " + MonName(SelectMonth) + Str(SelectDay) + "," + Str(SelectYear) Schedule.fpText2.Text = "Enter your appointment beside the desired time and press OK to save these entries :" Schedule.ok.Visible = True Schedule.cancel.Visible = True Schedule.del.Visible = False Schedule.Show End Sub Sub fpBoolean2_Click (Button As Integer) If Data1.Recordset("name") = "default" Then MsgBox "Appointments can not be added on the default Calendar. Please choose a person from the Calendar menu!" Exit Sub End If 'Initialize which text and buttons are to be displayed 'in the Schedule form. Schedule.Caption = "Delete an Appointment on " + MonName(SelectMonth) + Str(SelectDay) + "," + Str(SelectYear) Schedule.del.Visible = True Schedule.ok.Visible = False Schedule.cancel.Visible = True Schedule.fpText2.Text = "Highlight the appointment that you wish to remove and press DELETE :" Schedule.Show End Sub Sub fpBoolean3_Click (Button As Integer) If Data1.Recordset("name") = "default" Then MsgBox "Appointments can not be reviewed on the default Calendar. Please choose a person from the Calendar menu!" Exit Sub End If Data3.Connect = "" Data3.DatabaseName = App.Path + "\APPOINT.MDB" Data3.RecordSource = "Select * from Appoint Where " & SDate & " And Name = " & "'" & selectedname & "'" Data3.Refresh If Data3.Recordset.RecordCount = 0 Then Beep MsgBox "There are No Appointments on this Day", 64 Exit Sub End If 'Initialize which text and buttons are to be displayed 'in the Schedule form. Intro.fpBoolean3.Value = 0 Schedule.cancel.Visible = False Schedule.del.Visible = False Schedule.ok.Visible = True Schedule.Caption = "Review Appointments for " + MonName(SelectMonth) + Str(SelectDay) + "," + Str(SelectYear) Schedule.fpText2.Text = "" Reviewing = True Schedule.Show End Sub Sub fpBoolean4_Click (Button As Integer) End End Sub Sub fpBoolean5_Click (Button As Integer) 'Load and show the Alarm form alarm.Show End Sub Sub fpBoolean6_Click (Button As Integer) help.Show End Sub Sub fpBoolean7_Click (Button As Integer) If Data1.Recordset("name") = "default" Then MsgBox "Appointments can not be added on the default Calendar. Please choose a person from the Calendar menu!" Exit Sub End If Custom.Show Me.Hide End Sub Sub fpBoolean8_Click (Button As Integer) about.Show Me.Hide End Sub Sub fpClock1_Alarm () 'Allows the program to use the windows sound to play 'an alarm sound when activated. This is an alternate 'way to play a sound, instead of the BEEP command. t = OpenSound() duration% = 500 frequency& = 400 frequency& = frequency& * 65536 t = SetVoiceSound(1, frequency&, duration%) t = startsound() While (WaitSoundState(0) <> 0): Wend t = CloseSound() 'Displays a message box reminding the user why the alarm was set. MsgBox alarm.message.Text, 0, "Please Remember :" End Sub Sub Quit_Mnu_Click () End End Sub Sub Run_Mnu_Click () 'Minimize window Intro.WindowState = 1 End Sub Sub UpdateCal () Dim Sql, fdate, GetDate As String Dim i As Integer 'Colors the Appointment days when a change is made 'Search for all appointment days for the selected month cal1.Redraw = False GetDate = cal1.CurrentDate fdate = "'" + Mid(GetDate, 1, 6) + "##'" Sql = "Select * from Appoint Where Date like " & fdate & " And Name = " & "'" & selectedname & "'" data2.RecordSource = Sql data2.Refresh 'Initializes all days to the default background and foreground colors cal1.Element = 6 For i = 1 To 31 cal1.ElementIndex = i cal1.ElementForeColor = &H0 cal1.ElementBackColor = &HC0C0C0 Next 'Reads and colors all days that has an appointment While Not data2.Recordset.EOF cal1.ElementIndex = CInt(Mid$(data2.Recordset.Fields("Date").Value, 7, 2)) cal1.ElementBackColor = Data1.Recordset("Appbackcolor") cal1.ElementForeColor = Data1.Recordset("Appforecolor") data2.Recordset.MoveNext Wend cal1.Redraw = True End Sub 
