CHRONOSTAR

'Le code n'est pas du tout optimisé et il n'y a pas de commentaire
'de toute façon y en a pas vraiment besoin(en 2h le midi on fait vite fait!)
'on peut faire certain truc marrant avec ça si vous avez de l'imagination
'Valentino ;-)#
Private Sub Chronometre_Timer()
    Form1.Caption = "Heures Courante -> " + Str(Time) + "  Heures Butoire -> " + Hbutoire.Caption
    Hcourant.Caption = Time
    For i = 0 To 7
        If Chrono(i).Visible = True Then
            If i = 7 Then
                Chrono(i).Visible = False
                Chrono(0).Visible = True
                i = 8
            Else
                Chrono(i).Visible = False
                Chrono(i + 1).Visible = True
                i = 8
            End If
        End If
    Next i
End Sub
Private Sub Command1_Click()
    If Decompte(0) Then
        On Error Resume Next
        ProgressBar1.Value = 0
        ProgressBar1.Max = Temps.Value
        ProgressBar1.Visible = True
        Label1.Caption = Temps.Value
        Command1.Visible = False
        Cadre2.Visible = False
        Command2.Visible = True
        Timer1.Enabled = True
        Frame6.Visible = True
        Frame10.Visible = False
    Else
        ProgressBar1.Visible = False
        Frame10.Visible = True
        Frame6.Visible = False
        Hbutoire.Caption = Heures.Caption + ":" + Minutes.Caption + ":00"
        Command1.Visible = False
        Cadre2.Visible = False
        Command2.Visible = True
        Hcourant.Caption = Time
        Chronometre.Enabled = True
    End If
    Copy(0).Enabled = False
    Copy(1).Enabled = False
    If Commande(0) Then
        Commande(1).Enabled = False
        Commande(0).Enabled = False
    Else
        Commande(0).Enabled = False
        Commande(1).Enabled = False
    End If
    Command5.Enabled = False
    Frame7.Enabled = False
End Sub
Private Sub Command2_Click()
    Chronometre.Enabled = False
    Frame6.Visible = False
    Frame10.Visible = False
    Command1.Visible = True
    Cadre2.Visible = True
    Command2.Visible = False
    Timer1.Enabled = False
    Label1.Caption = "Arrêt du décompte des"
    Copy(0).Enabled = True
    Copy(1).Enabled = True
    Commande(0).Enabled = True
    Commande(1).Enabled = True
    If Commande(1) Then
        Command5.Enabled = True
    End If
    Frame7.Enabled = True
    ProgressBar1.Visible = False
End Sub
Private Sub Command3_Click()
    If File1.FileName <> "" Then
        test = Right(File1.Path, 1)
        If test = "\" Then
            Programme.Caption = File1.Path + File1.FileName
            Frame1.Visible = False
        Else
            Programme.Caption = File1.Path + "\" + File1.FileName
            Frame1.Visible = False
        End If
    Else
        MsgBox "Aucun Programme n'est séléctionné!!!"
    End If
    If Text1.Text <> "" Then Programme.Caption = Programme.Caption + " " + Text1.Text
End Sub
Private Sub Command4_Click()
    Frame1.Visible = False
End Sub
Private Sub Command5_Click()
    Frame1.Visible = True
End Sub
Private Sub Command6_Click()
    List1.Clear
    Text2.Text = ""
End Sub
Private Sub Command7_Click()
    If List1.SelCount <> 0 Then
        For i = 0 To List1.ListCount - 1
            If List1.Selected(i) = True Then
                List1.RemoveItem (i)
                Exit For
            End If
        Next i
    Else
        If List1.ListCount > 0 Then List1.RemoveItem List1.ListCount - 1
    End If
End Sub
Private Sub Commande_Click(Index As Integer)
    If Commande(0) Then
        Command5.Enabled = False
        Programme.Enabled = False
        Frame7.Enabled = False
        Image1_Click
    Else
        Command5.Enabled = True
        Programme.Enabled = True
        Frame7.Enabled = True
    End If
End Sub
Private Sub Copy_Click(Index As Integer)
    Version = "ChronoStar v1.0.0"
    Copyright = "Valentino_JJ@Yahoo.fr - 2000"
    Droit = "J² " & Chr(174) & " Tout Droits Reservés"

    msg = Version + Chr(13) + Chr(13) + Copyright + Chr(13) + Droit
    MsgBox msg, vbInformation, "A propos"
End Sub
Private Sub Decompte_Click(Index As Integer)
    If Decompte(0) Then
        Frame8.Visible = True
        Frame9.Visible = False
    Else
        Frame9.Visible = True
        Frame8.Visible = False
    End If
End Sub
Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
    On Error GoTo DriveHandler
    Dir1.Path = Drive1.Drive
    Exit Sub
DriveHandler:
    msg = "Lecteur " + UCase(Drive1.Drive) + " inaccessible"
    MsgBox msg, vbCritical, "Erreur"
    Drive1.Drive = Dir1.Path
    Exit Sub
    Dir1.Path = Drive1.Drive
