بداية Color Picker هى أداة انتقاء اللون من على سطح أداه أو أى شىء معروض فى الويندوز , و الميزه هنا أننا سنقوم بدراسة و التعرف على دوال جديده حيث يعتبر هذا المثال دليل عملى عليها. و أيضا يعتبر هذا الدرس تطبيق جيد جدا لموضوع Graphics For Visual Basic 6.0 و الذى تم الانتهاء من جميع أجزاءه بالكامل .
و الفكره كالتالى :
كلما تحرك مؤشر الماوس فى مكان ما فاننا سنعرف احداثيات هذا المكان فى (Label1 - Label2) و رقم لون المكان RGB فى (Label3) و اللون نفسه فى (PictureBox) عن طريق الـ Timer .
الأن الأكواد :
منطقة General Declaration
Option Explicit
Private Type pointapi
Px As Long
Py As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long)As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String,ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Dim PosXY As pointapi
Private Function LongToRGB(lColor As Long) As String
Dim iRed As Long, iGreen As Long, iBlue As Long
iRed = lColor Mod 256
iGreen = ((lColor And &HFF00) / 256&) Mod 256&
iBlue = (lColor And &HFF0000) / 65536
LongToRGB = Format$(iRed, "000") & ", " & Format$(iGreen, "000") & ", " & Format$(iBlue, "000")
End Function
Private Function GetPixelColor(x As Long, y As Long, Optional HexCode As Boolean = False) As String
Dim DC As Long
DC = CreateDC("DISPLAY", vbNullString, vbNullString, 0&)
GetPixelColor = Format$(GetPixel(DC, x, y), "00000000") 'long
DeleteDC DC
End Function
Private Sub Form_Load()
Me.BackColor = &HFF&
Timer1.Enabled = 1
End Sub
Private Sub Form_Resize()
Label1.Top = Me.ScaleHeight - Label1.Height
Label2.Top = Me.ScaleHeight - Label2.Height
Label3.Top = Me.ScaleHeight - Label3.Height
End Sub
Private Sub Label1_Click()
End
End Sub
Private Sub Label2_Click()
End
End Sub
Private Sub Timer1_Timer()
GetCursorPos PosXY
Label1.Caption = "X : " & PosXY.Px
Label2.Caption = "Y : " & PosXY.Py
Label3.Caption = "RGB : " & LongToRGB(GetPixelColor(PosXY.Px, PosXY.Py))
Picture1.BackColor = GetPixelColor(PosXY.Px, PosXY.Py)
End Sub
الشـــــــــــــــــرح
الأكواد السابقه يمكنك Copy و Paste على Form مباشرة بعد اضافة الأدوات المذكوره أعلاه .
الدوال المذكوره فى الـ Code :
1) الداله GetCursorPos :