Simple mais puissant dégradé

Télécharger le projet
Commenter

Description

Petit programme qui dessine un dégradé en deux couleurs choisies avec un nombre de traits choisi en décomposant la couleur.
Il n'y a pas de commentaires mais je pense que c'est assez clair.
La source est en VB 3 mais le code est compatible VB 6.

Le Zip contient :
- le fichier présenté ci-dessous (la feuille)
- le fichier projet (sert pas à grand chose)
- les 5 EXE des 5 versions
taille : 15,1 Ko (3 sec max).

Source / Exemple : 


VERSION 2.00
Begin Form Feuille1 
   BackColor       =   &H8000000F&
   Caption         =   "Dégradé"
   ClientHeight    =   4020
   ClientLeft      =   1905
   ClientTop       =   2145
   ClientWidth     =   6915
   Height          =   4425
   Left            =   1845
   LinkTopic       =   "Feuille1"
   ScaleHeight     =   268
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   461
   Top             =   1800
   Width           =   7035
   Begin CommandButton Commande1 
      Caption         =   "OK"
      Default         =   -1  'True
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   3960
      TabIndex        =   3
      Top             =   90
      Width           =   1185
   End
   Begin TextBox nb 
      Alignment       =   1  'Justifié à droite
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   285
      Left            =   90
      MaxLength       =   5
      TabIndex        =   1
      Text            =   "250"
      Top             =   120
      Width           =   825
   End
   Begin PictureBox Limage 
      AutoRedraw      =   -1  'True
      Height          =   3360
      Left            =   0
      ScaleHeight     =   222
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   498
      TabIndex        =   0
      Top             =   630
      Width           =   7500
   End
   Begin CommonDialog Dialog 
      CancelError     =   -1  'True
      DialogTitle     =   "Programme de Mehdi - Couleurs"
      Flags           =   3
      Left            =   900
      Top             =   630
   End
   Begin Label coul 
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Trait simple fixe
      Height          =   465
      Index           =   0
      Left            =   2430
      TabIndex        =   4
      Top             =   90
      Width           =   465
   End
   Begin Label Etiquette1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "traits                   de               à"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   195
      Left            =   990
      TabIndex        =   2
      Top             =   180
      Width           =   2130
   End
   Begin Label coul 
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Trait simple fixe
      Height          =   465
      Index           =   1
      Left            =   3240
      TabIndex        =   5
      Top             =   90
      Width           =   465
   End
End
Dim touche As Integer

Sub Commande1_Click ()
screen.MousePointer = 11
limage.AutoRedraw = False
n = Val(nb)
Me.Caption = "Dégradé de #" & UCase$(Hex$(coul(0).BackColor)) & " à #" & UCase$(Hex$(coul(1).BackColor)) & " en " & CStr(n) & " traits"
ReDim colo(1 To 6)
colo(3) = coul(0).BackColor \ 256 \ 256
colo(2) = coul(0).BackColor \ 256 Mod 256
colo(1) = coul(0).BackColor Mod 256 Mod 256
colo(6) = coul(1).BackColor \ 256 \ 256
colo(5) = coul(1).BackColor \ 256 Mod 256
colo(4) = coul(1).BackColor Mod 256 Mod 256
limage.Cls
w = limage.Width
h = limage.Height
Dim r As Integer, g As Integer, b As Integer
If n <> 1 Then
    For i = 0 To n - 1
    r = Int((colo(1) * (n - i - 1) + colo(4) * (i)) / (n - 1))
    g = Int((colo(2) * (n - i - 1) + colo(5) * (i)) / (n - 1))
    b = Int((colo(3) * (n - i - 1) + colo(6) * (i)) / (n - 1))
    limage.Line (CSng(i / n * w), 0)-(CSng((i + 1) / n * w), h / 6 - .1), RGB(r, 0, 0), BF
    limage.Line (CSng(i / n * w), h / 6)-(CSng((i + 1) / n * w), h / 3 - .1), RGB(0, g, 0), BF
    limage.Line (CSng(i / n * w), h / 3)-(CSng((i + 1) / n * w), h / 2 - .1), RGB(0, 0, b), BF
    limage.Line (CSng(i / n * w), h / 2)-(CSng((i + 1) / n * w), h - .1), RGB(r, g, b), BF
    Next i
Else
    r = (colo(1) + colo(4)) / 2
    g = (colo(2) + colo(5)) / 2
    b = (colo(3) + colo(6)) / 2
    limage.Line (0, 0)-(w, h / 6 - .1), RGB(r, 0, 0), BF
    limage.Line (0, h / 6)-(w, h / 3 - .1), RGB(0, g, 0), BF
    limage.Line (0, h / 3)-(w, h / 2 - .1), RGB(0, 0, b), BF
    limage.Line (0, h / 2)-(w, h - .1), RGB(r, g, b), BF
End If
limage.AutoRedraw = True
screen.MousePointer = 0
End Sub

Sub coul_Click (index As Integer)
On Error Resume Next
dialog.Color = coul(index).BackColor
dialog.Action = 3
If Err = 32755 Then Exit Sub
coul(index).BackColor = dialog.Color
End Sub

Sub Form_Resize ()
If Me.Width < 5410 Then Me.Width = 5430
If Me.Height < 2330 Then Me.Height = 2350
limage.Width = Me.ScaleWidth
limage.Height = Me.ScaleHeight - 42
End Sub

Sub nb_KeyDown (keycode As Integer, Shift As Integer)
touche = IIf(keycode = 8, True, False)
End Sub

Sub nb_KeyPress (keyascii As Integer)
If (keyascii < 48 Or keyascii > 57) And touche <> True Then keyascii = 0
End Sub

Conclusion :


pour + d'infos, contactez moi.
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_mehdibou)