بسم الله الرحمن الرحيم .

هذا الدرس ومجموعة أخرى من الدروس كنت قد اضفتها في منتدى vb4arab تحت اسم ( فتى فيجوال ) قبل اغلاقه .
 

المقدمة :

أقدم إخواني درس بسيط جداً حول طرق تعيين الألوان في فيجوال بيسك وبعض طرق الإستفادة من الألوان وبعض المواضيع المتعلقة . أتمنى أن يجد إخواني المبتدئين فيه الإفادة .

 الدرس :

أولاً : الألوان باستخدام QBColor :
تضم هذه الطريقة خمسة عشر لوناً تبدأ من الصفر وحتى 15 ولكل رقم لون معين ، ويمكن الحصول على الألوان من هذه القائمة بالطريقة التالية :

Picture1.BackColor = QBColor(Number)

حيث Number هو رقم بين 0 و 15 .

ثانياً : اختيار الألوان من مربعات الحوار .

مربعات الحوار أو CommonDialog تحتوي على أكثر من  شاشة مثل شاشة حفظ وفتح والخطوط وغيرها ، ومن ضمنها لوح الألوان ، ويمكن الإستفادة من هذه الأداة في الألوان بالطريقة التالية :
أضف الأداة إلى النموذج ثم اكتب الكود التالي  :
 

\' لتغيير عنوان مربع الحوار
CommonDialog1.DialogTitle = \"اختر اللون الذي تريد\"
\' لعرض مربع ( لوحة الألوان )
CommonDialog1.ShowColor
\' لعرض رقم اللون في رسالة
MsgBox CommonDialog1.Color
\' وتغيير لون الفورم حسب اللون المختار .
Form1.BackColor = CommonDialog1.Color

ثالثاً : معرفة رمز اللون .
بفرض أن لدينا لون هو خلفية الفورم فيمكن معرفة رمز اللون ( غير رقمه ) بالشكل التالي :
 

Dim MyColor
    MyColor = Form1.BackColor

Dim Red_C, Green_C, Blue_C

    Red_C = (MyColor And &HFF&)
    Green_C = (MyColor And &HFF00&) \\ 256
    Blue_C = (MyColor And &HFF0000) \\ 65536
   
    Dim Color_1
    Color_1 = Format(Hex(Red_C) &

Hex(Green_C) & Hex(Blue_C), \"000000\")

MsgBox Color_1

رابعاً : تكوين لون من تغير تركيز الألوان الأساسية ( أحمر + أخضر + أزرق ) .
اضف ثلاثة من أدوات HScrollBar واجعل خاصية Max لها = 255 ( واحدة لتغيير تركيز كل لون ) .
ثم ضع الكود التالي في حدث HScroll_Change

Form1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)

وهكذا ستجد أن لون الفورم يتغير بتغير نسبة الألوان الأساسية فيه .
 

TextRed.Text = (Form1.BackColor And &HFF&)
TextGreen.Text = (Form1.BackColor And &HFF00&) \\ 256
TextBlue.Text = (Form1.BackColor And &HFF0000) \\ 65536
 

خامساً : معرفة تركيز الألوان الأساسية في أي لون ، وهي عملية عكسية للعملية السابقة .

سادساً : معرفة لون النقطة التي يمر بها الماوس

اكتب أولاً الأوامر التالية في الجينرال :

\' لمعرفة نقطة الماوس
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
\' =========================================
 Private Declare Function GetPixel Lib \"gdi32\" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
 Private Declare Function GetCursorPos Lib \"user32\" (lpPoint As POINTAPI) As Long
 Private Declare Function GetWindowDC Lib \"user32\" (ByVal hwnd As Long) As Long

ومن ثم اكتب الأمر التالي في تايمر :

Dim tPOS As POINTAPI
Dim sTmp As String
Dim lColor As Long
Dim lDC As Long
Dim thecolor
lDC = GetWindowDC(0)
Call GetCursorPos(tPOS)
lColor = GetPixel(lDC, tPOS.x, tPOS.y)
Form1.BackColor = lColor

أكواد متنوعة تتعلق بالألوان :