End Sub
Private Sub File1_DblClick()
    Command3_Click
End Sub
Private Sub Form_Activate()
    Timer2.Enabled = True
End Sub
Private Sub Form_Load()
'on peut mettre tout dans un fichier
    ReDim cmde(40)
    cmde(0) = "Aucune"
    cmde(1) = "MAJ"
    cmde(2) = "CTRL"
    cmde(3) = "ALT"
    cmde(4) = "{BACKSPACE}"
    cmde(5) = "{BREAK}"
    cmde(6) = "{CAPSLOCK}"
    cmde(7) = "{DELETE}"
    cmde(8) = "{DOWN}"
    cmde(9) = "{END}"
    cmde(10) = "{ENTER}"
    cmde(11) = "{ESC}"
    cmde(12) = "{HELP}"
    cmde(13) = "{HOME}"
    cmde(14) = "{INSERT}"
    cmde(15) = "{LEFT}"
    cmde(16) = "{NUMLOCK}"
    cmde(17) = "{PGDN}"
    cmde(18) = "{PGUP}"
    cmde(19) = "{PRTSC}"
    cmde(20) = "{RIGHT}"
    cmde(21) = "{SCROLLLOCK}"
    cmde(22) = "{TAB}"
    cmde(23) = "{UP}"
    cmde(24) = "{F1}"
    cmde(25) = "{F2}"
    cmde(26) = "{F3}"
    cmde(27) = "{F4}"
    cmde(28) = "{F5}"
    cmde(29) = "{F6}"
    cmde(30) = "{F7}"
    cmde(31) = "{F8}"
    cmde(32) = "{F9}"
    cmde(33) = "{F10}"
    cmde(34) = "{F11}"
    cmde(35) = "{F12}"
    cmde(36) = "{F13}"
    cmde(37) = "{F14}"
    cmde(38) = "{F15}"
    cmde(39) = "{F16}"
    For i = 0 To 39
        Combo1.AddItem cmde(i)
        Combo2.AddItem cmde(i)
    Next i
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Image1.Appearance = 1 Then
        Image1.Appearance = 0
    End If
End Sub
Private Sub Frame7_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Image1.Appearance = 1 Then
        Image1.Appearance = 0
    End If
End Sub
Private Sub Hcourant_Change()
    If Hcourant.Caption = Hbutoire.Caption Then
        If Commande(0) Then
'Ne fonctionne pas sous les NT et XP
            Shell "rundll32.exe user.exe,ExitWindows"
        Else
            On Error Resume Next
            Form1.Hide
            Fenetre = Shell(Programme.Caption, 1)
            AppActivate Fenetre
            If List1.List(0) <> "" Then
                For i = 0 To List1.ListCount
                    For j = 0 To 75000
                        X = Height * j
                    Next j
                    SendKeys List1.List(i), True
                Next i
            End If
            End
        End If
    End If
End Sub
Private Sub Heure_Change()
    If Heure.Value = 24 Then Heure.Value = 0
    If Heure.Value = -1 Then Heure.Value = 23
    b = Format(Heure.Value, "#00")
    Heures.Caption = b
End Sub
Private Sub Image1_Click()
    If Commande(1) = True Then
        If Text2.Visible = True Then
            Text2.Visible = False
            List1.Visible = False
            Label3.Visible = False
            Combo1.Visible = False
            Combo2.Visible = False
            Command6.Visible = False
            Command7.Visible = False
        Else
            Text2.Visible = True
            List1.Visible = True
            Combo1.Visible = True
            Combo2.Visible = True
            Command6.Visible = True
            Command7.Visible = True
        End If
    Else
        Text2.Visible = False
        List1.Visible = False
        Label3.Visible = False
        Combo1.Visible = False
        Combo2.Visible = False
        Command6.Visible = False
        Command7.Visible = False
    End If
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Image1.Appearance = 0 Then Image1.Appearance = 1
End Sub
Private Sub Label1_Change()
    Form1.Caption = "Chrono : " + Label1.Caption + " Secondes"
    b = Format(Label1.Caption, "#0000")
    UU = Val(Left(b, 4))
    DD = Val(Left(b, 3))
    CC = Val(Left(b, 2))
    MM = Val(Left(b, 1))
    UU = Val(Right(UU, 1))
    DD = Val(Right(DD, 1))
    CC = Val(Right(CC, 1))
    MM = Val(Right(MM, 1))
    i = 0
    j = 0
    K = 0
    L = 0
    While i <= 9 And j <= 9 And K <= 9 And L <= 9
        If i = Val(UU) Then U(i).Visible = True Else U(i).Visible = False
        If j = Val(DD) Then D(j).Visible = True Else D(j).Visible = False
        If K = Val(CC) Then C(K).Visible = True Else C(K).Visible = False
        If L = Val(MM) Then M(L).Visible = True Else M(L).Visible = False
        i = i + 1
        j = j + 1
        K = K + 1
        L = L + 1
    Wend
    If Label1.Caption = "0" Then
        If Commande(0) Then
            Shell "rundll32.exe user.exe,ExitWindows"
        Else
            On Error Resume Next
            Form1.Hide
            Fenetre = Shell(Programme.Caption, 1)
            AppActivate Fenetre
            If List1.List(0) <> "" Then
                For i = 0 To List1.ListCount
                    For j = 0 To 75000
                        X = Height * j
                    Next j
                    SendKeys List1.List(i), True
                Next i
            End If
            End
        End If
    End If
