10 أكواد لتجعل مشروعك أكثر من جميل

مرحباً..

هذه مجموعة من الأكواد ليصبح شكل برنامجكم أجمل

الكود الأول

' ضع هذا الكود في الفورم

Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hwnd As Long, ByValcrKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Boolean
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Const LWA_ALPHA = 2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000

Private Sub Form_Load()
   SetWindowLong hwnd, GWL_EXSTYLE, GetWindowLong(hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
   SetLayeredWindowAttributes hwnd, 0, 128, LWA_ALPHA
End Sub

الكود الثاني:

شاشة افتتاحية

سوف نحتاج إلى نموذجين، ضع هذا الكود في النموذج الأول

Private Sub Form_Load()
Dim Start, Finsh
Form2.Show
Start = Timer
Finsh = Start + 3
Do Until Finsh <= Timer
DoEvents
Loop
Unload Form2
Form1.Show
End Sub

الكود الثالث:

مؤثر جميل على الفورم

ضع هذا الكود في الفورم

Function Dist(x1, y1, x2, y2) As Single 
Dim A As Single, B As Single 
A = (x2 - y1) * (x2 - x1) 
B = (y2 - y1) * (y2 - y1) 
Dist = Sqr(A + B) 
End Function 
Sub MoveIt(A, B, t) 
A = (1 - t) * A + t * B 
End Sub 

Private Sub Form_Click() 
Cls 
Dim t As Single, x1 As Single, y1 As Single 
Dim x2 As Single, y2 As Single, x3 As Single 
Dim y3 As Single, x4 As Single, y4 As Single 

Scale (-320, 200)-(320, -200) 
t = 0.05 
x1 = -320: y1 = 200 
x2 = 320: y2 = 200 
x3 = 320: y3 = -200 
x4 = -320: y4 = -200 
Do Until Dist(x1, y1, x2, y2) < 10 
Line (x1, y1)-(x2, y2) 
Line -(x3, y3) 
Line -(x4, y4) 
Line -(x1, y1) 
MoveIt x1, x2, t 
MoveIt y1, y2, t 
MoveIt x2, x3, t 
MoveIt y2, y3, t 
MoveIt x3, x4, t 
MoveIt y3, y4, t 
MoveIt x4, x1, t 
MoveIt y4, y1, t 
Loop 
End Sub 

Private Sub Form_Resize() 
Cls 
Dim t As Single, x1 As Single, y1 As Single 
Dim x2 As Single, y2 As Single, x3 As Single 
Dim y3 As Single, x4 As Single, y4 As Single 

Scale (-320, 200)-(320, -200) 
t = 0.05 
x1 = -320: y1 = 200 
x2 = 320: y2 = 200 
x3 = 320: y3 = -200 
x4 = -320: y4 = -200 
Do Until Dist(x1, y1, x2, y2) < 10 
Line (x1, y1)-(x2, y2) 
Line -(x3, y3) 
Line -(x4, y4) 
Line -(x1, y1) 
MoveIt x1, x2, t 
MoveIt y1, y2, t 
MoveIt x2, x3, t 
MoveIt y2, y3, t 
MoveIt x3, x4, t 
MoveIt y3, y4, t 
MoveIt x4, x1, t 
MoveIt y4, y1, t 
Loop 
End Sub

الكود الرابع:

رش الألوان على الفورم

ضع هذا الكود في الفورم

Private Sub Form_Load()
Me.AutoRedraw = True
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
X = Me.CurrentX
Y = Me.CurrentY
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.PSet (X + Rnd * 255, Y + Rnd * 255), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Me.PSet (X + Rnd * 255, Y + Rnd * 255), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Me.PSet (X + Rnd * 255, Y + Rnd * 255), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Me.PSet (X + Rnd * 255, Y + Rnd * 255), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
End Sub

الكود الخامس:

ظهور الفورم بألوان و أشكال عشوائية!!!

Private Sub Form_Load()
Timer1.Interval = 250
End Sub

Private Sub Timer1_Timer()
  Randomize
  Me.BackColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
  Me.Move Rnd * 12000, Rnd * 9000, Rnd * 12000, Rnd * 9000
  End Sub

الكود السادس:

نموذج ثلاثي الأبعاد

ضع هذا الكود في الفورم

Public Sub ThreeDForm(frmForm As Form)
Const cPi = 3.1415926
Dim intLineWidth As Integer
intLineWidth = 5
Dim intSaveScaleMode As Integer
intSaveScaleMode = frmForm.ScaleMode
frmForm.ScaleMode = 3
Dim intScaleWidth As Integer
Dim intScaleHeight As Integer
intScaleWidth = frmForm.ScaleWidth
intScaleHeight = frmForm.ScaleHeight
frmForm.Cls
frmForm.Line (0, intScaleHeight)-(intLineWidth, 0), &HFFFFFF, BF
frmForm.Line (0, intLineWidth)-(intScaleWidth, 0), &HFFFFFF, BF
frmForm.Line (intScaleWidth, 0)-(intScaleWidth - intLineWidth, _
intScaleHeight), &H808080, BF
frmForm.Line (intScaleWidth, intScaleHeight - intLineWidth)-(0, _
intScaleHeight), &H808080, BF
Dim intCircleWidth As Integer
intCircleWidth = Sqr(intLineWidth * intLineWidth + intLineWidth _
* intLineWidth)
frmForm.FillStyle = 0
frmForm.FillColor = QBColor(15)
frmForm.Circle (intLineWidth, intScaleHeight - intLineWidth), _
intCircleWidth, _
QBColor(15), -3.1415926, -3.90953745777778
frmForm.Circle (intScaleWidth - intLineWidth, intLineWidth), _
intCircleWidth, _
QBColor(15), -0.78539815, -1.5707963
frmForm.Line (0, intScaleHeight)-(0, 0), 0
frmForm.Line (0, 0)-(intScaleWidth - 1, 0), 0
frmForm.Line (intScaleWidth - 1, 0)-(intScaleWidth - 1, _
intScaleHeight - 1), 0
frmForm.Line (0, intScaleHeight - 1)-(intScaleWidth - 1, _
intScaleHeight - 1), 0
frmForm.ScaleMode = intSaveScaleMode
End Sub

Private Sub Form_Resize()
ThreeDForm Me
End Sub

الكود السابع:

تلوين النموذج قبل إغلاقه

ضع هذا الكود في الفورم

Private Sub Form_Unload(Cancel As Integer)
WindowState = 2     'تكبير حجم النموذج ليصبح بحجم الشاشة
DrawWidth = 4       'اتغيير حجم نقطة الرسم
For i = 1 To 18000  'التحضير للتنفيذ
Down = Down + 1     ' سرعة الرسم
Across = Across + 1
PSet (Rnd * Across, Rnd * Down), QBColor(Rnd * 15) 'رسم النقط
Next i            '  اعد تنقيذ الرسم
End Sub

الكود الثامن:

تحريك نص بطريقة مسلية

ضع هذا الكود في الفورم

Private Sub Form_Load()
Me.Label1.Top = 0
End Sub

Private Sub Timer1_Timer()
a = Me.Height
b = 200
If Me.Label1.Top < a Then 'Me.Height Then
Me.Label1.Top = Me.Label1.Top + b
Exit Sub
End If
For m = 1 To (Int(a / B) + 1)
Me.Label1.Top = Me.Label1.Top - 200
For x = 1 To 1000000
Next
Next
End Sub

الكود التاسع:

طريقة جميلة لإغلاق الفورم

ضع هذا الكود في الفورم

Sub SlideWindow(frmSlide As Form, iSpeed As Integer)
While frmSlide.Left + frmSlide.Width < Screen.Width
DoEvents
frmSlide.Left = frmSlide.Left + iSpeed
Wend
While frmSlide.Top - frmSlide.Height < Screen.Height
DoEvents
frmSlide.Top = frmSlide.Top + iSpeed
Wend
Unload frmSlide
End Sub
Private Sub Command1_Click()
Call SlideWindow(Form1, 100)
End Sub

الكود العاشر:

تحريك 2 label مع تغيير ألوانهما

ضع هذا الكود في الفورم

 Private Sub Form_Load()
Timer1.Interval = 100
Timer2.Interval = 100
Label1 = "Welcome"
Label2 = "Good Bey"
End Sub

Private Sub Timer1_Timer()
Label1.ForeColor = QBColor(Rnd * 15)
Label1.Left = Label1.Left + 10
End Sub

Private Sub Timer2_Timer()
Label2.ForeColor = QBColor(Rnd * 10)
Label2.Left = Label2.Left - 10
End Sub

أرجو أن تعجبكم هذه الأكواد و لا أريد منكم سوى زيارة موقعي

http://www.m35.t35.com

http://www.m35.t35.com

وشكراً