* لعمل خلفية متدرجة بالأزرق مثل برامج التنصيب :

Sub Fade(vForm As Form)
Dim intLoop As Integer
vForm.DrawStyle = vbInsideSolid
vForm.DrawMode = vbCopyPen
vForm.ScaleMode = vbPixels
vForm.DrawWidth = 2
vForm.ScaleHeight = 256
For intLoop = 0 To 255
vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(0, 0, 255 - intLoop), B
Next intLoop
End Sub
Private Sub Form_Activate()
Fade Me
End Sub

* لعمل خلفية متدرجة بالرمادي :

Private Sub Command1_Click()
Picture1.ScaleMode = vbPixels
x = Picture1.ScaleWidth
y = Picture1.ScaleHeight
For i = 0 To y - 1
For j = 0 To x - 1
pixel = Picture1.Point(j, i)
red = pixel Mod 256
green = ((pixel And &HFF00) / 256) Mod 256
blue = (pixel And &HFF0000) / 65536
g = ((red * 30) + (green * 60) + (blue * 20)) / 100
Picture1.PSet (j, i), RGB(g, g, g)
Next
Next
Picture1.ScaleMode = vbTwips
End Sub
 

* لعمل فورم بلون رخامي :

اكتب الأوامر التالي في التصاريح
 

Private Sub GradientFill()
Dim i As Long
Dim c As Integer
Dim r As Double
r = ScaleHeight / 3.142
For i = 0 To ScaleHeight
c = Abs(220 * Sin(i / r))
Me.Line (0, i)-(ScaleWidth, i), RGB(c, c, c + 30) \'Notice the bias To blue. You can be more subtle by reducing this number (try 10). Try other colours too.
Next
End Sub

وفي حدث  Form_Resize

GradientFill
 

* لعمل فورم بلون قوس المطر :

Option Explicit
Private Sub Form_Load()
    Me.AutoRedraw = True
    Me.ScaleMode = vbTwips
    Me.Caption = \"Rainbow Generator by \" & _
    \"K. O. Thaha Hussain\"
End Sub

Private Sub Form_Resize()
    Call Rainbow
End Sub

Private Sub Rainbow()
    On Error Resume Next
    Dim Position As Integer, Red As Integer, Green As _
    Integer, Blue As Integer
    Dim ScaleFactor As Double, Length As Integer
    ScaleFactor = Me.ScaleWidth / (255 * 6)
    Length = Int(ScaleFactor * 255)
    Position = 0
    Red = 255
    Blue = 1
    \'Purposfully avoided nested loops
    \'------------- 1

    For Green = 1 To Length
        Me.Line (Position, 0)-(Position, Me.ScaleHeight), _
        RGB(Red, Green \\ ScaleFactor, Blue)
        Position = Position + 1
    Next Green
    \'--------------- 2

    For Red = Length To 1 Step -1
        Me.Line (Position, 0)-(Position, Me.ScaleHeight), _
        RGB(Red \\ ScaleFactor, Green, Blue)
        Position = Position + 1
    Next Red
    \'---------------- 3

    For Blue = 0 To Length
        Me.Line (Position, 0)-(Position, Me.ScaleHeight), _
        RGB(Red, Green, Blue \\ ScaleFactor)
        Position = Position + 1
    Next Blue
   
    \'----------------- 4

    For Green = Length To 1 Step -1
        Me.Line (Position, 0)-(Position, Me.ScaleHeight), _
        RGB(Red, Green \\ ScaleFactor, Blue)
        Position = Position + 1
    Next Green
   
    \'------------------ 5

    For Red = 1 To Length
        Me.Line (Position, 0)-(Position, Me.ScaleHeight), _
        RGB(Red \\ ScaleFactor, Green, Blue)
        Position = Position + 1
    Next Red
    \'------------------- 6

    For Blue = Length To 1 Step -1
        Me.Line (Position, 0)-(Position, Me.ScaleHeight), _
        RGB(Red, Green, Blue \\ ScaleFactor)
        Position = Position + 1
    Next Blue
End Sub
 

* سبع تدريجات مختلفة للفورم :
نكتب ما يلي في قسم التصاريح
 

