CARLVB'S HORLOGE AVEC CONTOUR IRREGULIER

Commentaire de EBArtSoft le 12/11/2003 12:24:00 administrateur CS

carlvb>Si je peut me permettre qlq modifs d'ordre fonctionnel :

- Il faudrait supprimer le module
    (mettre les fonctions en private dans la form)

- Supprimer la picturebox et mettre l'image
    dans la prop picture de la form

- Mettre Pixel au lieu de twip (scalemode)
- Mettre autoredraw = true
- Capturer l'heure qu'une seul fois au lieu de 4

bref voici le code :
(la from a été qlq peut modifié mais tu devrais pouvoir t'y retrouver)

Private Const Pi As Double = 3.14159265358979
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Const RGN_OR = 2

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 Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Private WindowRegion As Long

Private Sub Form_Load()
    
    'Les lignes suivantes servent à initialiser la position des trois aiguilles
    Line1.X1 = Int((Me.Width / Screen.TwipsPerPixelX) / 2)
    Line1.Y1 = Int((Me.Height / Screen.TwipsPerPixelY) / 2) - 40
    Line2.X1 = Line1.X1
    Line2.Y1 = Line1.Y1
    Line3.X1 = Line1.X1
    Line3.Y1 = Line1.Y1

    'On découpe ensuite la forme suivant le countour circulaire
    WindowRegion = MakeRegion(Me)
    SetWindowRgn Me.hWnd, WindowRegion, True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'On rend a la fenetre sa forme original
    SetWindowRgn Me.hWnd, 0, False
    DeleteObject WindowRegion
End Sub

Private Function MakeRegion(picSkin As Form) As Long
    Dim X As Long, Y As Long, StartLineX As Long
    Dim FullRegion As Long, LineRegion As Long
    Dim TransparentColor As Long
    Dim InFirstRegion As Boolean
    Dim InLine As Boolean
    Dim hDC As Long
    Dim PicWidth As Long
    Dim PicHeight As Long
    
    hDC = picSkin.hDC
    PicWidth = picSkin.ScaleWidth
    PicHeight = picSkin.ScaleHeight
    
    InFirstRegion = True: InLine = False
    X = Y = StartLineX = 0
    
    TransparentColor = GetPixel(hDC, 0, 0)
    
    For Y = 0 To PicHeight - 1
        For X = 0 To PicWidth - 1
            
            If GetPixel(hDC, X, Y) = TransparentColor Or X = PicWidth Then

                If InLine Then
                    InLine = False
                    LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1)
                    
                    If InFirstRegion Then
                        FullRegion = LineRegion
                        InFirstRegion = False
                    Else
                        CombineRgn FullRegion, FullRegion, LineRegion, RGN_OR

                        DeleteObject LineRegion
                    End If
                End If
            Else
                If Not InLine Then
                    InLine = True
                    StartLineX = X
                End If
            End If
        Next
    Next
    
    MakeRegion = FullRegion
End Function

Private Sub Form_DblClick()
    'Pour arrêter le programme double cliquer sur la form
    Unload Me
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Pour pouvoir déplacer la form car on n'a pas de barre de titre
    ReleaseCapture
    SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub

Private Sub Timer1_Timer()
    Dim Instant As Date
    
    'La première partie de cette procédure sert à prendre l'heure, la minute et la seconde
    Instant = Time
    Ora = Hour(Instant) Mod 12
    minitra = Minute(Instant)
    segondra = Second(Instant)
    
    'affichage de l'horloge digitale
    Text1 = Instant
    
    'déplacement des aiguilles de l'horloge analogique
    'La première extremité de l'aiguille reste toujours le centre de l'horloge
    'La seconde est calculé à partir du racine complexe 60ième de 1
    i = segondra
    j = minitra * 60
    C = (Ora + (minitra / 60)) * 43200 / 12
    Line1.X2 = 110 * (Cos((2 * i * Pi / 60) - (Pi / 2))) + Line1.X1
    Line1.Y2 = 110 * (Sin(2 * i * Pi / 60 - (Pi / 2))) + Line1.Y1
    Line2.X2 = 90 * (Cos((2 * j * Pi / 3600) - (Pi / 2))) + Line1.X1
    Line2.Y2 = 90 * (Sin(2 * j * Pi / 3600 - (Pi / 2))) + Line1.Y1
    Line3.X2 = 70 * (Cos((2 * C * Pi / 43200) - (Pi / 2))) + Line1.X1
    Line3.Y2 = 70 * (Sin((2 * C * Pi / 43200) - (Pi / 2))) + Line1.Y1
End Sub

On ne gagne pas en taille mais plutot en clarté
Voila si cela peut t'aider...

@+