التعامل مع الألوان والتدرجات اللونية من خلال الفيجوال بيسك

[أحمد جمال]

بسم الله الرحمن الرحيم
أقدم إخواني درس بسيط جداً حول طرق تعيين الألوان في فيجوال بيسك
وبعض طرق الإستفادة من الألوان وبعض المواضيع المتعلقة . أتمنى أن
يجد إخواني المبتدئين فيه الإفادة .
أولاً : الألوان باستخدام 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!! 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
ملحوظة : بعض هذه الأكواد للأخوة الكرام أعضاء هذا المنتدى وغيره .

[العولقي11]

جزاك الله الف خير زمشكور على هذه الاكواد

[eng_mostafa]

جزاك الله عنا كل الخير

ولكن عند تطبيق الجزء الثانى فى الاداء

لايتم التطبيق وتظر رسائل خطأ كثيرة

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

ولو بعد الاذن تعطيى لنا مثال فى المرفقات لنرى او صور وجزاك الله عنا كل الخير

[real_pal]

يعطيك العافية اخي وان شاء الله رح استخدمها مشكور