Sub XFormBlueFade(vForm As Object)
    On Error Resume Next
    Dim intLoop As Integer
    vForm.DrawStyle = vbInsideSolid
    vForm.DrawMode = vbCopyPen
    vForm.ScaleMode = vbPixels
    vForm.DrawWidth = 2
    vForm.ScaleHeight = 256

    For intLoop = 0 To 255
        vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(0, 0, 255 - intLoop), B \'Draw boxes With specified color of loop
    Next intLoop
End Sub

Sub XFormFireFade(vForm As Object)
    \'This code works best when called in the
    \'
    \' paint event
    On Error Resume Next
    Dim intLoop As Integer
    vForm.DrawStyle = vbInsideSolid
    vForm.DrawMode = vbCopyPen
    vForm.ScaleMode = vbPixels
    vForm.DrawWidth = 2
    vForm.ScaleHeight = 256

    For intLoop = 0 To 255
        vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(255, 255 - intLoop, 0), B \'Draw boxes With specified color of loop
    Next intLoop
End Sub

Sub XFormGreenFade(vForm As Object)
    On Error Resume Next
    Dim intLoop As Integer
    vForm.DrawStyle = vbInsideSolid
    vForm.DrawMode = vbCopyPen
    vForm.ScaleMode = vbPixels
    vForm.DrawWidth = 2
    vForm.ScaleHeight = 256

    For intLoop = 0 To 255
        vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(0, 255 - intLoop, 0), B \'Draw boxes With specified color of loop
    Next intLoop
End Sub

Sub XFormIceFade(vForm As Object)
    On Error Resume Next
    Dim intLoop As Integer
    vForm.DrawStyle = vbInsideSolid
    vForm.DrawMode = vbCopyPen
    vForm.ScaleMode = vbPixels
    vForm.DrawWidth = 2
    vForm.ScaleHeight = 256

    For intLoop = 0 To 255
        vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(0, 255 - intLoop, 255), B \'Draw boxes With specified color of loop
    Next intLoop
End Sub

Sub XFormPurpleFade(vForm As Object)
    On Error Resume Next
    Dim intLoop As Integer
    vForm.DrawStyle = vbInsideSolid
    vForm.DrawMode = vbCopyPen
    vForm.ScaleMode = vbPixels
    vForm.DrawWidth = 2
    vForm.ScaleHeight = 256

    For intLoop = 0 To 255
        vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(25, 0, 100 - intLoop), B \'Draw boxes With specified color of loop
    Next intLoop
End Sub

Sub XFormRedFade(vForm As Object)
    On Error Resume Next
    Dim intLoop As Integer
    vForm.DrawStyle = vbInsideSolid
    vForm.DrawMode = vbCopyPen
    vForm.ScaleMode = vbPixels
    vForm.DrawWidth = 2
    vForm.ScaleHeight = 256

    For intLoop = 0 To 255
        vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(255 - intLoop, 0, 0), B \'Draw boxes With specified color of loop
    Next intLoop
End Sub

Sub XFormSilverFade(vForm As Object)
    On Error Resume Next
    Dim intLoop As Integer
    vForm.DrawStyle = vbInsideSolid
    vForm.DrawMode = vbCopyPen
    vForm.ScaleMode = vbPixels
    vForm.DrawWidth = 2
    vForm.ScaleHeight = 256

    For intLoop = 0 To 255
        vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(255 - intLoop, 255 - intLoop, 255 - intLoop), B \'Draw boxes With specified color of loop
    Next intLoop
End Sub
 

كل اجراء من الإجراءات السابقة يعطينا تدرجاً معينا كما يلي :

لتدرج من أزرق إلى أسود :

   Call XFormBlueFade(Me) \'Makes it Fade Blue

لتدرج من الأصفر إلى الاحمر :

 Call XFormFireFade(Me) \'Makes it FIRE!!

لتدرج من أخضر فاتح إلى أخضر غامق :

  Call XFormGreenFade(Me) \'Makes it Fade Green

لتدرج من بني إلى أزرق

    Call XFormIceFade(Me) \'Makes it Fade ICE

