begin process at 2012 02 13 21:24:11
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Date & Heure

 > EMPLOI DU TEMPS

EMPLOI DU TEMPS


 Information sur la source

Note :
9,2 / 10 - par 5 personnes
9,20 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Date & Heure Niveau :Débutant Date de création :22/04/2003 Date de mise à jour :22/04/2003 03:43:02 Vu / téléchargé :8 504 / 1 698

Auteur : NeoCortex

Ecrire un message privé
Site perso
Commentaire sur cette source (4)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
ce prog fait un calendrier de la semaine courante et affiche l'emploi du temps.

Source

  • 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 Sub ReleaseCapture Lib "user32" ()
  • Const WM_NCLBUTTONDOWN = &HA1
  • Const HTCAPTION = 2
  • Private Largeur As Integer
  • Private Hauteur As Integer
  • Private Epaisseur As Integer
  • Private Compte As Integer
  • Private Sub aide_Click()
  • Form8.Show
  • Unload Form6
  • Unload Form7
  • End Sub
  • Private Sub aide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  • Unload Form6
  • Unload Form7
  • End Sub
  • Private Sub edit_Click()
  • Form7.Show
  • Unload Form6
  • Unload Form8
  • End Sub
  • Private Sub edit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  • Unload Form6
  • Unload Form8
  • End Sub
  • Private Sub fich_Click()
  • Form6.Show
  • Unload Form7
  • Unload Form8
  • End Sub
  • Private Sub fich_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  • Unload Form7
  • Unload Form8
  • End Sub
  • Private Sub Form_Load()
  • 'declaration des variables
  • '##################################################################################
  • Dim i As Integer
  • Dim cpt As Integer
  • '##################################################################################
  • MAJ
  • Compte = 1
  • If LireINI("gen", "cours") <> vbNullString Then
  • Cours
  • Else
  • MsgBox "Aucun cours enregistré", vbInformation
  • Form4.Show
  • End If
  • End Sub
  • Private Function MAJ()
  • 'code
  • '##################################################################################
  • 'installation des jours dans les labels
  • For i = 0 To 6 Step 1
  • lbljour(i).Caption = Format(vbMonday + i, "dddd")
  • Next i
  • 'installation des dates dans les labels
  • cpt = 0
  • For i = Form3.Date1.Text To Form3.Date2 Step 1
  • lbldate(cpt).Caption = i
  • If lbldate(cpt).Caption = Format(Date, "dd") Then
  • lbldate(cpt).ForeColor = vbRed
  • Else
  • lbldate(cpt).ForeColor = vbBlue
  • End If
  • cpt = cpt + 1
  • Next i
  • 'installation des heures dans les labels
  • If LireINI("heure", "debut") = vbNullString Then
  • cpt = 6
  • Else
  • cpt = LireINI("heure", "debut")
  • End If
  • For i = 0 To 15 Step 1
  • lblheure(i).Caption = cpt & " H"
  • If lblheure(i).Caption = Format(Time, "hh") & " H" Then
  • lblheure(i).ForeColor = vbRed
  • Else
  • lblheure(i).ForeColor = vbBlue
  • End If
  • cpt = cpt + 1
  • Next i
  • '##################################################################################
  • End Function
  • Private Function Cours()
  • EcarType
  • k.Text = 0
  • j.Text = 0
  • 'affichage des cours sur la grille
  • 'parcours des matireres
  • While j.Text <= LireINI("mat", "cpt")
  • 'verification si la matiere contient des cours
  • If LireINI(j.Text, "cpt") <> vbNullString Then
  • k.Text = "0"
  • 'si oui
  • 'parcours des cours de la matiere
  • While k.Text <= LireINI(j.Text, "cpt")
  • 'chargement du label representant le cours
  • Load cr(Compte)
  • With cr(Compte)
  • .BackColor = LireINI(j.Text, "col")
  • .Caption = LireINI(j.Text, "nom")
  • .ToolTipText = LireINI(j.Text, k.Text & "aper")
  • .Left = Largeur * Val(LireINI(j.Text, k.Text & "jour")) + planche.Left + (Epaisseur / 8)
  • .Width = Epaisseur
  • .Height = (Val(LireINI(j.Text, k.Text & "fh")) - Val(LireINI(j.Text, k.Text & "dh"))) * Hauteur
  • .Top = (Val(LireINI(j.Text, k.Text & "dh")) - Val(LireINI("heure", "debut"))) * Hauteur + planche.Top
  • .Visible = True
  • .ZOrder (0)
  • End With
  • 'incrementation du compteur de label
  • Compte = Compte + 1
  • k.Text = Val(k.Text) + 1
  • Wend
  • End If
  • j.Text = Val(j.Text) + 1
  • Wend
  • End Function
  • Private Function EcarType()
  • 'echel_largeur
  • Largeur = planche.Width / 7
  • Epaisseur = (Largeur / 5) * 4
  • 'echel_hauteur
  • Hauteur = planche.Height / 16
  • End Function
  • Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  • Unload Form6
  • Unload Form7
  • End Sub
  • Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  • Dim ValRetourLng As Long
  • If Button = 1 Then
  • Call ReleaseCapture
  • ValRetourLng = SendMessage(Form2.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
  • End If
  • Unload Form6
  • Unload Form7
  • End Sub
  • Private Sub Image2_Click()
  • End
  • End Sub
  • Private Sub Image3_Click()
  • Me.WindowState = 1
  • End Sub
  • Private Sub Label1_Click()
  • Form4.Show
  • End Sub
  • Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  • Dim ValRetourLng As Long
  • If Button = 1 Then
  • Call ReleaseCapture
  • ValRetourLng = SendMessage(Form2.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
  • End If
  • End Sub
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 Sub ReleaseCapture Lib "user32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2

Private Largeur As Integer
Private Hauteur As Integer
Private Epaisseur As Integer
Private Compte As Integer

Private Sub aide_Click()
Form8.Show
Unload Form6
Unload Form7
End Sub

Private Sub aide_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Unload Form6
Unload Form7
End Sub

Private Sub edit_Click()
Form7.Show
Unload Form6
Unload Form8
End Sub

Private Sub edit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Unload Form6
Unload Form8
End Sub

Private Sub fich_Click()
Form6.Show
Unload Form7
Unload Form8
End Sub

Private Sub fich_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Unload Form7
Unload Form8
End Sub

Private Sub Form_Load()
'declaration des variables
'##################################################################################
    Dim i As Integer
    Dim cpt As Integer
'##################################################################################
MAJ
Compte = 1
    
If LireINI("gen", "cours") <> vbNullString Then
    Cours
Else
    MsgBox "Aucun cours enregistré", vbInformation
    Form4.Show
End If

End Sub

Private Function MAJ()
'code
'##################################################################################

'installation des jours dans les labels
For i = 0 To 6 Step 1
lbljour(i).Caption = Format(vbMonday + i, "dddd")
Next i

'installation des dates dans les labels
cpt = 0
For i = Form3.Date1.Text To Form3.Date2 Step 1
lbldate(cpt).Caption = i
    If lbldate(cpt).Caption = Format(Date, "dd") Then
    lbldate(cpt).ForeColor = vbRed
    Else
    lbldate(cpt).ForeColor = vbBlue
    End If
cpt = cpt + 1
Next i

'installation des heures dans les labels
If LireINI("heure", "debut") = vbNullString Then
cpt = 6
Else
cpt = LireINI("heure", "debut")
End If

For i = 0 To 15 Step 1
lblheure(i).Caption = cpt & " H"
    If lblheure(i).Caption = Format(Time, "hh") & " H" Then
    lblheure(i).ForeColor = vbRed
    Else
    lblheure(i).ForeColor = vbBlue
    End If
cpt = cpt + 1
Next i
'##################################################################################
End Function

Private Function Cours()
EcarType
k.Text = 0
j.Text = 0
'affichage des cours sur la grille
    'parcours des matireres
    While j.Text <= LireINI("mat", "cpt")
        'verification si la matiere contient des cours
        If LireINI(j.Text, "cpt") <> vbNullString Then
        k.Text = "0"
        'si oui
            'parcours des cours de la matiere
            While k.Text <= LireINI(j.Text, "cpt")
                'chargement du label representant le cours
                Load cr(Compte)
                With cr(Compte)
                    .BackColor = LireINI(j.Text, "col")
                    .Caption = LireINI(j.Text, "nom")
                    .ToolTipText = LireINI(j.Text, k.Text & "aper")
                    .Left = Largeur * Val(LireINI(j.Text, k.Text & "jour")) + planche.Left + (Epaisseur / 8)
                    .Width = Epaisseur
                    .Height = (Val(LireINI(j.Text, k.Text & "fh")) - Val(LireINI(j.Text, k.Text & "dh"))) * Hauteur
                    .Top = (Val(LireINI(j.Text, k.Text & "dh")) - Val(LireINI("heure", "debut"))) * Hauteur + planche.Top
                    .Visible = True
                    .ZOrder (0)
                End With
                'incrementation du compteur de label
                Compte = Compte + 1
                k.Text = Val(k.Text) + 1
            Wend
        End If
        j.Text = Val(j.Text) + 1
    Wend
End Function

Private Function EcarType()
    'echel_largeur
        Largeur = planche.Width / 7
        Epaisseur = (Largeur / 5) * 4
    'echel_hauteur
        Hauteur = planche.Height / 16
End Function


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Unload Form6
    Unload Form7
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ValRetourLng As Long
    If Button = 1 Then
        Call ReleaseCapture
        ValRetourLng = SendMessage(Form2.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
    Unload Form6
    Unload Form7
End Sub

Private Sub Image2_Click()
End
End Sub

Private Sub Image3_Click()
Me.WindowState = 1
End Sub

Private Sub Label1_Click()
Form4.Show
End Sub

Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ValRetourLng As Long
    If Button = 1 Then
        Call ReleaseCapture
        ValRetourLng = SendMessage(Form2.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub

 Conclusion

bonne prog

NeoCortex

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources du même auteur

Source avec Zip Source avec une capture PES-LIGUE
Source avec Zip Source avec une capture CASSE BRIQUE
Source avec Zip Source avec une capture CALCUL RESEAU
Source avec Zip Source avec une capture COURSE A PIED
Source avec Zip Source avec une capture RADIOCX

 Sources de la même categorie

Source avec Zip Source avec une capture LES FONCTIONS DATE PAR L'EXEMPLE. par pasquet78
Source avec Zip Source avec une capture CALENDRIER, MODE D'EMPLOI par pasquet78
Source avec Zip Source avec une capture Source .NET (Dotnet) HORLOGE DIODE AVEC 3 ALARMES ET REMISE À L'HEURE par EhJoe
Source avec Zip Source avec une capture POINTEUSE HORAIRES PAR SEMAINE par VBNoob13
Source avec Zip Source avec une capture HORLOGE À AIGUILLES SIMPLEMENT DANS UN USERFORM EXCEL par bigbe

Commentaires et avis

Commentaire de mic le 22/04/2003 14:09:04

Logiciel très pratique avec un design de qualité. Il est malheuresement inutilisable pour moi. Je pense que d'autres personnes doivent être dans ce cas.

En fait le porblème c'est la définition des horaires. Il faut que les horaires de chaques cours puissent être définie autre que fixe. (ex.: 8h45). Autre petit problème qui vient de la même chose, l'heure de commencement.  

Sinon petit bug, si on oublie de définir la couleur du cours, à moins d'aller éditer le fichier de config à la main, pas moyen de starter le programme. Le plus simple c'est de mettre une msgbox qui empêche de fermer la fenêtre sans avoir défini une couleur.

Voila, comme pour l'autre je te met une bonne note. Si je trouve d'autre bugs je te tiendrais au courant.

Commentaire de zpiboo le 23/04/2003 09:19:36

Pour la partie design bravo par contre pour ce qui est de la partie gestion des cours et des horaires un .ini n'est pas fait pour ça il aurait été préférable d'utiliser une base de donnée.

c juste un conseil mais ton prog mérite d'être aprofondis bonne chance.

Commentaire de Frank339 le 23/04/2003 10:55:30

Moi personnellement je le trouve bien réussi... mis a part quelques bug de cliques il a l'air d'etre assez au point... c'est vrai qu'il faut etre de la branche pour pouvoir l'utiliser mais les zidées sont très bonnes...

Commentaire de TheOnlyMaX le 18/11/2003 16:33:24

Vraiment bien ton prog, a part que je n'arrive pas à l'utiliser ... Les idées sont bonnes, je cherchais justement comment donner du style à mes fenetres...
Corrige tes bugs et mets des matières par défaut (tout le monde fait des maths, etc...) 9,9/10 !!!

 Ajouter un commentaire




Nos sponsors


Sondage...

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,952 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales