Un ocx pour les phases de la lune

Télécharger le projet
Commenter

Description

Voici un OCX pour afficher une Lune dont on peut choisir la phase. Sa seule utilité (je pense) est pour afficher dans un programme genre Agenda la phase de la Lune selon le jour de l'annêe. Il a une seule propriété "Phase" qui varie de -1 a 1 (le détail des phases est expliqué dans le code)

'Lune - OCX.vbp

Le code est ci-dessous mais il ne suffit pas !!! Pour le graphisme, des fichiers images du ZIP sont necessaires. Il y a aussi des schemas explicatifs.

3 controles :
- ImgFond : image qui est dans le Zip
- ShpOmbre : ellipse a remplissage jaune
- ShpLumiere : ellipse a remplissage noir

'Exemple.vbp

J'ai mis un exemple d'utilisation du contrôle. Evidemment, il faut compiler l'OCX de l'autre projet dans le répertoire Windows\System avant de lancer le projet Exemple. (Je ne l'ai pas compilé moi-même car il faut pas mettre de fichiers compilés dans l'archive)

'Fonction Phase de la Lune selon la Date

Voici aussi une fonction qui va avec : en donnant une date, on obtient la valeur de la phase de la Lune que vous pouvez entrez directement dans le contrôle OCX. Le problème est que cette fonction prend une date de référence (26/09/2003) et plus on s'en éloigne, plus la précision est mauvaise.

Source / Exemple : 


'------------------ CODE DE L'OCX ------------------

Option Explicit

Private PHASE_LUNE As Single

'Controles :
        'ImgFond : gabarit opaque avec un rond tranparent au milieu
        '        (c'est pour cacher le reste des ellipses
        '        qui sort du cercle de la Lune)
        'ShpOmbre : ellipse de l'ombre
        'ShpLumiere : ellipse de la lumiere

Sub AfficherLune(SngPhase As Single)

        'valeurs VOIR AUSSI LE FICHIER "CYLU.JPG"
        '-1,00 :    nouvelle lune
        '-0,75 :    premier croissant
        '-0,50 :    premier quartier
        '-0,25 :    lune gibbeuse
        '0 :        pleine lune
        '0,25 :     lune gibbeuse
        '0,50 :     dernier quartier
        '0,75 :     dernier croissant
        '1,00 :     nouvelle lune

'Selon si la partie la plus grande (ombre ou lumiere), on change la couleur
'de fond et on modifie les dimensions de l'ellipse de couleur complementaire.

'ex : 1er croissant : 3/4 d'ombre a gauche et 1/4 de lumiere a droite
'l'ellipse lumiere sera invisible et on modifie les dimensions de l'ellipse
'ombre (on la place a gauche)

'Si la largeur de l'ellipse devient infêrieur a la moitiê, on inverse simplement
'Ombre et Lumiere...

PHASE_LUNE = SngPhase

'PREMIERE PHASE : Nouvelle Lune au Premier quartier
If SngPhase >= -1 And SngPhase <= -1 / 2 Then
    UserControl.BackColor = &HC0C0& 'Jaune
    ShpLumiere.Visible = False
    
    With ShpOmbre
        .Visible = True
        .Width = -720 * SngPhase
        .Left = 0
        .Height = CurveHeight(.Width)
        .Top = CurveTop(.Height)
    End With

End If

'DEUXIEME PHASE : Premier quartier a la Pleine lune
If SngPhase > -1 / 2 And SngPhase <= 0 Then
    UserControl.BackColor = &H80000008 'Noir
    ShpOmbre.Visible = False

    With ShpLumiere
        .Visible = True
        .Width = 720 * SngPhase + 720
        .Left = CurveLeftD(.Width)
        .Height = CurveHeight(.Width)
        .Top = CurveTop(.Height)
    End With
    
End If