End Sub
Private Sub Minute_Change()
    If Minute.Value = 60 Then Minute.Value = 0
    If Minute.Value = -1 Then Minute.Value = 59
    b = Format(Minute.Value, "#00")
    Minutes.Caption = b
End Sub
Private Sub Temps_Change()
    b = Format(Temps.Value, "#0000")
    UU = Val(Left(b, 4))
    DD = Val(Left(b, 3))
    CC = Val(Left(b, 2))
    MM = Val(Left(b, 1))
    UU = Val(Right(UU, 1))
    DD = Val(Right(DD, 1))
    CC = Val(Right(CC, 1))
    MM = Val(Right(MM, 1))
    i = 0
    j = 0
    K = 0
    L = 0
    While i <= 9 And j <= 9 And K <= 9 And L <= 9
        If i = Val(UU) Then Dessins(i).Visible = True Else Dessins(i).Visible = False
        If j = Val(DD) Then DessinsD(j).Visible = True Else DessinsD(j).Visible = False
        If K = Val(CC) Then DessinsC(K).Visible = True Else DessinsC(K).Visible = False
        If L = Val(MM) Then DessinsM(L).Visible = True Else DessinsM(L).Visible = False
        i = i + 1
        j = j + 1
        K = K + 1
        L = L + 1
    Wend
End Sub
Private Sub Text2_DblClick()
    Touche = ""
    If Combo1.Text <> "Aucune" And Combo1.Text <> "" Then
        If Combo1.Text = "MAJ" Then
            Touche = "+"
            GoTo t
        End If
        If Combo1.Text = "CTRL" Then
            Touche = "^"
            GoTo t
        End If
        If Combo1.Text = "ALT" Then
            Touche = "%"
            GoTo t
        End If
        Touche = Combo1.Text
t:
    End If
    If Combo2.Text <> "Aucune" And Combo2.Text <> "" Then
        If Combo2.Text = "MAJ" Then
            Touche = Touche + "+"
            GoTo tt
        End If
        If Combo2.Text = "CTRL" Then
            Touche = Touche + "^"
            GoTo tt
        End If
        If Combo2.Text = "ALT" Then
            Touche = Touche + "%"
            GoTo tt
        End If
        Touche = Touche + Combo2.Text
tt:
    End If
    If Touche <> "" Then
        List1.AddItem Touche
    End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
    Touche = ""
    If Combo1.Text <> "Aucune" And Combo1.Text <> "" Then
        If Combo1.Text = "MAJ" Then
            Touche = "+"
            GoTo spec
        End If
        If Combo1.Text = "CTRL" Then
            Touche = "^"
            GoTo spec
        End If
        If Combo1.Text = "ALT" Then
            Touche = "%"
            GoTo spec
        End If
        Touche = Combo1.Text
spec:
    End If
    If Combo2.Text <> "Aucune" And Combo2.Text <> "" Then
        If Combo2.Text = "MAJ" Then
            Touche = Touche + "+"
            GoTo spec2
        End If
        If Combo2.Text = "CTRL" Then
            Touche = Touche + "^"
            GoTo spec2
        End If
        If Combo2.Text = "ALT" Then
            Touche = Touche + "%"
            GoTo spec2
        End If
        Touche = Touche + Combo2.Text
spec2:
    End If
    If KeyAscii = 13 Then Touche = Touche + "{ENTER}" Else Touche = Touche + Chr(KeyAscii)
    Text2.Text = ""
    List1.AddItem Touche
End Sub
Private Sub Timer1_Timer()
    On Error Resume Next
    Label1 = Label1 - 1
    ProgressBar1.Value = ProgressBar1.Value + 1
    For i = 0 To 7
        If Chrono(i).Visible = True Then
            If i = 7 Then
                Chrono(i).Visible = False
                Chrono(0).Visible = True
                i = 8
            Else
                Chrono(i).Visible = False
                Chrono(i + 1).Visible = True
                i = 8
            End If
        End If
    Next i
End Sub
Private Sub Timer2_Timer()
    If Copy(0).Visible = True Then
        Copy(0).Visible = False
        Copy(1).Visible = True
    Else
        Copy(1).Visible = False
        Copy(0).Visible = True
    End If
    If Text2.Visible = True Then If Label3.Visible = True Then Label3.Visible = False Else Label3.Visible = True
End Sub

Télécharger le zip