* لعمل 38 خلفية للفورم مشكلة من تداخل اللونين الأصفر والأحمر :
 

Dim FadeNumPos As Integer
\'The First RGB Values
Dim R1 As Integer, G1 As Integer, B1 As Integer
\'The Second RGB Values
Dim R2 As Integer, G2 As Integer, B2 As Integer
\'These are the RGB values for the curren
\'     t line
Dim NewRed As Integer, NewGreen As Integer, NewBlue As Integer
\'Easier than an array to store a color
Public FadeColors As New Collection
\'The Difference
Dim OverAllDiff
\'This is the long value for the line col
\'     or
Dim NewColor
\'Gets the colors ready to draw the line
\'Then calls on the effect sub to make th
\'     e gradient

Public Function Gradeffect(Target As Object, style As Integer)
    \'Clear the object
    Target.Cls
    \'Get the fade count
    FadeTimes = FadeColors.Count - 1
    \'Set the draw width for the line
    Target.DrawWidth = 1
    \'Want auto redraw
    Target.AutoRedraw = True
    \'Don\'t Modify these. Won\'t work without
    \'     them
    Target.ScaleWidth = 255 \'No modifying
    Target.ScaleHeight = Target.ScaleWidth \'No modifying
    \'do each color

    For FadeNumPos = 1 To FadeTimes
        \'Set the Start values
        R1 = R2
        G1 = G2
        B1 = B2
        \'Set the Start values for the first colo
        \'     r

        If FadeNumPos = 1 Then
            R1 = FadeColors(1) Mod &H100
            G1 = (FadeColors(1) \\ &H100) Mod &H100
            B1 = (FadeColors(1) \\ &H10000) Mod &H100
        End If
        \'Set the End values
        R2 = FadeColors(FadeNumPos + 1) Mod &H100
        G2 = (FadeColors(FadeNumPos + 1) \\ &H100) Mod &H100
        B2 = (FadeColors(FadeNumPos + 1) \\ &H10000) Mod &H100
        \'Get the differences
        RedDiff = (R1 - R2) / Target.ScaleHeight * FadeTimes
        GreenDiff = (G1 - G2) / Target.ScaleHeight * FadeTimes
        BlueDiff = (B1 - B2) / Target.ScaleHeight * FadeTimes
        \'For each line

        For OverAllDiff = ((FadeNumPos - 1) * Target.ScaleWidth / FadeTimes) To (FadeNumPos * Target.ScaleHeight / FadeTimes)
            \'Get the new RGB values
            NewRed = R1 - RedDiff * (OverAllDiff - ((FadeNumPos - 1) * Target.ScaleWidth / FadeTimes))
            NewGreen = G1 - GreenDiff * (OverAllDiff - ((FadeNumPos - 1) * Target.ScaleWidth / FadeTimes))
            NewBlue = B1 - BlueDiff * (OverAllDiff - ((FadeNumPos - 1) * Target.ScaleWidth / FadeTimes))
            \'Set the color
            NewColor = RGB(NewRed, NewGreen, NewBlue)
            \'Do the effect
            Effect Target, style
            \'Next Line
        Next
        \'Next color
    Next
    \'Done here
End Function
\'The effect

