基本信息

---

下载

   友情提示：（无需注册或充值，赞助后即可获取资源下载链接）

---

     嘿，亲！知识可是无价之宝呢，但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下，绝对物超所值哦！如有下载和支付问题，请联系我们QQ(微信同号)：78630559

本次赞助数额为： 10 元　

支付宝支付

微信支付

   源码介绍

---

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