📄 date.frm
字号:
Alignment = 1 'Right Justify
Caption = "10"
Height = 255
Index = 9
Left = 480
TabIndex = 20
Top = 1560
Width = 255
End
Begin VB.Label DayLabel
Alignment = 1 'Right Justify
Caption = "9"
Height = 255
Index = 8
Left = 240
TabIndex = 19
Top = 1560
Width = 255
End
Begin VB.Label DayLabel
Alignment = 1 'Right Justify
Caption = "8"
Height = 255
Index = 7
Left = 0
TabIndex = 18
Top = 1560
Width = 255
End
Begin VB.Label DayLabel
Alignment = 1 'Right Justify
Caption = "7"
Height = 255
Index = 6
Left = 1440
TabIndex = 17
Top = 1200
Width = 255
End
Begin VB.Label DayLabel
Alignment = 1 'Right Justify
Caption = "6"
Height = 255
Index = 5
Left = 1200
TabIndex = 16
Top = 1200
Width = 255
End
Begin VB.Label DayLabel
Alignment = 1 'Right Justify
Caption = "5"
Height = 255
Index = 4
Left = 960
TabIndex = 15
Top = 1200
Width = 255
End
Begin VB.Label DayLabel
Alignment = 1 'Right Justify
Caption = "4"
Height = 255
Index = 3
Left = 720
TabIndex = 14
Top = 1200
Width = 255
End
Begin VB.Label DayLabel
Alignment = 1 'Right Justify
Caption = "3"
Height = 255
Index = 2
Left = 480
TabIndex = 13
Top = 1200
Width = 255
End
Begin VB.Label DayLabel
Alignment = 1 'Right Justify
Caption = "2"
Height = 255
Index = 1
Left = 240
TabIndex = 12
Top = 1200
Width = 255
End
Begin VB.Label DayLabel
Alignment = 1 'Right Justify
Caption = "1"
Height = 255
Index = 0
Left = 0
TabIndex = 11
Top = 1200
Width = 255
End
Begin VB.Label WeekLabel
Alignment = 1 'Right Justify
Caption = "日"
Height = 375
Index = 6
Left = 3000
TabIndex = 10
Top = 720
Width = 375
End
Begin VB.Label WeekLabel
Alignment = 1 'Right Justify
Caption = "六"
Height = 375
Index = 5
Left = 2520
TabIndex = 9
Top = 720
Width = 375
End
Begin VB.Label WeekLabel
Alignment = 1 'Right Justify
Caption = "五"
Height = 375
Index = 4
Left = 2040
TabIndex = 8
Top = 720
Width = 375
End
Begin VB.Label WeekLabel
Alignment = 1 'Right Justify
Caption = "四"
Height = 375
Index = 3
Left = 1560
TabIndex = 7
Top = 720
Width = 375
End
Begin VB.Label WeekLabel
Alignment = 1 'Right Justify
Caption = "三"
Height = 375
Index = 2
Left = 1080
TabIndex = 6
Top = 720
Width = 375
End
Begin VB.Label WeekLabel
Alignment = 2 'Center
Caption = "二"
Height = 375
Index = 1
Left = 600
TabIndex = 5
Top = 720
Width = 375
End
Begin VB.Label WeekLabel
Caption = "一"
Height = 375
Index = 0
Left = 120
TabIndex = 4
Top = 720
Width = 375
End
Begin VB.Image ImageMove
Height = 255
Left = 0
Top = 0
Width = 255
End
Begin VB.Label MonthLabel2
Caption = "月"
BeginProperty Font
Name = "华文行楷"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3360
TabIndex = 3
Top = 0
Width = 255
End
Begin VB.Label MonthLabel
Alignment = 1 'Right Justify
Caption = "00"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3120
TabIndex = 2
Top = 60
Width = 255
End
Begin VB.Label YearLabel2
Alignment = 2 'Center
Caption = "年"
BeginProperty Font
Name = "华文行楷"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2880
TabIndex = 1
Top = 75
Width = 255
End
Begin VB.Label YearLabel
Alignment = 1 'Right Justify
Caption = "0000"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2400
TabIndex = 0
Top = 75
Width = 495
End
Begin VB.Menu OptionMenu
Caption = "Option"
Visible = 0 'False
Begin VB.Menu Setting
Caption = "设置...(&S)"
End
Begin VB.Menu line1
Caption = "-"
End
Begin VB.Menu Exit
Caption = "退出(&X)"
End
End
End
Attribute VB_Name = "DateForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'全局变量
Dim GYear, GMonth, GDay, FirstDay, Lunar
Dim TodayColor, WeekendColor, textColor, LunarColor
Dim TodayLabel_i, TodayLabel_Top
Dim TodayColor_loop, RR, GG, BB, Color_space
'拖放窗口移动
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Dim Window_X, Window_Y
'背景透明
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
'窗体最前
Private Declare Function SetWindowPos Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long _
) As Long
'hWndInsertAfter的值
Const HWND_BOTTOM = 1 '将窗口置于Z序列的底部
Const HWND_TOP = 0 '将窗口置于Z序列的顶部
Const HWND_TOPMOST = -1 '将窗口置于顶部,并位于最顶窗口的前面
Const HWND_NOTOPMOST = -2 '将窗口置于顶部,并位于最顶窗口的后面
'wFlags的值
Const SWP_HIDEWINDOW = &H80 '隐藏窗口
Const SWP_NOACTIVE = &H10 '不激活窗口
Const SWP_NOMOVE = &H2 '保持窗口当前位置(x,y设定将被忽略)
Const SWP_NOREDRAW = &H8 '窗口不自动重画
Const SWP_NOSIZE = &H1 '保持窗口当前大小(cx,cy设定将被忽略)
Const SWP_NOZORDER = &H8 '保持窗口列表在当前的位置(hWndInsertAfter设定将被忽略)
Const SWP_SHOWWINDOW = &H40 '显示窗口
Private Sub Exit_Click()
Unload Dialog
Unload Me
End Sub
Private Sub Form_Load()
'On Error Resume Next
Me.Caption = ""
App.TaskVisible = False
'窗体透明
Dim BgColor As String
BgColor = &H0 '&H646464 '指定需要透明的控件或窗体的背景颜色
Me.BackColor = BgColor
'设置背景颜色
Call setBackColor(BgColor)
Dim rtn As Long
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, BgColor, 0, LWA_COLORKEY '让背景色透明!!
'设置窗口位置
Call ReadPos
Call SetWindowPos(Me.hwnd, HWND_TOP, Window_X, Window_Y, 0, 0, SWP_NOSIZE + SWP_SHOWWINDOW)
'加载图片
ImageMove.Picture = LoadPicture(App.Path + "\move.bmp")
'取得年,月,日
GYear = Year(Now)
GMonth = Month(Now)
GDay = Day(Now)
YearLabel.Caption = GYear
MonthLabel.Caption = GMonth
'设置日历
Call setLunar(GMonth)
Call setDay
If DayLabel(i + 40).Caption = "1" Then Call setDay
If DayLabel(i + 40).Caption = "1" Then Call setDay
If DayLabel(i + 40).Caption = "1" Then Call setDay
'设置字体,颜色,位置
Call setFontName("华文行楷", "隶书")
Call setForeColor
Call setLabelPosition
End Sub
'设置字体
Private Function setFontName(DefinedFont, DefinedFont2)
YearLabel2.Font.Name = DefinedFont
MonthLabel2.Font.Name = DefinedFont
For i = 0 To 6
WeekLabel(i).Font.Name = DefinedFont
Next
For i = 40 To 79
DayLabel(i).Font.Name = DefinedFont2
Next
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -