فيجوال بيسك(كودلعمل مؤثرات رسومية)

Option Explicit
'Remember to have AutoRedraw turned on for the form!
Private mb_Filled As Boolean 'for when the form is re-sized

Public Sub GradientForm_0(po_Form As Object, pl_Start As Long, pl_End As Long, pi_Orientation As Integer)

Dim li_StartRed As Integer
Dim li_StartGreen As Integer
Dim li_StartBlue As Integer
Dim li_EndRed As Integer
Dim li_EndGreen As Integer
Dim li_EndBlue As Integer
Dim ld_DifR As Double
Dim ld_DifG As Double
Dim ld_DifB As Double
Dim li_Counter As Integer
Dim li_DrawWidth As Integer

GetRGBComponents pl_Start, li_StartRed, li_StartGreen, li_StartBlue
GetRGBComponents pl_End, li_EndRed, li_EndGreen, li_EndBlue

ld_DifR = (li_EndRed - li_StartRed) / 255
ld_DifG = (li_EndGreen - li_StartGreen) / 255
ld_DifB = (li_EndBlue - li_StartBlue) / 255

'Draw the gradient onto the form
Select Case pi_Orientation
Case 1 'horizontal gradient
po_Form.Scale (0, 0)-(1, 256)
For li_Counter = 0 To 255
po_Form.Line (0, li_Counter)-(1, li_Counter + 1), _
RGB(CInt(li_StartRed + (ld_DifR * li_Counter)), _
CInt(li_StartGreen + (ld_DifG * li_Counter)), _
CInt(li_StartBlue + (ld_DifB * li_Counter))), BF
Next li_Counter
Case 2 'vertical gradient
po_Form.Scale (0, 0)-(256, 1)
For li_Counter = 0 To 255
po_Form.Line (li_Counter, 0)-(li_Counter + 1, 1), _
RGB(CInt(li_StartRed + (ld_DifR * li_Counter)), _
CInt(li_StartGreen + (ld_DifG * li_Counter)), _
CInt(li_StartBlue + (ld_DifB * li_Counter))), BF
Next li_Counter
Case 3 'radial gradient
po_Form.Scale (0, 0)-(256, 256)
li_DrawWidth = po_Form.DrawWidth
po_Form.DrawWidth = 3
For li_Counter = 0 To 255
po_Form.Circle (123, 123), li_Counter, _
RGB(CInt(li_StartRed + (ld_DifR * (li_Counter))), _
CInt(li_StartGreen + (ld_DifG * (li_Counter))), _
CInt(li_StartBlue + (ld_DifB * (li_Counter))))
Next li_Counter
po_Form.DrawWidth = li_DrawWidth
End Select
po_Form.Scale

End Sub
Public Sub GetRGBComponents(ByVal pl_Colour As Long, pi_Red As Integer, pi_Green As Integer, pi_Blue As Integer)

Dim ls_Colour As String
Dim ls_Hex As String

ls_Hex = CStr(Hex(pl_Colour))

If Len(ls_Hex) > 6 Then
ls_Hex = Right(ls_Hex, 6)
End If

'Get Blue
If Len(ls_Hex) > 4 Then
ls_Colour = Left(ls_Hex, Len(ls_Hex) - 4)
pi_Blue = Val("&h" & ls_Colour)
ls_Hex = Right(ls_Hex, 4)
End If

'Get Green
If Len(ls_Hex) > 2 Then
ls_Colour = Left(ls_Hex, Len(ls_Hex) - 2)
pi_Green = Val("&h" & ls_Colour)
ls_Hex = Right(ls_Hex, 2)
End If

'Get Red
pi_Red = Val("&h" & ls_Hex)

End Sub

Private Sub Command1_Click()
GradientForm_0 Me, Text1, Text2, Combo1.Text 'or you could fill a picture box instead
mb_Filled = True
End Sub

Private Sub Form_Load()
Combo1 = "1"
End Sub

Private Sub Form_Resize()
If mb_Filled Then GradientForm_0 Me, Text1, Text2, Combo1.Text
End Sub

موضوع: مرحبا بكم الأربعاء أكتوبر 24, 2007 6:57 pm

اظن انك على حق Embarassed

شكرا الك اخي على هذه الكودات

واتمنى من كل شخص ياخذ مهارات حاسوب (2) الاستفادة

ونحن بانتظار مزيدك

وابداعاتك

يعطيك الف عافية ....

يسلم ايديك

_________________

The Road of Success is always Under Construction