可以拖动移动,透明窗口,记住位置和文字颜色。
单击 AM/PM 读出显示选项。
演示图:
实现代码:
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 GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1&
Private Const LWA_ALPHA = &H2&
Dim IsDragging As Boolean
Dim MousePosX As Integer
Dim MousePosY As Integer
Dim ConfigData(2) As Long
Private Sub Form_Load()
'Set the Form transparent by color.
BackColor =RGB(127, 127, 0) 'Non standard color.
SetWindowLong hWnd, _
GWL_EXSTYLE, _
GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributes hWnd, BackColor, 0, LWA_COLORKEY
ReadConfigFile (App.Path & "\Clock.cfg")
Me.Left = ConfigData(0)
Me.Top = ConfigData(1)
Clock(0).ForeColor = ConfigData(2)
Clock(1).ForeColor = ConfigData(2)
Timer1_Timer
End Sub
Private Sub Form_Unload(Cancel As Integer)
WriteConfigFile (App.Path & "\Clock.cfg")
End
End Sub
Private Sub Clock_Click(Index As Integer)
If Index = 1 Then
ClockBG.Visible = True
For i = 0 To 3
Options(i).Visible = True
Next
End If
End Sub
Private Sub Clock_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 And Index = 0 Then
IsDragging = True
MousePosX = X
MousePosY = Y
End If
End Sub
Private Sub Clock_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If IsDragging Then
Me.Left = Me.Left + (X - MousePosX)
Me.Top = Me.Top + (Y - MousePosY)
If Button <> 1 Then
IsDragging = False
ConfigData(0) = Me.Left
ConfigData(1) = Me.Top
End If
End If
End Sub
Private Sub Options_Click(Index As Integer)
Select Case Index
Case 0
Clock(0).ForeColor = vbRed
Clock(1).ForeColor = vbRed
ConfigData(2) = vbRed
Case 1
Clock(0).ForeColor = vbGreen
Clock(1).ForeColor = vbGreen
ConfigData(2) = vbGreen
Case 2
For i = 0 To 3
ClockBG.Visible = False
Options(i).Visible = False
Next
Case 3
Unload Me
End Select
End Sub
Private Sub ReadConfigFile(Filename As String)
On Error GoTo Handler
Open Filename For Input As #1
Input #1, ConfigData(0) 'Form Left
Input #1, ConfigData(1) 'Form Top
Input #1, ConfigData(2) 'Clock Forecolor
Handler:
Close #1
End Sub
Private Sub WriteConfigFile(Filename As String)
On Error GoTo Handler
Open Filename For Output As #1
Print #1, ConfigData(0) 'Form Left
Print #1, ConfigData(1) 'Form top
Print #1, ConfigData(2) 'Clock Forecolor
Handler:
Close #1
End Sub
Private Sub Timer1_Timer()
Temp = Time
Clock(0) = Format(Left(Temp, 8), "h:mm:ss")
Clock(1) = Right(Temp, 2)
End Sub