'TROISIEME PHASE : Pleine Lune au Dernier quartier
If SngPhase > 0 And SngPhase <= 1 / 2 Then
    UserControl.BackColor = &H80000008 'Noir
    ShpOmbre.Visible = False
    
    With ShpLumiere
        .Visible = True
        .Width = 720 * (1 - SngPhase)
        .Left = 0
        .Height = CurveHeight(.Width)
        .Top = CurveTop(.Height)
    End With

End If

'QUATRIEME PHASE : Dernier quartier a la Nouvelle lune
If SngPhase > 1 / 2 And SngPhase <= 1 Then
    UserControl.BackColor = &HC0C0& 'Jaune
    ShpLumiere.Visible = False
    
    With ShpOmbre
        .Visible = True
        .Width = 720 * SngPhase
        .Left = CurveLeftD(.Width)
        .Height = CurveHeight(.Width)
        .Top = CurveTop(.Height)
    End With
    
End If
        

End Sub

Function CurveTop(LngHeight As Long) As Long
        'cette fonction centre simplement
        'l'ellipse sur le controle
    CurveTop = (720 - LngHeight) / 2
End Function

Function CurveLeftD(LngWidth As Long) As Long
        'dans le cas ou l'ellipse vient de la droite
        'il faut ajuster la propriêtê Left selon
        'la largeur
    CurveLeftD = -LngWidth + 720
End Function

Function CurveHeight(LngWidth As Long) As Long
        'cette fonction regle la hauteur de l'ellipse
        'selon sa largeur (pour une Width variant de
        '50 a 100% : 360 a 720)
        'VOIR SCHEMA.BMP

        'pour 50% : sêparation droite => Ellipse.Height =2880
        'pour 80% : sêparation incurvêe => Ellipse.Height + petit
        'pour 100% : sêparation invisible => Ellipse.Height = 720 'minimum

        'coefficients
    Dim A As Double
    Dim B As Double
    Dim C As Double

    A = 13 / 450
    B = -186 / 5
    C = 12528
    
    CurveHeight = Int(A * LngWidth ^ 2 + B * LngWidth + C)

    If CurveHeight < 720 Then CurveHeight = 720

End Function

'dêfinition de la propriêtê Phase

Public Property Get Phase() As String
    Phase = PHASE_LUNE
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    PHASE_LUNE = PropBag.ReadProperty("Phase", 0)
End Sub

Private Sub UserControl_Resize()
    UserControl.Width = 720
    UserControl.Height = 720
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Phase", PHASE_LUNE, 0)
End Sub

Public Property Let Phase(ByVal New_Phase As String)
    PHASE_LUNE = Val(New_Phase)
    PropertyChanged "Phase"
    Call AfficherLune(PHASE_LUNE)
End Property

'------------------------ CODE DE LA FONCTION PhaseLune(Date) ------------------

Option Explicit

Const CYCLE_LUNE = 42524    '24h 12h 44mn  Cycle synodique moyen de la Lune

Function PhaseLune(DtValue As Date) As Single
    Dim DATE_REF As Date 'date de référence si possible de source sûre
    Dim LngIntervalleMinutes As Long
    Dim LngPhase As Long
    
    DATE_REF = "26/09/2003"
    
LngIntervalleMinutes = DateDiff("n", DATE_REF, DtValue)

LngPhase = LngIntervalleMinutes Mod CYCLE_LUNE

PhaseLune = 2 * (LngPhase / CYCLE_LUNE) - 1

'Renvoit une valeur entre -1 et 1
        '-1,00 :    nouvelle lune
        '-0,75 :    premier croissant
        '-0,50 :    premier quartier
        '-0,25 :    lune gibbeuse
        '0 :        pleine lune
        '0,25 :     lune gibbeuse
        '0,50 :     dernier quartier
        '0,75 :     dernier croissant
        '1,00 :     nouvelle lune

End Function

Conclusion :


J'ai essayé de commenter au maximum la source mais si quelque chose reste obscur, n'hésitez pas à me demander (francois.brouet@laposte.net)
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 (fbrt)