Option Explicit
Private Sub Form_Click()
   Dim x As Long, y As Long
             
    AutoRedraw = True
    ScaleMode = vbPixels
        
    Scale (0, -120)-(360, 120)
    BackColor = vbBlue
    
    'moon aspect
    Lune.Elongation = "Ouest"
    Lune.Fraction = 0.7
          

    'Moon Radius
    Dim diam As Integer
     diam = 50

    'centre of moon
    'with x=180 and y=0 the moon must be in the center of form, but it is not!
    'coordinates start from the upper left corner in this case.
    x = 150
    y = 100

    
    Dim ShowDarkMoon As Boolean
    Dim lRgn1 As Long, lRgn2 As Long, lRgn3 As Long

    '_____________
    'lune entiere
    lRgn1 = CreateEllipticRgn(0, 0, diam, diam)

    '__________________________
    'tracé de la partie sombre

    'déplacement à l'endroit voulu
    OffsetRgn lRgn1, x - diam / 2, y - diam / 2

    'brosse pour le tracé
    Dim lBrshDrk As Long
    If ShowDarkMoon Then
        lBrshDrk = CreateSolidBrush(&H404040)
    Else
        lBrshDrk = CreateSolidBrush(&H400000) 'pinf.BackGroundColor)
    End If

    'tracé
    FillRgn hdc, lRgn1, lBrshDrk
    DeleteObject lBrshDrk

    'retour en (0,0) pour la suite
    OffsetRgn lRgn1, -x + diam / 2, -y + diam / 2

    '___________________________________
    'cache rectangulaire pour la moitié
    lRgn3 = CreateRectRgn(0, 0, diam / 2, diam)
    If Lune.Elongation = "Ouest" Then _
        OffsetRgn lRgn3, diam / 2, 0                'repositionnement du cache
    CombineRgn lRgn1, lRgn1, lRgn3, RGN_DIFF        'on soustrait le cache à la lune

    '________________
    'région centrale
    lRgn2 = CreateEllipticRgn(diam * Lune.Fraction, 0, diam * (1 - Lune.Fraction), diam)
    If Lune.Fraction < 0.5 Then
        CombineRgn lRgn1, lRgn1, lRgn2, RGN_DIFF    'région centrale sombre
    Else
        CombineRgn lRgn1, lRgn1, lRgn2, RGN_OR      'région centrale éclairée
    End If

    '______________________________
    'déplacement à l'endroit voulu
    OffsetRgn lRgn1, x - diam / 2, y - diam / 2

    '______
    'tracé
    Dim lBrsh As Long
    lBrsh = CreateSolidBrush(vbWhite)               'brosse pour le tracé
    FillRgn hdc, lRgn1, lBrsh

    '____________________________
    'Suppression des objets créé
    DeleteObject lBrsh
    DeleteObject lRgn1
    DeleteObject lRgn2
    DeleteObject lRgn3


End Sub



'Module declarations API

Public Type Lune
    x As Double
    y As Double
    Ad As Double
    Dec As Double
    Lat As Double
    Lon As Double
    Elongation As String
    Fraction As Double
    Nom As String
End Type

Public Lune As Lune

'Déclaration des APIs Windows pour l'utilisation des régions

Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Public Declare Function OffsetRgn Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function PaintRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long

'CombineRgn nCombineMode flag constants
Public Const RGN_AND = 1
Public Const RGN_OR = 2
Public Const RGN_XOR = 3
Public Const RGN_DIFF = 4
Public Const RGN_COPY = 5

Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long