form1.frm

vb编写的中国日梭万年历,可查询年1583-99999年

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form Form1 
   Caption         =   "中国日梭万年历"
   ClientHeight    =   6105
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7365
   LinkTopic       =   "Form2"
   ScaleHeight     =   6105
   ScaleWidth      =   7365
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text1 
      Height          =   2145
      Left            =   0
      MultiLine       =   -1  'True
      TabIndex        =   10
      Top             =   3930
      Width           =   7335
   End
   Begin VB.Frame Frame1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   42
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3885
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   7365
      Begin VB.Frame Frame10 
         Height          =   495
         Left            =   1560
         TabIndex        =   1
         Top             =   -90
         Width           =   4215
         Begin MSComCtl2.UpDown UpDown1 
            Height          =   300
            Left            =   1875
            TabIndex        =   9
            Top             =   150
            Width           =   255
            _ExtentX        =   450
            _ExtentY        =   529
            _Version        =   393216
            Value           =   1583
            BuddyControl    =   "Text_year"
            BuddyDispid     =   196612
            OrigLeft        =   1830
            OrigTop         =   120
            OrigRight       =   2085
            OrigBottom      =   465
            Max             =   99999
            Min             =   1583
            SyncBuddy       =   -1  'True
            BuddyProperty   =   65547
            Enabled         =   -1  'True
         End
         Begin VB.TextBox Text_year 
            Height          =   300
            Left            =   1350
            TabIndex        =   4
            Top             =   150
            Width           =   555
         End
         Begin VB.ComboBox Combo_month 
            Height          =   300
            ItemData        =   "Form1.frx":0000
            Left            =   2400
            List            =   "Form1.frx":0028
            TabIndex        =   3
            Top             =   150
            Width           =   705
         End
         Begin VB.CommandButton current_date 
            Caption         =   "今天"
            Height          =   300
            Left            =   3480
            TabIndex        =   2
            Top             =   150
            Width           =   675
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            Caption         =   "月"
            Height          =   180
            Left            =   3120
            TabIndex        =   7
            Top             =   210
            Width           =   180
         End
         Begin VB.Label Label17 
            AutoSize        =   -1  'True
            Caption         =   "年"
            Height          =   180
            Left            =   2160
            TabIndex        =   6
            Top             =   210
            Width           =   180
         End
         Begin VB.Label Label18 
            AutoSize        =   -1  'True
            Caption         =   "中国日历：公历"
            Height          =   180
            Left            =   60
            TabIndex        =   5
            Top             =   210
            Width           =   1260
         End
      End
      Begin VB.Label calendar 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0FFFF&
         Height          =   180
         Left            =   450
         TabIndex        =   8
         Top             =   480
         Width           =   90
      End
      Begin VB.Shape Shape_day 
         BorderColor     =   &H000000FF&
         BorderWidth     =   2
         FillColor       =   &H00FFFFFF&
         Height          =   350
         Left            =   1200
         Shape           =   2  'Oval
         Top             =   1800
         Width           =   840
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Combo_month_Click()
   Combo_month_Change
End Sub

Private Sub Combo_month_Change()
   Dim amon() As String
   If Val(Combo_month) < 1 Then Combo_month = "01"
   If Val(Combo_month) > 12 Then Combo_month = "12"
   If Len(Combo_month) > 2 Then Combo_month = Right(Combo_month, 2)
   On Error Resume Next
   With calendar
    .Caption = PrintMonth(Text_year, Combo_month, amon)
    .Left = (Frame1.Width - .Width) / 2
    .Top = (Frame1.Height - .Height) / 2 + Me.TextHeight("") * Frame1.FontSize / Me.FontSize * 3 / 16 + Frame1.Top
    .Alignment = 2
    Call current_day
   End With
   Text1 = Mid(Join(amon, vbCrLf), 3)
End Sub

Private Sub current_date_click()
     Text_year = year(Date): Combo_month = Right("00" & month(Date), 2) ' current_day
End Sub
Private Sub current_day()
   On Error Resume Next
   With calendar
    Shape_day.Visible = False
    If Text_year = year(Date) And Val(Combo_month) = month(Date) Then
       amon = Split(.Caption, vbCr): Shape_day.Width = .Width / 7
       ml = UBound(amon): Shape_day.Height = .Height / (ml + 1) * 2
       For i = 5 To ml Step 2
           l = InStrB(amon(i), " " & day(Date) & " ")
           If l > 0 Then
              Shape_day.Top = .Top + (i / 2 - 0.25) * Shape_day.Height
              Shape_day.Left = .Left + (Weekday(Date) - 1) * Shape_day.Width
              Shape_day.Visible = True: Shape_day.ZOrder 0
              Exit For
           End If
       Next i
    End If
   End With
End Sub

Private Sub Form_Load()
   current_date_click
End Sub

Private Sub Text_year_Change()
  If Val(Text_year) < 0 Then Text_year = 1583
  If Val(Text_year) > 99999 Then Text_year = 99999
  If Len(Text_year) > 5 Then Text_year = Right(Text_year, 5)
  If Val(Combo_month) > 0 And Val(Combo_month) < 13 Then Combo_month_Change
End Sub