أكواد للفيجوال بيسك ممتازة

[الكوبــــــــرا]

بسم الله الرحمن الرحيم
السلام عليكم و رحمة الله و بركاتة أما بعد:-
الأكواد:-
--------------------


الوصف : كود لتغيير شكل الفورم على شكل دائرة


التصنيف : Custom Controls/ Forms/ Menus



كود:
'Declarations
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

'Code
Private Sub Form_Load()
Dim lngRegion As Long
Dim lngReturn As Long
Dim lngFormWidth As Long
Dim lngFormHeight As Long

lngFormWidth = Me.Width / Screen.TwipsPerPixelX
lngFormHeight = Me.Height / Screen.TwipsPerPixelY
lngRegion = CreateEllipticRgn(0, 0, lngFormWidth, lngFormHeight)
lngReturn = SetWindowRgn(Me.hWnd, lngRegion, True)
End Sub

[الكوبــــــــرا]

الوصف : توسيط فورمform في الشاشة وقت التشغيل Run time



التصنيف : Custom Controls/ Forms/ Menus




كود:
Private Sub Form_Load()

Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2
End Sub

[الكوبــــــــرا]

الوصف : تغيير حجم الخط على الزر عند مرور المؤشر عليه


التصنيف : Custom Controls/ Forms/ Menus


كود:


Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Command1.FontBold = False Then
Command1.FontBold = True
Command1.FontSize = 12
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Command1.FontBold = True Then
Command1.FontBold = False
Command1.FontSize = 10
End If
End Sub

[الكوبــــــــرا]

الوصف : السماح بإدخال تاريخ فقط في مربع النص


التصنيف : Coding Standards



كود:
Dim i As Integer
Dim t1 As String
Dim t2 As String
Public Sub AutoDate(TextBoxName As TextBox ByVal keyasci As Integer)
If Val(keyasci) 8 Then
If TextBoxName.Text Empty Then
i 0
Else
i i - 1
End If
Exit Sub
End If
i i 1
If i 3 Then
t1 Mid(TextBoxName.Text 1 2)
t2 Mid(TextBoxName.Text 3 1)
TextBoxName.Text Trim$(t1) & / & t2
TextBoxName.SelStart 4
t2 Empty
ElseIf i 6 Then
t1 Mid(TextBoxName.Text 1 5)
t2 Mid(TextBoxName.Text 6 1)
TextBoxName.Text Trim$(t1) & / & t2
TextBoxName.SelStart 7
End If
If i 11 Then Exit Sub
End Sub
Public Function DateValidation(TextBoxName As TextBox) As Boolean
If IsDate(Trim$(TextBoxName.Text)) False Then
MsgBox Enter valid date in dd/mm/yyyy format. vbInformation System Info..
TextBoxName.SetFocus
DateValidation False

[الكوبــــــــرا]

الوصف : طباعة النص على النموذج بألوان مختلفة



التصنيف : Coding Standards




كود:

Sub Form_Paint()
Dim i As Integer X As Integer Y As Integer
Dim C As String
Cls
For i 0 To 91
X CurrentX
Y CurrentY
C Chr(i)
Line -(X TextWidth(C) Y TextHeight(C)) _
QBColor(Rnd * 16) BF
CurrentX X
CurrentY Y
ForeColor RGB(Rnd * 256 Rnd * 256 Rnd * 256)
Print منتدى الغاط
Next
End Sub

[الكوبــــــــرا]

الوصف : السماح بكتابة حروف إنجليزية فقط في مربع النص


التصنيف : Coding Standards




كود:
Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii Asc(a) And KeyAscii Asc(z)) Or (KeyAscii Asc(A) And KeyAscii Asc(Z)) Then
Else
KeyAscii 0
End If
End Sub

[الكوبــــــــرا]

الوصف : تحويل حالة الأحرف من صغيرة إلى كبيرة



التصنيف : String Manipulation



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



كود:

Private Sub Command1_Click()
x Text1.Text
y UCase(Left(x Len(x)))
Text1.Text y
End Sub
Private Sub Command2_Click()
x Text1.Text
y LCase(Left(x Len(x)))
Text1.Text y
End Sub

[مدمن نت]

مشكووووووووووووووور أخوي وماقصرت

والله أكواد روعه من العضو الرائع :)

[الكوبــــــــرا]

العفوووووووووووو أخوي و ماقصرت
والله رد رائع من العضو الرائع :)