Afrank

je cherche le code source de l'horloge
« le: 23 avril 2016 13:27:07 »
Bonjour

J'espere que je poste au bon endroit

J'aime bien l'horloge de la Freebox , est-il possible par exemple d'avoir son code source ? (ou autre chose)
Je suis pas tres fort en informatique  mais si c'est pas trop compliqué, pouvez-vous m'aider ?  ???

En vous remerciant d'avance de votre réponse, n'hésitez pas à m'indiquer un autre forum où ils pourraient plus me renseigner si jamais.

Cordialement
F

AAS

Re : je cherche le code source de l'horloge
« Réponse #1 le: 23 avril 2016 16:47:52 »
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

Afrank

Re : je cherche le code source de l'horloge
« Réponse #2 le: 30 avril 2016 21:33:36 »
Bonjour,

Merci pour votre réponse
Mais ça va être trop compliqué pour moi malheureusement
  (j'aimais bien comment sont animés les chiffres à chaque changement de nombre, en glissant)

J'avais vu que le code source de la Freebox , je crois, étais disponible donc j'ai posé cette question ........

Merci quand même de m'avoir  envoyer ça.

Cordialement
F