Bonjour,
VERSION 5.00
Begin VB.Form Horloge
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
Caption = "Horloge"
ClientHeight = 9735
ClientLeft = 0
ClientTop = 0
ClientWidth = 11010
ControlBox = 0 'False
FillStyle = 2 'Horizontal Line
BeginProperty Font
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "Horloge.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 649
ScaleMode = 3 'Pixel
ScaleWidth = 734
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
WindowState = 2 'Maximized
Begin VB.Timer Timer
Interval = 1000
Left = 75
Top = 735
End
Begin VB.PictureBox PicHorloge
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00000000&
BeginProperty Font
Name = "Verdana"
Size = 14.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 9525
Left = 0
ScaleHeight = 633
ScaleMode = 3 'Pixel
ScaleWidth = 718
TabIndex = 0
Top = 0
Width = 10800
Begin VB.Image SonOn
Appearance = 0 'Flat
Height = 450
Left = 0
Picture = "Horloge.frx":030A
Stretch = -1 'True
Top = 0
Visible = 0 'False
Width = 450
End
Begin VB.Label Pub
BackColor = &H0080FFFF&
BorderStyle = 1 'Fixed Single
Caption = "Pub"
Height = 3000
Left = 525
TabIndex = 1
Top = 15
Visible = 0 'False
Width = 3300
End
Begin VB.Image SonOff
Appearance = 0 'Flat
Height = 450
Left = 0
Picture = "Horloge.frx":11A3
Stretch = -1 'True
Top = 0
Visible = 0 'False
Width = 450
End
End
End
Attribute VB_Name = "Horloge"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
'SND_SYNC = &H0 SND_ASYNC = &H1 SND_NODEFAULT = &H2 SND_LOOP = &H8 SND_NOSTOP = &H10
'wFlags% = SND_SYNC Or SND_NODEFAULT = &H0 or &H2 = &H2 'Arrêt pgm le temp du son
'wFlags% = SND_ASYNC Or SND_NODEFAULT = &H1 or &H2 = &H3 'Pgm continue
'X = SndPlaySound("HEURE.WAV", &H2)
Dim Horloge As Boolean, DateOk As Boolean, HP As Boolean, Taille As Single, Gras As Boolean
Private Sub HorlogeParlante(Maintenant As Date)
Dim H As String, M As String, X As Integer
SonOn.Visible = True: DoEvents: H = Format$(Maintenant, "hh"): M = Format$(Maintenant, "nn")
X = sndPlaySound("WAV\" & H & ".WAV", &H2): DoEvents: X = sndPlaySound("WAV\" & "HEURE.WAV", &H2): DoEvents
If M > 0 Then X = sndPlaySound("WAV\" & M & ".WAV", &H2): DoEvents
SonOn.Visible = False
End Sub
Public Function DessineHorloge(HMS As Date, pos As Integer, Coul As Long, lPictureBox As PictureBox)
Dim Pi As Double, HX As Long, HY As Long, i As Long, tempVar As Long, CentreX As Long, CentreY As Long, hh As Byte, MM As Byte, SS As Byte
On Error Resume Next: Pi = 3.141592654: lPictureBox.Cls: PicHorloge.FontName = "Verdana"
If pos = 1 Then CentreX = Taille * 100: CentreY = Taille * 100
If pos = 2 Then CentreX = lPictureBox.Width / 2: CentreY = Taille * 100
If pos = 3 Then CentreX = lPictureBox.Width - Taille * 100: CentreY = Taille * 100
If pos = 4 Then CentreX = Taille * 100: CentreY = lPictureBox.Height / 2
If pos = 5 Then CentreX = lPictureBox.Width / 2: CentreY = lPictureBox.Height / 2
If pos = 6 Then CentreX = lPictureBox.Width - Taille * 100: CentreY = lPictureBox.Height / 2
If pos = 7 Then CentreX = Taille * 100: CentreY = lPictureBox.Height - Taille * 100
If pos = 8 Then CentreX = lPictureBox.Width / 2: CentreY = lPictureBox.Height - Taille * 100
If pos = 9 Then CentreX = lPictureBox.Width - Taille * 100: CentreY = lPictureBox.Height - Taille * 100
SS = Second(HMS): MM = Minute(HMS): If Hour(HMS) > 12 Then hh = Hour(HMS) - 12 Else hh = Hour(HMS)
For i = 1 To 12
HX = Int(80 * Taille * Cos((((i * 30) - 90) / 180) * Pi)): HY = Int(80 * Taille * Sin((((i * 30) - 90) / 180) * Pi)) - 1.6 * Taille
lPictureBox.FontSize = Int(15 * Taille * 1.5): lPictureBox.ForeColor = Coul: lPictureBox.FontBold = Gras
lPictureBox.CurrentX = HX + CentreX - lPictureBox.TextWidth("•") / 2: lPictureBox.CurrentY = HY + CentreY - (lPictureBox.TextHeight("•") / 2)
lPictureBox.Print "•"
Next i
'Heures
tempVar = (hh + (MM / 60)) * 30
HX = Int(48 * Taille * Cos(((tempVar - 90) / 180) * Pi)): HY = Int(48 * Taille * Sin(((tempVar - 90) / 180) * Pi))
HX = Int(45 * Taille * Cos(((tempVar - 90) / 180) * Pi)): HY = Int(45 * Taille * Sin(((tempVar - 90) / 180) * Pi))
lPictureBox.DrawWidth = 15 * (1 - 2 * Gras): lPictureBox.Line (CentreX, CentreY)-(CentreX + HX, CentreY + HY), vbRed
'Minutes
tempVar = (MM + (SS / 60)) * 6
HX = Int(65 * Taille * Cos(((tempVar - 90) / 180) * Pi)): HY = Int(65 * Taille * Sin(((tempVar - 90) / 180) * Pi))
lPictureBox.DrawWidth = 10 * (1 - 2 * Gras): lPictureBox.Line (CentreX, CentreY)-(CentreX + HX, CentreY + HY), vbGreen
'Secondes
tempVar = SS * 6
HX = Int(75 * Taille * Cos(((tempVar - 90) / 180) * Pi)): HY = Int(75 * Taille * Sin(((tempVar - 90) / 180) * Pi))
HX = Int(85 * Taille * Cos(((tempVar - 90) / 180) * Pi)): HY = Int(85 * Taille * Sin(((tempVar - 90) / 180) * Pi))
lPictureBox.DrawWidth = 1 * (1 - 2 * Gras): lPictureBox.Line (CentreX, CentreY)-(CentreX + HX, CentreY + HY), vbBlue
End Function
Public Function DessineNumerique(Maintenant As Date)
Dim TexteDate As String, pos As Integer, i As Integer
TexteDate = Format$(Maintenant, "hh") + " " + Right$(Format$(Maintenant, "nn"), 2)
PicHorloge.FontName = "Arial Narrow"
PicHorloge.FontSize = Int(97 * Taille): PicHorloge.FontBold = Gras
pos = PicHorloge.Width / 2 - PicHorloge.TextWidth(TexteDate) / 2: PicHorloge.CurrentX = pos: PicHorloge.CurrentY = PicHorloge.Height / 7
PicHorloge.ForeColor = vbWhite: PicHorloge.Print TexteDate
TexteDate = ":": PicHorloge.FontName = "Arial Narrow"
PicHorloge.FontSize = Int(80 * Taille): PicHorloge.FontBold = False
PicHorloge.CurrentX = PicHorloge.Width / 2 - 12 * Taille: PicHorloge.CurrentY = PicHorloge.Height / 7 + 22 * Taille
PicHorloge.ForeColor = vbBlue: PicHorloge.Print TexteDate
If DateOk Then
PicHorloge.FontName = "Arial"
TexteDate = "": For i = 1 To 60: TexteDate = TexteDate + ".": Next
PicHorloge.FontSize = Int(12 * Taille): PicHorloge.ForeColor = vbBlue: PicHorloge.FontBold = True
pos = PicHorloge.Width / 2 - PicHorloge.TextWidth(TexteDate) / 2
PicHorloge.CurrentX = pos + 1 * Taille: PicHorloge.CurrentY = PicHorloge.Height / 8
TexteDate = "": For i = 1 To Format(Maintenant, "s"): TexteDate = TexteDate + ".": Next
PicHorloge.Print TexteDate
TexteDate = Format$(Maintenant, "dddd d mmmm yyyy")
PicHorloge.FontSize = Int(14 * Taille): PicHorloge.ForeColor = vbYellow: PicHorloge.FontBold = False
PicHorloge.CurrentX = PicHorloge.Width / 2 - PicHorloge.TextWidth(TexteDate) / 2: PicHorloge.CurrentY = PicHorloge.Height / 4 * 3.5
PicHorloge.Print TexteDate
End If
End Function
Private Sub Form_Load()
If App.PrevInstance Then Beep: End
On Error Resume Next: Shell App.Path & "\SoundClap.exe", 0
Dim C As String: C = Command$: Aide 0
If InStr(1, C, "A") > 0 Then Pub.Visible = True
If InStr(1, C, "G") > 0 Then Gras = True
If InStr(1, C, "D") > 0 Then DateOk = True
If InStr(1, C, "H") > 0 Then Horloge = True
If InStr(1, C, "S") > 0 Then HP = True
Width = Screen.Width: Height = Screen.Height: PicHorloge.Width = Width / 15: PicHorloge.Height = Height / 15: Taille = PicHorloge.Height / 200 '180
End Sub
Private Sub PicHorloge_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 145 Then
If HP And Not SonOn.Visible Then HorlogeParlante Now
ElseIf KeyCode = 65 Then
If Pub.Visible Then Pub.Visible = False Else Pub.Visible = True
ElseIf KeyCode = 32 Then
HorlogeParlante Now
End If
If Pub.Visible Then
If KeyCode = 81 Then
End
ElseIf KeyCode = 68 Then
If DateOk Then DateOk = False Else DateOk = True
ElseIf KeyCode = 72 Then
If Horloge Then Horloge = False Else Horloge = True
ElseIf KeyCode = 71 Then
If Gras Then Gras = False Else Gras = True
ElseIf KeyCode = 82 Then
WindowState = 1
ElseIf KeyCode = 83 Then
If HP Then HP = False Else HP = True
SonOff.Visible = HP
End If
Aide KeyCode
End If
End Sub
Private Sub PicHorloge_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then If Gras Then Gras = False Else Gras = True
If Button = 4 Then If Pub.Visible Then Pub.Visible = False Else Pub.Visible = True
End Sub
Private Sub Timer_Timer()
PicHorloge.SetFocus: PicHorloge.Cls
If Horloge Then DessineHorloge Now, 5, vbYellow, PicHorloge Else DessineNumerique Now
If HP Then SonOff.Visible = True
End Sub
Private Sub Aide(Key As Integer)
Dim msg As String
msg = " Aide" & Chr$(10) & Chr$(10) & " A = Aide" & " Touche : " & Key & Chr$(10) & " G = Gras" & Chr$(10) & " D = Date"
msg = msg & Chr$(10) & " H = Horloge" & Chr$(10) & " S = Sonore" & Chr$(10) & " R = Réduit" & Chr$(10) & " Q = Quitte"
msg = msg & Chr$(10) & Chr$(10) & " Espace = Parle"
msg = msg & Chr$(10) & Chr$(10) & " Raccourci : Horloge.exe AGDHS"
msg = msg & Chr$(10) & Chr$(10) & " ©AAS le 15 décembre 2012"
Pub = msg
End Sub