Function Effect(Target As Object, kind As Integer)
    \'There are 36 different gradients. Try t
    \'     hem all

    Select Case kind
        \'Clockwork Down - Cool and New
        Case 1
        Target.Line (OverAllDiff + 1, Target.ScaleHeight)-(Target.ScaleWidth - OverAllDiff, OverAllDiff), NewColor, BF
        \'Clockwork Left - Cool and new!
        Case 2
        Target.Line (0, Target.ScaleWidth - OverAllDiff)-(Target.ScaleWidth - OverAllDiff, OverAllDiff), NewColor, BF
        \'Clockwork Up - Cool and new
        Case 3
        Target.Line (OverAllDiff, Target.ScaleHeight - OverAllDiff)-(Target.ScaleHeight, 0), NewColor, BF
        \'Clockwork Right
        Case 4
        Target.Line (OverAllDiff, Target.ScaleHeight - OverAllDiff)-(Target.ScaleHeight, OverAllDiff), NewColor, BF
        \'Right to Left
        Case 5
        Target.Line (Target.ScaleWidth - OverAllDiff, 0)-(Target.ScaleWidth - OverAllDiff, Target.ScaleHeight - 20), NewColor, BF
        \'Left to Right
        Case 6
        Target.Line (OverAllDiff, 0)-(OverAllDiff + 1, Target.ScaleWidth), NewColor, BF
        \'Fade Out from bottom right
        Case 7
        Target.Line (0, Target.ScaleHeight - OverAllDiff)-(Target.ScaleWidth, Target.ScaleHeight - (OverAllDiff + 1)), NewColor, BF
        Target.Line (Target.ScaleWidth - OverAllDiff, 0)-(Target.ScaleWidth - (OverAllDiff + 1), Target.ScaleHeight), NewColor, BF
        \'Fade Out from bottom left
        Case 8
        Target.Line (0, Target.ScaleHeight - OverAllDiff)-(Target.ScaleWidth, Target.ScaleHeight - (OverAllDiff + 1)), NewColor, BF
        Target.Line (OverAllDiff, 0)-(OverAllDiff + 1, Target.ScaleHeight), NewColor, BF
        \'Fade Out from top left
        Case 9
        Target.Line (0, OverAllDiff)-(Target.ScaleWidth, OverAllDiff + 1), NewColor, BF
        Target.Line (OverAllDiff, 0)-(OverAllDiff + 1, Target.ScaleHeight), NewColor, BF
        \'Fade Out from top right
        Case 10
        Target.Line (0, OverAllDiff)-(Target.ScaleWidth, OverAllDiff + 1), NewColor, BF
        Target.Line (Target.ScaleWidth - OverAllDiff, 0)-(Target.ScaleWidth - OverAllDiff, Target.ScaleHeight - 20), NewColor, BF
        \'Fade Out from center
        Case 11
        Target.Line (Int(Target.ScaleWidth / 2 - OverAllDiff / 2), Int(Target.ScaleHeight / 2 - OverAllDiff / 2))-(Target.ScaleWidth / 2 + OverAllDiff / 2, Target.ScaleHeight / 2 + OverAllDiff / 2), NewColor, B
        \'Fade In from bottom right
        Case 12
        Target.Line (OverAllDiff, Target.ScaleWidth)-(Target.ScaleWidth, OverAllDiff + 1), NewColor, BF
        \'Fade In from bottom left
        Case 13
        Target.Line (0, Target.ScaleHeight)-(Target.ScaleWidth - OverAllDiff, OverAllDiff), NewColor, BF
        \'Fade In from top left
        Case 14
        Target.Line (0, 0)-(Target.ScaleWidth - OverAllDiff, Target.ScaleHeight - OverAllDiff), NewColor, BF
        \'Fade In from top right
        Case 15
        Target.Line (Target.ScaleWidth, 0)-(OverAllDiff, Target.ScaleHeight - OverAllDiff), NewColor, BF
        \'Boxes 1
        Case 16
        Target.Line (Target.ScaleWidth, 0)-(OverAllDiff, Target.ScaleHeight - OverAllDiff), NewColor, BF
        Target.Line (0, Target.ScaleHeight)-(Target.ScaleWidth - OverAllDiff, OverAllDiff), NewColor, BF
        \'Boxes 2
        Case 17
        Target.Line (Target.ScaleWidth, 0)-(OverAllDiff, Target.ScaleHeight - OverAllDiff), NewColor, BF
        Target.Line (OverAllDiff, Target.ScaleWidth)-(Target.ScaleWidth, OverAllDiff + 1), NewColor, BF
        \'Boxes 3
        Case 18
        Target.Line (Target.ScaleWidth, 0)-(OverAllDiff, Target.ScaleHeight - OverAllDiff), NewColor, BF
        Target.Line (0, Target.ScaleHeight)-(Target.ScaleWidth - OverAllDiff, OverAllDiff), NewColor, BF
        Target.Line (OverAllDiff, Target.ScaleWidth)-(Target.ScaleWidth, OverAllDiff + 1), NewColor, BF
        \'Boxes 4
        Case 19
        Target.Line (0, Target.ScaleHeight)-(Target.ScaleWidth - OverAllDiff, OverAllDiff), NewColor, BF
        Target.Line (OverAllDiff, Target.ScaleWidth)-(Target.ScaleWidth, OverAllDiff + 1), NewColor, BF
        \'Boxes 5
        Case 20
        Target.Line (Target.ScaleWidth, 0)-(OverAllDiff, Target.ScaleHeight - OverAllDiff), NewColor, BF
        Target.Line (0, 0)-(Target.ScaleWidth - OverAllDiff, Target.ScaleHeight - OverAllDiff), NewColor, BF
        \'Boxes 6
        Case 21
        Target.Line (0, Target.ScaleHeight)-(Target.ScaleWidth - OverAllDiff, OverAllDiff), NewColor, BF
        Target.Line (0, 0)-(Target.ScaleWidth - OverAllDiff, Target.ScaleHeight - OverAllDiff), NewColor, BF
        \'Boxes 7
        Case 22
        Target.Line (OverAllDiff, Target.ScaleWidth)-(Target.ScaleWidth, OverAllDiff + 1), NewColor, BF
        Target.Line (0, 0)-(Target.ScaleWidth - OverAllDiff, Target.ScaleHeight - OverAllDiff), NewColor, BF
        \'Boxes 8
        Case 23
        Target.Line (0, 0)-(Target.ScaleWidth - OverAllDiff, Target.ScaleHeight - OverAllDiff), NewColor, BF
        Target.Line (Target.ScaleWidth, 0)-(OverAllDiff, Target.ScaleHeight - OverAllDiff), NewColor, BF
        Target.Line (0, Target.ScaleHeight)-(Target.ScaleWidth - OverAllDiff, OverAllDiff), NewColor, BF
        Target.Line (OverAllDiff, Target.ScaleWidth)-(Target.ScaleWidth, OverAllDiff + 1), NewColor, BF
        \'Top to Bottom
        Case 24
        Target.Line (0, OverAllDiff)-(Target.ScaleWidth, OverAllDiff + 1), NewColor, BF
        \'Bottom to Top
        Case 25
        Target.Line (0, 0)-(Target.ScaleWidth, Target.ScaleHeight - OverAllDiff), NewColor, BF
        \'Refraction
        Case 26
        Target.Line (Target.ScaleWidth - OverAllDiff, OverAllDiff)-(Target.ScaleWidth - OverAllDiff, Target.ScaleHeight), NewColor, BF
        Target.Line (OverAllDiff, Target.ScaleHeight - OverAllDiff)-(Target.ScaleHeight, OverAllDiff), NewColor, BF
        \'Line through middle
        Case 27
        Target.Line ((Target.ScaleWidth / 2) - (OverAllDiff / 2), 0)-((Target.ScaleWidth / 2) - (OverAllDiff / 2), Target.ScaleHeight), NewColor, BF
        Target.Line ((Target.ScaleWidth / 2) + (OverAllDiff / 2), 0)-((Target.ScaleWidth / 2) + (OverAllDiff / 2), Target.ScaleHeight), NewColor, BF
        \'Exploded
        Case 28
        Target.Line (Target.ScaleWidth, OverAllDiff / 2)-(OverAllDiff, Target.ScaleHeight - OverAllDiff), NewColor, BF
        Target.Line (0, Target.ScaleHeight)-(Target.ScaleWidth - OverAllDiff, OverAllDiff), NewColor, BF
        \'Pouring
        Case 29
        Target.Line (Target.ScaleWidth, 0)-(OverAllDiff, Target.ScaleHeight), NewColor, BF
        Target.Line (0, Target.ScaleHeight)-(Target.ScaleWidth - OverAllDiff, OverAllDiff), NewColor, BF
        \'lighthouse
        Case 30
        Target.Line (Target.ScaleWidth, OverAllDiff / 2)-(OverAllDiff, Target.ScaleHeight - OverAllDiff), NewColor, BF
        \'Square
        Case 31
        Target.Line (OverAllDiff / 2, Target.ScaleWidth)-(Target.ScaleWidth, OverAllDiff + 1), NewColor, BF
        \'Ripped
        Case 32
        Target.Line ((Target.ScaleHeight * OverAllDiff), OverAllDiff)-(OverAllDiff, Target.ScaleWidth + OverAllDiff), NewColor, BF
        \'Prism
        Case 33
        Target.Line (Target.ScaleWidth - OverAllDiff, OverAllDiff)-(Target.ScaleWidth - OverAllDiff, Target.ScaleHeight), NewColor, BF
        Target.Line (OverAllDiff, Target.ScaleHeight - OverAllDiff)-(Target.ScaleHeight - OverAllDiff, 0), NewColor, BF
        \'Top left to bottom right
        Case 34
        Target.Line (0, OverAllDiff * 2)-(OverAllDiff * 2, 0), NewColor
        \'Fade to center from top right and botto
        \'     m left
        Case 35
        Target.AutoRedraw = False
        Target.Line (0, Target.ScaleHeight - OverAllDiff)-(OverAllDiff, Target.ScaleHeight), NewColor
        Target.Line (Target.ScaleWidth - OverAllDiff, 0)-(Target.ScaleWidth, OverAllDiff), NewColor
        \'Fade to center from top left and bottom
        \'     right
        Case 36
        Target.Line (Target.ScaleWidth, Target.ScaleHeight - OverAllDiff)-(Target.ScaleWidth - OverAllDiff, Target.ScaleHeight), NewColor
        Target.Line (0, OverAllDiff)-(OverAllDiff, 0), NewColor
        \'Wow I\'m finally done!
    End Select
