dialog.frm

一个可以显示阴历和阳历的月历程序,显示在桌面上,背景透明.

VERSION 5.00
Begin VB.Form Dialog 
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "设置颜色..."
   ClientHeight    =   2580
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   3450
   Icon            =   "Dialog.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2580
   ScaleWidth      =   3450
   ShowInTaskbar   =   0   'False
   Begin VB.CheckBox ColorCheck 
      Caption         =   "Check1"
      Height          =   255
      Left            =   960
      TabIndex        =   17
      Top             =   1560
      Width           =   255
   End
   Begin VB.CommandButton DefaultButton 
      Caption         =   "默认"
      Height          =   375
      Left            =   2040
      TabIndex        =   16
      Top             =   1560
      Width           =   1215
   End
   Begin VB.CommandButton YingYongButton 
      Caption         =   "应用"
      Height          =   375
      Left            =   2040
      TabIndex        =   15
      Top             =   1080
      Width           =   1215
   End
   Begin VB.CommandButton showColorTableCommand 
      Caption         =   "查看颜色表"
      Height          =   375
      Left            =   720
      TabIndex        =   14
      Top             =   2040
      Width           =   1815
   End
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   3000
      Top             =   120
   End
   Begin VB.TextBox TodayColorText 
      Alignment       =   1  'Right Justify
      Height          =   270
      Left            =   960
      MaxLength       =   6
      TabIndex        =   13
      Text            =   "TodayC"
      Top             =   1200
      Width           =   855
   End
   Begin VB.TextBox WeekendColorText 
      Alignment       =   1  'Right Justify
      Height          =   270
      Left            =   960
      MaxLength       =   6
      TabIndex        =   12
      Text            =   "Weeken"
      Top             =   840
      Width           =   855
   End
   Begin VB.TextBox LunarColorText 
      Alignment       =   1  'Right Justify
      Height          =   270
      Left            =   960
      MaxLength       =   6
      TabIndex        =   11
      Text            =   "LunarC"
      Top             =   480
      Width           =   855
   End
   Begin VB.TextBox textColorText 
      Alignment       =   1  'Right Justify
      Height          =   270
      Left            =   960
      MaxLength       =   6
      TabIndex        =   3
      Text            =   "textCo"
      Top             =   120
      Width           =   855
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "取消"
      Height          =   375
      Left            =   2040
      TabIndex        =   1
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Height          =   375
      Left            =   2040
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label Label5 
      Caption         =   "颜色循环"
      Height          =   255
      Left            =   1260
      TabIndex        =   18
      Top             =   1605
      Width           =   855
   End
   Begin VB.Label TodayColorLabel 
      Height          =   255
      Left            =   600
      TabIndex        =   10
      Top             =   1200
      Width           =   255
   End
   Begin VB.Label WeekendColorLabel 
      Height          =   255
      Left            =   600
      TabIndex        =   9
      Top             =   840
      Width           =   255
   End
   Begin VB.Label LunarColorLabel 
      Height          =   255
      Left            =   600
      TabIndex        =   8
      Top             =   480
      Width           =   255
   End
   Begin VB.Label Label2 
      Caption         =   "农历"
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   540
      Width           =   495
   End
   Begin VB.Label Label4 
      Caption         =   "今日"
      Height          =   375
      Left            =   120
      TabIndex        =   6
      Top             =   1260
      Width           =   495
   End
   Begin VB.Label Label3 
      Caption         =   "周末"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   900
      Width           =   495
   End
   Begin VB.Label textColorLabel 
      Height          =   255
      Left            =   600
      TabIndex        =   4
      Top             =   120
      Width           =   255
   End
   Begin VB.Label Label1 
      Caption         =   "正常"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   180
      Width           =   495
   End
End
Attribute VB_Name = "Dialog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim TodayColor_loop
'取消
Private Sub CancelButton_Click()
    Me.Hide
End Sub

'默认
Private Sub DefaultButton_Click()
    TodayColorText.text = "0000FF"
    WeekendColorText.text = "0080FF"
    textColorText.text = "FFFFFF"
    LunarColorText.text = "C4C4C4"
    ColorCheck.Value = 1
End Sub

'确定
Private Sub OKButton_Click()
    Call YingYongButton_Click
    Me.Hide
End Sub

'查看颜色表...
Private Sub showColorTableCommand_Click()
       Call Shell("C:\Program Files\Internet Explorer\iexplore.exe """ + App.Path + "\colorTable.htm""", vbMaximizedFocus)
End Sub

Private Sub Timer1_Timer()
    On Error Resume Next
    '加载当前颜色
    Dialog.textColorLabel.BackColor = setColor(textColorText.text)
    Dialog.LunarColorLabel.BackColor = setColor(LunarColorText.text)
    Dialog.WeekendColorLabel.BackColor = setColor(WeekendColorText.text)
    Dialog.TodayColorLabel.BackColor = setColor(TodayColorText.text)
End Sub

'颜色文本转换为十六进制
Private Function setColor(text)
    If text <> "" Then
    setColor = "&H" + text
    Else
        setColor = 0
    End If
End Function

'应用
Private Sub YingYongButton_Click()
    If ColorCheck.Value = 1 Then
        TodayColor_loop = 1
    Else
        TodayColor_loop = 0
        DateForm.RR1.Enabled = False
        DateForm.RR2.Enabled = False
        DateForm.GG1.Enabled = False
        DateForm.GG2.Enabled = False
        DateForm.BB1.Enabled = False
        DateForm.BB2.Enabled = False
    End If
    Call WriteColor(setColor(textColorText.text), setColor(LunarColorText.text), setColor(WeekendColorText.text), setColor(TodayColorText.text))
    DateForm.setForeColor
End Sub

Private Function WriteColor(color1, color2, color3, color4)
    Call SaveSetting("Calendar", "Color", "textColor", color1)
    Call SaveSetting("Calendar", "Color", "LunarColor", color2)
    Call SaveSetting("Calendar", "Color", "WeekendColor", color3)
    Call SaveSetting("Calendar", "Color", "TodayColor", color4)
    Call SaveSetting("Calendar", "Color", "TodayColor_loop", TodayColor_loop)
End Function