Programming Tool Box

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

/ Programming Tool Box / SIMS_2.iso / tool / various / ctdemo / ct_date.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-02-26 | 18.8 KB | 583 lines

VERSION 2.00 Begin Form w_ctdate_demo BackColor = &H00C0C0C0& BorderStyle = 1 'Fixed Single Caption = "ctDATE (Monthly Calendar) Demo" ClientHeight = 5550 ClientLeft = 570 ClientTop = 1335 ClientWidth = 8805 Height = 6075 Icon = CT_DATE.FRX:0000 Left = 510 LinkTopic = "Form1" MaxButton = 0 'False MDIChild = -1 'True ScaleHeight = 5550 ScaleWidth = 8805 Top = 870 Width = 8925 Begin TextBox txt_date BackColor = &H00FFFFFF& FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 315 Left = 5820 TabIndex = 18 Top = 1380 Width = 2355 End Begin ctPUSH ctPush1 BackColor = &H00C0C0C0& BevelSize = 2 ButtonHeight = 25 ButtonWidth = 33 Caption = "ctPush1" DisableColor = &H00808080& FocusBorder = 0 'False ForeColor = &H00000000& Height = 315 Left = 8160 MultiLine = 0 'None PicBevel = 1 PicExpand = 0 'False PicOnly = -1 'True PicPosition = 1 'Top Picture = CT_DATE.FRX:0302 PicXOffset = 0 PicYOffset = 0 RepeatRate = 0 RoundCorners = -1 'True State = -1 'True TabIndex = 17 TextXOffset = 0 TextYOffset = 0 Toggle = 0 'False Top = 1380 Width = 285 End Begin ctDATE ctDate1 Action = 0 BackColor = &H00C0C0C0& BorderColor = &H00808080& BorderStyle = 1 'Fixed Single BorderType = 2 'Raised CustomColor1 = &H00FFFFFF& CustomColor2 = &H00FFFFFF& CustomColor3 = &H00FFFFFF& CustomColor4 = &H00FFFFFF& CustomColor5 = &H00FFFFFF& Date = 34750 DateBorder = 1 'None Day = 20 DayFirst = 0 'Sunday DayHeader = "S,M,T,W,T,F,S" FocusColor = &H00E0FFFF& FocusType = 3 'Lowered ForeColor = &H00800000& Height = 2775 Left = 5820 LevelColor = &H00808000& LevelDepth = 2 'Header LevelOffset = 0 Month = 2 MonthNames = "January,February,March,April,May,June,July,August,September,October,November,December" TabIndex = 16 TitleAlign = 3 'Center with Buttons TitleBorder = 0 'False TitleColor = &H00000000& Top = 1680 Visible = 0 'False WeekendMark = 0 'Default Width = 2625 Year = 1995 End Begin ctGROUP ctGroup2 Alignment = 0 'Left BackColor = &H00C0C0C0& BorderColor = &H00808080& BorderType = 3 'Raised Inset Caption = "Focus Border" ForeColor = &H00000000& Height = 1575 Left = 3840 TabIndex = 13 TextPosition = 0 'Top Top = 3180 Width = 1635 Begin ctRADIO ctlw Alignment = 0 'Left Justify BackColor = &H00C0C0C0& Caption = "Lowered" DisableColor = &H00808080& ForeColor = &H00000000& Height = 255 Left = 180 PicStyle = 1 'Style #1 ShowFocus = -1 'True TabIndex = 22 Top = 1200 Value = 0 'False Width = 1005 End Begin ctRADIO ctraise Alignment = 0 'Left Justify BackColor = &H00C0C0C0& Caption = "Raised" DisableColor = &H00808080& ForeColor = &H00000000& Height = 255 Left = 180 PicStyle = 1 'Style #1 ShowFocus = -1 'True TabIndex = 21 Top = 900 Value = 0 'False Width = 1185 End Begin ctRADIO ctRadio2 Alignment = 0 'Left Justify BackColor = &H00C0C0C0& Caption = "Flat" DisableColor = &H00808080& ForeColor = &H00000000& Height = 255 Left = 180 PicStyle = 1 'Style #1 ShowFocus = -1 'True TabIndex = 15 Top = 600 Value = 0 'False Width = 1275 End Begin ctRADIO ctRadio1 Alignment = 0 'Left Justify BackColor = &H00C0C0C0& Caption = "Regular" DisableColor = &H00808080& ForeColor = &H00000000& Height = 255 Left = 180 PicStyle = 1 'Style #1 ShowFocus = -1 'True TabIndex = 14 Top = 300 Value = -1 'True Width = 1275 End End Begin ctGROUP ctGroup1 Alignment = 0 'Left BackColor = &H00C0C0C0& BorderColor = &H00808080& BorderType = 3 'Raised Inset Caption = "Date Border" ForeColor = &H00000000& Height = 1575 Left = 3840 TabIndex = 8 TextPosition = 0 'Top Top = 1500 Width = 1635 Begin ctRADIO ctRadio4 Alignment = 0 'Left Justify BackColor = &H00C0C0C0& Caption = "Lowered" DisableColor = &H00808080& ForeColor = &H00000000& Height = 255 Left = 180 PicStyle = 1 'Style #1 ShowFocus = -1 'True TabIndex = 12 Top = 1200 Value = -1 'True Width = 1245 End Begin ctRADIO ctRadio3 Alignment = 0 'Left Justify BackColor = &H00C0C0C0& Caption = "Raised" DisableColor = &H00808080& ForeColor = &H00000000& Height = 255 Left = 180 PicStyle = 1 'Style #1 ShowFocus = -1 'True TabIndex = 11 Top = 900 Value = 0 'False Width = 1065 End Begin ctRADIO rb_none Alignment = 0 'Left Justify BackColor = &H00C0C0C0& Caption = "None" DisableColor = &H00808080& ForeColor = &H00000000& Height = 255 Left = 180 PicStyle = 1 'Style #1 ShowFocus = -1 'True TabIndex = 10 Top = 600 Value = 0 'False Width = 1095 End Begin ctRADIO rb_regular Alignment = 0 'Left Justify BackColor = &H00C0C0C0& Caption = "Regular" DisableColor = &H00808080& ForeColor = &H00000000& Height = 255 Left = 180 PicStyle = 1 'Style #1 ShowFocus = -1 'True TabIndex = 9 Top = 300 Value = 0 'False Width = 1215 End End Begin CommandButton Command2 Caption = "Today" Height = 375 Left = 1440 TabIndex = 5 Top = 4980 Width = 945 End Begin ctDATA date_next AmountButtons = 1 'Three Buttons ArrowColor = &H00000000& ArrowSize = 1 'Large BevelSize = 2 BorderColor = &H00000000& DisableCenter = 0 'False DisableLeft = 0 'False DisableRight = 0 'False Height = 375 Left = 2370 RepeatCenter = -1 'True RepeatLeft = -1 'True RepeatRate = 5 RepeatRight = -1 'True SkipValue = 1 Style = 1 'Next Records TabIndex = 4 Top = 4980 Width = 1095 End Begin ctDATA date_prev AmountButtons = 1 'Three Buttons ArrowColor = &H00000000& ArrowSize = 1 'Large BevelSize = 2 BorderColor = &H00000000& DisableCenter = 0 'False DisableLeft = 0 'False DisableRight = 0 'False Height = 375 Left = 360 RepeatCenter = -1 'True RepeatLeft = -1 'True RepeatRate = 5 RepeatRight = -1 'True SkipValue = 1 Style = 0 'Previous Records TabIndex = 3 Top = 4980 Width = 1095 End Begin CommandButton Command1 Caption = "Exit" Height = 375 Left = 4320 TabIndex = 1 Top = 5040 Width = 795 End Begin ctDATE ctDate Action = 0 BackColor = &H00C0C0C0& BorderColor = &H00808080& BorderStyle = 1 'Fixed Single BorderType = 2 'Raised CustomColor1 = &H00FFFF00& CustomColor2 = &H0000FF00& CustomColor3 = &H0000FFFF& CustomColor4 = &H00FF00FF& CustomColor5 = &H00FFFFFF& Date = 34667 DateBorder = 3 'Lowered Day = 29 DayFirst = 0 'Sunday DayHeader = "S,M,T,W,T,F,S" FocusColor = &H000000FF& FocusType = 0 'Regular ForeColor = &H00000000& Height = 3315 Left = 360 LevelColor = &H00808080& LevelDepth = 0 'None LevelOffset = 0 Month = 11 MonthNames = "January,February,March,April,May,June,July,August,September,October,November,December" TabIndex = 0 TitleAlign = 2 'Center TitleBorder = -1 'True TitleColor = &H00800000& Top = 1440 WeekendMark = 1 'Custom Color #1 Width = 3135 Year = 1994 End Begin Label lbl_move Alignment = 2 'Center BackColor = &H00C0C0C0& Caption = "Click on the arrows beside the title to move to a different month." FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00800000& Height = 675 Left = 6090 TabIndex = 20 Top = 4500 Visible = 0 'False Width = 2145 End Begin Label Label3 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "The example above uses a label control, picture push button, and a calendar control to simulate a drop down calendar box. Press the button to view the calendar" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00800000& Height = 2175 Left = 6060 TabIndex = 19 Top = 2100 Width = 2205 End Begin Label sle_date BackColor = &H00FFFFFF& BorderStyle = 1 'Fixed Single FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 315 Left = 1800 TabIndex = 7 Top = 1080 Width = 2475 End Begin Label Label2 BackColor = &H00C0C0C0& Caption = "Date Selected :" FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 315 Left = 360 TabIndex = 6 Top = 1080 Width = 1455 End Begin Label Label1 Alignment = 2 'Center BackColor = &H00C0C0C0& Caption = "ctDATE VBX Is a Calendar Control that allows you to display and select dates in a visual format. The calendar works from 1900 on. Up to five different custom colors can be used to mark the dates. Differnt months or years can be viewed either through an Action attribute of the control, or by using internal controls." ForeColor = &H00800000& Height = 795 Left = 270 TabIndex = 2 Top = 120 Width = 8235 End Sub Command1_Click () Unload w_ctdate_demo End Sub Sub Command2_Click () ctDate.Action = 7 End Sub Sub ctDate_DateChange (nDow As Integer, nDay As Integer, nMonth As Integer, nYear As Integer) Dim MonthName As String If (nMonth = 1) Then ctDate.MarkDate(1) = 2 ElseIf (nMonth = 2) Then ctDate.MarkDate(14) = 4 ElseIf (nMonth = 4) Then ctDate.MarkDate(14) = 2 ElseIf (nMonth = 5) Then ctDate.MarkDate(22) = 2 ElseIf (nMonth = 7) Then ctDate.MarkDate(1) = 2 ctDate.MarkDate(4) = 2 ElseIf (nMonth = 9) Then ctDate.MarkDate(9) = 2 ElseIf (nMonth = 10) Then ctDate.MarkDate(4) = 2 ElseIf (nMonth = 11) Then ctDate.MarkDate(11) = 2 ElseIf (nMonth = 12) Then ctDate.MarkDate(24) = 3 ctDate.MarkDate(25) = 2 ctDate.MarkDate(26) = 3 End If If (nMonth = 1) Then MonthName = "Jan." ElseIf (nMonth = 2) Then MonthName = "Feb." ElseIf (nMonth = 3) Then MonthName = "Mar." ElseIf (nMonth = 4) Then MonthName = "Apr." ElseIf (nMonth = 5) Then MonthName = "May" ElseIf (nMonth = 6) Then MonthName = "June" ElseIf (nMonth = 7) Then MonthName = "July" ElseIf (nMonth = 8) Then MonthName = "Aug." ElseIf (nMonth = 9) Then MonthName = "Sep." ElseIf (nMonth = 10) Then MonthName = "Oct." ElseIf (nMonth = 11) Then MonthName = "Nov." ElseIf (nMonth = 12) Then MonthName = "Dec." MonthName = "???" End If MonthName = MonthName + " " + Str$(nDay) + " / " + Str$(nYear) If (nDow = 1) Then sle_date.Caption = "Sunday " + MonthName ElseIf (nDow = 2) Then sle_date.Caption = "Monday " + MonthName ElseIf (nDow = 3) Then sle_date.Caption = "Tuesday " + MonthName ElseIf (nDow = 4) Then sle_date.Caption = "Wednesday " + MonthName ElseIf (nDow = 5) Then sle_date.Caption = "Thursday " + MonthName ElseIf (nDow = 6) Then sle_date.Caption = "Friday " + MonthName ElseIf (nDow = 7) Then sle_date.Caption = "Saturday " + MonthName End If End Sub Sub ctDate1_DateChange (nDow As Integer, nDay As Integer, nMonth As Integer, nYear As Integer) Dim MonthName As String If (nMonth = 1) Then MonthName = "January" ElseIf (nMonth = 2) Then MonthName = "February" ElseIf (nMonth = 3) Then MonthName = "March" ElseIf (nMonth = 4) Then MonthName = "April" ElseIf (nMonth = 5) Then MonthName = "May" ElseIf (nMonth = 6) Then MonthName = "June" ElseIf (nMonth = 7) Then MonthName = "July" ElseIf (nMonth = 8) Then MonthName = "August" ElseIf (nMonth = 9) Then MonthName = "September" ElseIf (nMonth = 10) Then MonthName = "October" ElseIf (nMonth = 11) Then MonthName = "November" ElseIf (nMonth = 12) Then MonthName = "December" Else MonthName = "???" End If MonthName = MonthName + " " + Str$(nDay) + " / " + Str$(nYear) txt_date.Text = MonthName End Sub Sub ctDate1_LostFocus () lbl_move.Visible = False ctDate1.Visible = False End Sub Sub ctlw_Click () ctDate.FocusType = 3 End Sub Sub ctPush1_Click () lbl_move.Visible = True ctDate1.Visible = True ctDate1.SetFocus End Sub Sub ctRadio1_Click () ctDate.FocusType = 0 End Sub Sub ctRadio2_Click () ctDate.FocusType = 1 End Sub Sub ctRadio3_Click () ctDate.DateBorder = 2 End Sub Sub ctRadio4_Click () ctDate.DateBorder = 3 End Sub Sub ctraise_Click () ctDate.FocusType = 2 End Sub Sub date_next_ClickCenter () ctDate.Action = 2 End Sub Sub date_next_ClickLeft () ctDate.Action = 1 End Sub Sub date_next_ClickRight () ctDate.Action = 3 End Sub Sub date_prev_ClickCenter () ctDate.Action = 5 End Sub Sub date_prev_ClickLeft () ctDate.Action = 6 End Sub Sub date_prev_ClickRight () ctDate.Action = 4 End Sub Sub Form_Load () ' Center the window on the screen Move (Screen.Width - Width) / 2, (Screen.Height - Height) * .15 w_mdi_main.bt_date = BUTTON_DISABLE ctDate.Action = 7 ctDate1.Action = 7 End Sub Sub Form_Unload (Cancel As Integer) w_mdi_main.bt_date = BUTTON_UP End Sub Sub rb_none_Click () ctDate.DateBorder = 1 End Sub Sub rb_regular_Click () ctDate.DateBorder = 0 End Sub