End Function

Function nolic(Target As Object)
    Target.FontSize = 10
    Target.ForeColor = vbBlack
    Target.CurrentY = 0
    Target.CurrentX = 2
    Target.Print \"Created With a SpiderTek Product\"
    Target.ForeColor = vbWhite
    Target.CurrentY = 0
    Target.CurrentX = 3
    Target.Print \"Created With a SpiderTek Product\"
End Function

Private Sub Form_Click()
    Static x As Integer
    If x = 36 Then x = 0
    x = x + 1
    Gradeffect Me, x
    Me.CurrentY = 200
    Me.CurrentX = 3
    Me.Print \"You are at \"\"\" & x & \"\"\" of 36 total effects.\"
    nolic Me
End Sub

Private Sub Form_Load()
    FadeColors.Add vbBlack
    FadeColors.Add vbRed
    FadeColors.Add vbYellow
    FadeColors.Add vbWhite
    Gradeffect Me, 1
End Sub

Private Sub Form_Resize()
    Gradeffect Me, 1
End Sub
 

الرقم ( 1 ) السابق هو الذي يحدد شكل التداخل بتغيير البارميتر المرسل إلى الإجراء ، وهو يتراوح بين 1 و 38 على الشكل التالي كمثال :

1 - 4 مثلث أصفر ، وتدرج من الأحمر إلى الأسود ( الإختلاف في جهة الملثلث )
5 تدرج من الأحمر للأصفر متقطع
6 تدرج من الأبيض للأسود مروراً بالأحمر والأصفر صافي أفقي
7 مثل السابق من زاوية
8 - 10 من زاوية مع تقطع
11 من الوسط ( نصف مقطع ونصف صافي ) .
12 - 16 من زوايا ولكن الفورم مقسوم نصفين من زاويتين
17 ليس مقسوماً من النصف ولكن من جهة واحدة
18 من ثلاث جهات

خاتمة :

ملحوظة هامة جداً : أكواد القسم الثاني والتي يختص أغلبها بالتداخلات أعدها أخوة كرام في منتدى vb4arab وغيره ، فلهم جزيل الشكر .

في نهاية هذا الدرس نكون قد تعلمنا أساليب عديدة لانتقاء الألون خلال الفيجوال بيسك . وبعض العمليات على الألوان ، اضافة لعدد من التدرجات اللونية المختلفة .

والسلام عليكم ورحمة الله وبركاته .

الألوان من خلال فيجوال بيسك