实例介绍
【实例截图】
【核心代码】
Imports System.ComponentModel
<DefaultEvent("时间调整")> _
Public Class 可调时钟
Private CenterPoint As New Point(128, 128)
Private B As Bitmap = Nothing
Private _秒 As Bitmap = Nothing
Private _时 As Bitmap = Nothing
Private _分 As Bitmap = Nothing
Private Dt As Date = Now
Private _SelLayer As Integer = 0
Private _PM As Boolean = False
Public Event 时间调整(Dt As Date)
Private PMRct As New Rectangle(99, 85, 60, 25)
Private Sub 可调时钟_Load(sender As Object, e As EventArgs) Handles MyBase.Load
MakeBg()
End Sub
Private Sub MakeBg()
Try
If Me.Created = False Then Exit Sub
Dim Rg As New Region
B = Nothing
B = New Bitmap(255, 255)
Dim Lst As Single() = GetAng(Dt)
Using G As Graphics = Graphics.FromImage(B)
G.Clip = New Region(New Rectangle(0, 0, 255, 255))
If _PM = False Then
G.DrawImage(My.Resources.time1, New Rectangle(0, 0, 255, 255), New Rectangle(0, 0, 255, 255), GraphicsUnit.Pixel)
Else
G.DrawImage(My.Resources.time2, New Rectangle(0, 0, 255, 255), New Rectangle(0, 0, 255, 255), GraphicsUnit.Pixel)
End If
G.TranslateTransform(CenterPoint.X, CenterPoint.Y)
G.RotateTransform(Lst(0))
Make_秒(Lst(0))
G.DrawImage(My.Resources.秒针, New Rectangle(-5, -100, 10, 130), New Rectangle(0, 0, 10, 130), GraphicsUnit.Pixel)
G.ResetTransform()
G.TranslateTransform(CenterPoint.X, CenterPoint.Y)
G.RotateTransform(Lst(1))
Make_分(Lst(1))
G.DrawImage(My.Resources.分针, New Rectangle(-7, -90, 11, 100), New Rectangle(0, 0, 11, 100), GraphicsUnit.Pixel)
G.ResetTransform()
G.TranslateTransform(CenterPoint.X, CenterPoint.Y)
G.RotateTransform(Lst(2))
Make_时(Lst(2))
G.DrawImage(My.Resources.时针, New Rectangle(-11, -55, 23, 67), New Rectangle(0, 0, 23, 67), GraphicsUnit.Pixel)
G.ResetTransform()
End Using
Me.BackgroundImage = B
Catch
End Try
End Sub
Private Sub Make_秒(Ang As Single)
Try
_秒 = Nothing
_秒 = New Bitmap(255, 255)
Using G As Graphics = Graphics.FromImage(_秒)
G.Clip = New Region(New Rectangle(0, 0, 255, 255))
G.TranslateTransform(CenterPoint.X, CenterPoint.Y)
G.RotateTransform(Ang)
G.DrawImage(My.Resources.秒针, New Rectangle(-5, -100, 10, 130), New Rectangle(0, 0, 10, 130), GraphicsUnit.Pixel)
End Using
'DSAPI.图形图像.图像特效.色彩.亮度(_秒, 128)
Catch
End Try
End Sub
Private Sub Make_分(Ang As Single)
Try
_分 = Nothing
_分 = New Bitmap(255, 255)
Using G As Graphics = Graphics.FromImage(_分)
G.Clip = New Region(New Rectangle(0, 0, 255, 255))
G.TranslateTransform(CenterPoint.X, CenterPoint.Y)
G.RotateTransform(Ang)
G.DrawImage(My.Resources.分针, New Rectangle(-7, -90, 11, 100), New Rectangle(0, 0, 11, 100), GraphicsUnit.Pixel)
End Using
'DSAPI.图形图像.图像特效.色彩.亮度(_分, 128)
Catch
End Try
End Sub
Private Sub Make_时(Ang As Single)
Try
_时 = Nothing
_时 = New Bitmap(255, 255)
Using G As Graphics = Graphics.FromImage(_时)
G.Clip = New Region(New Rectangle(0, 0, 255, 255))
G.TranslateTransform(CenterPoint.X, CenterPoint.Y)
G.RotateTransform(Ang)
G.DrawImage(My.Resources.时针, New Rectangle(-11, -55, 23, 67), New Rectangle(0, 0, 23, 67), GraphicsUnit.Pixel)
'DSAPI.图形图像.图像特效.色彩.亮度(_时, 128)
End Using
Catch
End Try
End Sub
Private Function GetAng(Tm As Date) As Single()
Dim Lst As New List(Of Single)
Lst.Add(0) '秒
Lst.Add(0) '分
Lst.Add(0) '时
Try
Lst(0) = 360 / 60 * Tm.Second
Lst(1) = 360 / 60 * Tm.Minute 6 / 60 * Tm.Second
Dim H As Integer = Tm.Hour
If H > 11 Then H -= 12
Lst(2) = 360 / 12 * Tm.Hour 30 / 60 * Tm.Minute
Catch
End Try
Return Lst.ToArray
End Function
Private Sub 可调时钟_MouseClick(sender As Object, e As MouseEventArgs) Handles Me.MouseClick
If e.Button = Windows.Forms.MouseButtons.Left Then
If PMRct.Contains(e.Location) Then
_PM = Not _PM
Dim H As Integer = Dt.Hour
If _PM = True Then
H = 12
If H > 23 Then H = 23
Else
H -= 12
If H < 0 Then H = 0
End If
Dt = New Date(Dt.Year, Dt.Month, Dt.Day, H, Dt.Minute, Dt.Second)
MakeBg()
RaiseEvent 时间调整(Dt)
End If
End If
End Sub
Private Sub 可调时钟_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
If e.X >= 0 AndAlso e.Y >= 0 AndAlso e.X <= 255 AndAlso e.Y <= 255 Then
Dim IsCatched As Boolean = False
If IsCatched = False AndAlso _时.GetPixel(e.X, e.Y).A > 10 Then
_SelLayer = 1
IsCatched = True
End If
If IsCatched = False AndAlso _分.GetPixel(e.X, e.Y).A > 10 Then
_SelLayer = 2
IsCatched = True
End If
If IsCatched = False AndAlso _秒.GetPixel(e.X, e.Y).A > 10 Then
_SelLayer = 3
IsCatched = True
End If
If IsCatched Then
Cursor = Cursors.Hand
MakeBg()
Else
_SelLayer = 0
Cursor = Cursors.Default
End If
End If
End If
End Sub
Private Sub 可调时钟_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
If e.X >= 0 AndAlso e.Y >= 0 AndAlso e.X <= 255 AndAlso e.Y <= 255 Then
If _时.GetPixel(e.X, e.Y).A > 10 OrElse _分.GetPixel(e.X, e.Y).A > 10 OrElse _秒.GetPixel(e.X, e.Y).A > 10 Then
Cursor = Cursors.Hand
Else
If PMRct.Contains(e.Location) Then
Cursor = Cursors.Hand
Else
Cursor = Cursors.Default
End If
End If
Else
Exit Sub
End If
If _SelLayer = 0 Then Exit Sub
If e.Button = Windows.Forms.MouseButtons.Left Then
Dim H As Integer = 0
Try
Select Case _SelLayer
Case 1
H = 11 / 360 * GetAng(e.Location)
If _PM = True Then
H = 12
If H > 23 Then H = 23
End If
Dt = New Date(Dt.Year, Dt.Month, Dt.Day, H, Dt.Minute, Dt.Second)
Case 2
H = 59 / 360 * GetAng(e.Location)
Dt = New Date(Dt.Year, Dt.Month, Dt.Day, Dt.Hour, H, Dt.Second)
Case 3
H = 59 / 360 * GetAng(e.Location)
Dt = New Date(Dt.Year, Dt.Month, Dt.Day, Dt.Hour, Dt.Minute, H)
End Select
MakeBg()
Catch
End Try
RaiseEvent 时间调整(Dt)
End If
End Sub
Private Function GetAng(Pt As Point) As Double
'斜边=Math.Sqrt(A ^ 2 B ^ 2)
'夹角=90 - (Math.Asin(A / 斜边) / Math.PI * 180)
Dim H As Double = 0
Dim Pt1 As New Point(Pt.X - Me.Width / 2, Pt.Y - Me.Height / 2)
H = Math.Sqrt(Pt1.X ^ 2 Pt1.Y ^ 2)
If Pt1.X < 0 AndAlso Pt1.Y < 0 Then
H = 90 - (Math.Asin(Math.Abs(Pt1.X) / H) / Math.PI * 180)
H = 270
End If
If Pt1.X > 0 AndAlso Pt1.Y > 0 Then
H = 90 - (Math.Asin(Math.Abs(Pt1.X) / H) / Math.PI * 180)
H = 90
End If
If Pt1.X < 0 AndAlso Pt1.Y > 0 Then
H = 90 - (Math.Asin(Math.Abs(Pt1.Y) / H) / Math.PI * 180)
H = 180
End If
If Pt1.X > 0 AndAlso Pt1.Y < 0 Then
H = 90 - (Math.Asin(Math.Abs(Pt1.Y) / H) / Math.PI * 180)
End If
If Pt1.X = 0 AndAlso Pt1.Y > 0 Then
H = 90 - (Math.Asin(Math.Abs(Pt1.X) / H) / Math.PI * 180)
End If
If Pt1.X = 0 AndAlso Pt1.Y < 0 Then
H = 90 - (Math.Asin(Math.Abs(Pt1.Y) / H) / Math.PI * 180)
End If
If Pt1.X < 0 AndAlso Pt1.Y = 0 Then
H = 90 - (Math.Asin(Math.Abs(Pt1.X) / H) / Math.PI * 180)
End If
If Pt1.X > 0 AndAlso Pt1.Y = 0 Then
H = 90 - (Math.Asin(Math.Abs(Pt1.Y) / H) / Math.PI * 180)
End If
If H > 360 Then H = 360
Return H
End Function
Private Sub 可调时钟_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
_SelLayer = 0
End Sub
End Class
标签: 时钟
小贴士
感谢您为本站写下的评论,您的评论对其它用户来说具有重要的参考价值,所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字,对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙,所以请不要反馈意义不大的重复字符,也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明,或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦,又没人会搭理,于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享,对搜索内容的合法性不具有预见性、识别性、控制性,仅供学习研究,请务必在下载后24小时内给予删除,不得用于其他任何用途,否则后果自负。基于互联网的特殊性,平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查;无论平台是否已进行审查,用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场,基于网友分享,根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定,若资源存在侵权或相关问题请联系本站客服人员,点此联系我们。关于更多版权及免责申明参见 版权及免责申明


网友评论
我要评论