Visual Basic World, Visual basic 6 et .net Visual Basic 6 et .net World
Revenir à la liste des sources


puceCode source n°3 : Dégradé de couleurs sans les API
Auteur : P. Cuisinaud Codes source visual studio .net codevb5.zip - Taille : 3 Ko
Sub Fade(obj As Object, Optional vRed As Variant, Optional vGreen As Variant,  _
    Optional vBlue As Variant, Optional vVert As Variant, Optional vHoriz As Variant,  _
    Optional vLightToDark As Variant)
    ' Donne des valeures par défaut aux paramètres optionnels
    If IsMissing(vRed) Then vRed = False
    If IsMissing(vBlue) Then vBlue = False
    If IsMissing(vGreen) Then vGreen = False
    If Not vRed And Not vGreen Then vBlue = True ' Une couleur est requise
    If IsMissing(vVert) Then vVert = False
    If IsMissing(vHoriz) Then vHoriz = Not vVert
    If Not vVert And Not vHoriz Then vHoriz = True ' Une orientation est requise
    If IsMissing(vLightToDark) Then vLightToDark = True
    ' Gestion des erreurs
    On Error Resume Next
    With obj
        'Sauve les propriétés
        Dim fAutoRedraw As Boolean, ordDrawStyle As Integer
        Dim ordDrawMode As Integer, iDrawWidth As Integer
        Dim ordScaleMode As Integer
        Dim rScaleWidth As Single, rScaleHeight As Single
        fAutoRedraw = .AutoRedraw
        iDrawWidth = .DrawWidth
        ordDrawStyle = .DrawStyle
        ordDrawMode = .DrawMode
        rScaleWidth = .ScaleWidth
        rScaleHeight = .ScaleHeight
        ordScaleMode = .ScaleMode
        ' Une erreur est générée si une des propriétés est manquante
        If Err Then Exit Sub
        On Error GoTo 0
        fAutoRedraw = .AutoRedraw
        ' On fixe les paramètres pour le dégradé
        .AutoRedraw = True
        .DrawWidth = 2
        .DrawStyle = vbInsideSolid
        .DrawMode = vbCopyPen
        .ScaleMode = vbPixels
        .ScaleWidth = 256 * 2
        .ScaleHeight = 256 * 2
        Dim Clr As Long, I As Integer, X As Integer, Y As Integer
        Dim IRed As Integer, IGreen As Integer, IBlue As Integer
        For I = 0 To 255
            ' Fixe les couleurs des lignes
            If vLightToDark Then
                If vRed Then IRed = 255 - I
                If vBlue Then IBlue = 255 - I
                If vGreen Then IGreen = 255 - I
            Else
                If vRed Then IRed = I
                If vBlue Then IBlue = I
                If vGreen Then IGreen = I
            End If
            Clr = RGB(IRed, IGreen, IBlue)
            ' Dessine chaque ligne
            If vVert Then
                obj.Line (0, Y)-(.ScaleWidth, Y + 2), Clr, BF
                Y = Y + 2
            End If
            If vHoriz Then
                obj.Line (X, 0)-(X + 2, .ScaleHeight), Clr, BF
                X = X + 2
            End If
        Next
        ' Restore les propriétés précédentes
        .AutoRedraw = fAutoRedraw
        .DrawWidth = iDrawWidth
        .DrawStyle = ordDrawStyle
        .DrawMode = ordDrawMode
        .ScaleMode = ordScaleMode
        .ScaleWidth = rScaleWidth
        .ScaleHeight = rScaleHeight
    End With
End Sub


Principal (Principal.frm)


Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Form_Load()
         'Blanc   --> True,True,True
         'Jaune   --> True,True,False
         'Rouge   --> True,False,False
         'Magenta --> True,False,True
         'Cyan    --> False,True,True
         'Bleu    --> False,False,True
         'Vert    --> False,True,False
         'Sens = True  --> Couleur > Noir
         'Sens = False --> Noir > Couleur
         'Nom   Red    Green Blue   Horz. Vert.  Sens
    Fade Form1, False, True, False, True, False, True
    Fade Picture1, True, False, False, True, True, False
End Sub

Remonter