CARLVB'S HORLOGE AVEC CONTOUR IRREGULIER
cs_DARKSIDIOUS
Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Membre
Dernière intervention
4 mars 2013
-
12 nov. 2003 à 11:36
carlvb Messages postés 199 Date d'inscription mercredi 23 avril 2003 Statut Contributeur Dernière intervention 25 mai 2017 - 13 nov. 2003 à 10:47
carlvb Messages postés 199 Date d'inscription mercredi 23 avril 2003 Statut Contributeur Dernière intervention 25 mai 2017 - 13 nov. 2003 à 10:47
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/17878-carlvb-s-horloge-avec-contour-irregulier
https://codes-sources.commentcamarche.net/source/17878-carlvb-s-horloge-avec-contour-irregulier
13 nov. 2003 à 10:47
EBArtSoft> J'ai mis à jour la source en intégrant tes améliorations. Merci pour ton aide.
Bonne continuation.
12 nov. 2003 à 12:24
- 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...
@+
12 nov. 2003 à 11:36
Tu aurais pu inclure un menu pour quitter !
Tu aurais pu faire un effet de transparence pour les chiffres en découpant également les chiffres... ca aurait donné un plus ;-)
Si tu veux la faire progresser, tu peux aller voir ma source d'horloge à l'adresse :
http://www.vbfrance.com/code.aspx?ID=4506
Il s'agit grosso-modo de la même idée, mais un peu plus poussée ;p
Je te mets 7/10
DarK Sidious