thegust2000
07-04-2006, 08:48 AM
سأشرح لكم طريقة سهلة للغايه لربط برنامجك بإمتداد معين مثل برنامج Winamp وملفات mp3 مثلا .... ساستخدم الدوال RegCreateKey و RegSetValue قم بتشغيل فيجول بيسك على مشروع جديد إنسخ هذه الاعلانات إلى قسم الإعلانات فى الفورم الجديد Private Declare Function RegCreateKey Lib "advapi32.dll" _ Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal _ lpSubKey As String, phkResult As Long) As Long هذه الدالة تتطلب ثلاث توابع التابع الاول hKey وهو يمثل المفتاح الرئيسى أما التابع الثانى lpSubKey فيمثل المفتاح الفرعى المشتق من المفتاح الاول وهذا المفتاح هو الذى سيتم إنشاءة أما المفتاح الثالث فيمثل مؤشر للمفتاح الذى تم إنشاءة وسنستخدمة فى الدالة الثانية ( حرف P عندما يأتى فى دالة من دوال API فهو يدل على مؤشروهى كلمة مشهورة جداً فى لغة السى وهى تمثل عنوان فى الذاكرة ) Private Declare Function RegSetValue Lib "advapi32.dll" _ Alias "RegSetValueA" (ByVal hKey As Long, ByVal _ lpSubKey As String, ByVal dwType As Long, ByVal _ lpData As String, ByVal cbData As Long) As Long أما هذه الدالة فهى تتطلب خمس متغيرات الاول والثانى كما فى الدالة السابقة أما الثالث dwType فهو يحدد نوع البيانات التى سيتم وضعها فى المفتاح الفرفعى أما التابع الرابع lpData فيمثل مؤشر إلىالتابع الثالث أما cbData فيحدد طول البيانات فى التابع الثانى ثم إنسخ هذه الثوابت أيضاً Const ERROR_SUCCESS = 0& Const ERROR_BADDB = 1& Const ERROR_BADKEY = 2& Const ERROR_CANTOPEN = 3& Const ERROR_CANTREAD = 4& Const ERROR_CANTWRITE = 5& Const ERROR_OUTOFMEMORY = 6& Const ERROR_INVALID_PARAMETER = 7& Const ERROR_ACCESS_DENIED = 8& Private Const HKEY_CLASSES_ROOT = &H80000000 Private Const MAX_PATH = 260& Private Const REG_SZ = 1 هذه الثوابت أعتقد أن معناها واضح ثم إنسخ هذا الكود إلى قسم الاعلانات فى الفورم وأضغط Enter فى يتم إنشاء الدالة التى ستقوم بالعمل Private Sub AssociateFileExtension(Extension _ As String, PathToExecute As String, ApplicationName _ As String) ثم ضع هذه الإعلانات Dim sKeyName As String Dim sKeyValue As String . Dim ret& . Dim lphKey& ألأن سنبدأ العمل فى الدالة....... فأنظر إلى هذا الكود sKeyName = ApplicationName فى هذا المتغير نخزن إسم البرنامج الذى تمرره لنا الدالة وهو سيكون المفتاح الاساسى sKeyValue = ApplicationName فى هذا المتغير نخزن إسم البرنامج الذى تمرره لنا الدالة وهو سيكون المفتاح الفرعى ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&) هنا نستدعى الدالة التى تنشأ المفتاح الاساسى فى التسجيل تحت المفتاح HKEY_CLASSES_ROOT ثم تضع مؤشر لهدا المفتاح فى المتغير &lphKey الذى سنستخدمة فى الخطوة الثانية ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&) فى هذه الخطوة ننشيء المفتاح الخاص بالبرنامج أو بمعنى أدق نضع الاسم فى هذا المفتاح sKeyName = "." & Extension sKeyValue = ApplicationName ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&) ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&) فى هذه الخطوة ننشيء المفتاح الخاص بالإمتداد الذى سيربط بالبرنامج sKeyName = ApplicationName sKeyValue = PathToExecute & " %1" ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&) ret& = RegSetValue&(lphKey&, "shellopencommand", REG_SZ, sKeyValue, MAX_PATH) فى هذه الخطوة سسنشيء المفتاح الذى سيفتح الطبيق عندما يضغط المستخدم ضغطة مزدوجة على أى ملف لة الإمتداد الذى ربطناه وهذه هى الخطوة الاخيرة وبذلك تصبح الدالة بالصورة الاتية Private Sub AssociateFileExtension(Extension _ As String, PathToExecute As String, ApplicationName _ As String) Dim sKeyName As String Dim sKeyValue As String Dim ret& Dim lphKey& sKeyName = ApplicationName sKeyValue = ApplicationName ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&) ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&) sKeyName = "." & Extension sKeyValue = ApplicationName ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&) ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&) sKeyName = ApplicationName sKeyValue = PathToExecute & " %1" ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&) ret& = RegSetValue&(lphKey&, "shellopencommand", REG_SZ, sKeyValue, MAX_PATH) End Sub وعندما ترغب فى إستخدام هذه الدالة ( أو بمعنى أدق هذا الإجراء ) تتبع الصورة الأتية AssociateFileExtension "إمتداد الملف ( ثلاث حروف فقط )" , "مسار البرنامج الذى سيفتح هذا الملف ", " إسم البرنامج" مثال بفرض أن إمتداد البرنامج هو nor ومسار البرنامج هو "C: test" وإسم البرنامج هو Project1.exe فيكون إستخدام الإجراء كالأتى AssociateFileExtension "nor"," C: test " , " Project1.exe" المراجع : MSDN
thegust2000
07-04-2006, 09:11 AM
المقدمة :
أقدم إخواني درس بسيط جداً حول طرق تعيين الألوان في فيجوال بيسك وبعض طرق الإستفادة من الألوان وبعض المواضيع المتعلقة . أتمنى أن يجد إخواني المبتدئين فيه الإفادة .
الدرس :
أولاً : الألوان باستخدام 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 وغيره ، فلهم جزيل الشكر .
في نهاية هذا الدرس نكون قد تعلمنا أساليب عديدة لانتقاء الألون خلال الفيجوال بيسك . وبعض العمليات على الألوان ، اضافة لعدد