Emploi du temps

Télécharger le projet
Commenter

Description

ce prog fait un calendrier de la semaine courante et affiche l'emploi du temps.

Source / Exemple : 


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
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_NeoCortex)