الدرس الـ12 من دورة احتراف الفجوال بيسك 6 (طرق أستخراج ألالوان وعمل التدرجات الونية المختلفة )

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

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

كود:

Picture1.BackColor = QBColor(Number)

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

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


ملاحظة هامة: هذه الطرريقة تحتاج إلى إضافة اداة من اللوحة Components التي تحدثنا عنها سابقا اسم الأداة 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

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

كود:

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

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

لتدرج من أزرق إلى أسود :
Call XFormBlueFade(Me) 'Makes it Fade Blue

لتدرج من الأصفر إلى الاحمر :
Call XFormFireFade(Me) 'Makes it FIRE!! My FAV

لتدرج من أخضر فاتح إلى أخضر غامق :
Call XFormGreenFade(Me) 'Makes it Fade Green

لتدرج من بني إلى أزرق
Call XFormIceFade(Me) 'Makes it Fade ICE

لتدرج من بنفسجي لامع إلى أسود :
Call XFormPurpleFade(Me) 'Makes it Fade Purple

لتدرج من الأحمر إلى الأسود 
Call XFormRedFade(Me) 'Makes it Fade Red

لتدرج من الأبيض إلى الأسود :
Call XFormSilverFade(Me) 'Makes it Fade Silver

عسى أن يكون في هذا الدرس المتعة و الفائدة ..