اكواد فيجوال بيسك3

[ضمتني الين طاح عقالي]

كلمة مرور لنموذج في برنامجك

كود PHP:

rivate Sub Form_Load()
'تعريف المتغيرات

Dim s As Integer
Dim passw As String
'اعطاء قيمة اولية

s = 1
'بدية التكرار واختبار ووضع كلمة المرور

Do Until (s = 5 Or passw = "هنا ضع كلمة المرور")
'عرض مربع الادخال لكتابة كلمة المرور

passw = InputBox("ادخل كلمة المرور الى قاعدة البيانات", "كلمة مرور مطلوبة")
'مقدار زيادة لستمرار التكرار

s = s + 1
Loop
If s = 5 Then
'عرض رسالة للمستخدم بعد التكرار  دون تحقق الشرط

MsgBox "كلمة المرور التي ادخلتها خاطئة... الرجاء حاول مرة أخرى", vbOKOnly, "خطأ في كلمة المرور"
End
'عرض النموذج بعد التأكد من تحقق الشرط

Form1.Show "form1"
'خروج من التكرار

End If
End Sub 


لإخفاء وإظهار شريط المهام Taskbar

كود PHP:

Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40

Private Declare Function FindWindow Lib "user32" _
        Alias "FindWindowA" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long

Private Declare Function SetWindowPos Lib "user32" _
        (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
        ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
        ByVal cy As Long, ByVal wFlags As Long) As Long
' لإخفاء شريط المهام
Private Sub Command1_Click()
Dim Thwnd As Long
Thwnd = FindWindow("****l_traywnd", "")
Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End Sub
' لإظهار شريط المهام
Private Sub Command2_Click()
Dim Thwnd As Long
Thwnd = FindWindow("****l_traywnd", "")
Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End Sub 


لحصر الماوس داخل النموذج (وتستطيع ان تحصرها داخل أي أداة أخرى)

كود PHP:

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, _
    lpRect As RECT) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, _
    lpPoint As Any) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long

Sub RestrictMouseRegion(Optional ByVal hWnd As Long = 0)
Dim recTargetWindow     As RECT
    If hWnd Then
        GetClientRect hWnd, recTargetWindow
        ClientToScreen hWnd, recTargetWindow
        ClientToScreen hWnd, recTarget********Right
        ClipCursor recTargetWindow
    Else
        ClipCursor ByVal 0&
    End If
End Sub

Private Sub Form_Load()
    RestrictMouseRegion (Me.hWnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
RestrictMouseRegion
End Sub 


لإضافة عروض الفلاش لبرنامجك

كود PHP:

Private Sub Command1_Click()
Dim s As String
s = App.Path
If Mid(s, Len(s), 1) <> "\" Then s = s + ""
ShockwaveFlash1.Movie = s + "a4.swf"

End Sub 


لتحريك النموذج من أي نقطة فيه بدون الاعتماد على شريط العنوان

كود PHP:

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd _
    As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "User32" ()

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, _
 Y As Single)
    Const WM_NCLBUTTONDOWN = &HA1
    Const HTCAPTION = 2
    If Button = 1 Then
        ReleaseCapture
        SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
    End If
End Sub 


لتشفير وفك تشفير نص

كود PHP:

Private Sub Command1_Click()
For i = 1 To Len(****1.****)
st1 = Mid(****1.****, i, 1)
as1 = Asc(st1)
ch1 = Chr(255 - as1)
st = st + ch1
Next
****1.**** = st
End Sub 


لإظهار وإخفاء الأيقونات (الرموز) على سطح المكتب

كود PHP:

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
    ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, _
 ByVal nCmdShow As Long) As Long

Private Sub Command1_Click()
'لإخفاء الأيقونات على سطح المكتب
Dim hWnd As Long
hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd, 0
End Sub

Private Sub Command2_Click()
'لإظهار الأيقونات على سطح المكتب
Dim hWnd As Long
hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd, 5
End Sub 


يقوم هذا الاجراء بتحويل معظم الأدوات المستخدمة في الفيجوال بيسك من اليسار الى اليمين حتى وان كانت الفيجوال بيسك لا تدعم ذلك

كود PHP:

Option Explicit 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 

Private Const WS_EX_LAYOUTRTL = &H400000 
Private Const GWL_EXSTYLE = (-20) 

Public Sub SetRtoL(Ctl As Control) 
Ctl.Visible = False 
SetWindowLong Ctl.hwnd, GWL_EXSTYLE, GetWindowLong(Ctl.hwnd, GWL_EXSTYLE) Or WS_EX_LAYOUTRTL 
Ctl.Visible = True 
End Sub 


يحرك لك الفورم لمكان معينة

كود PHP:

Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long 

Private Sub Command1_Click() 
r = MoveWindow(Me.hwnd, 90, 90, 300, 250, 1) 
End Sub 


توسيط اسم الفورم في الوسط

كود PHP:

Public Sub CenterC(frm As Form) 
Dim SpcF As Integer 'How many spaces can fit 
Dim clen As Integer 'caption length 
Dim oldc As String 'oldcaption 
Dim i As Integer 'not important 
' 'remove any spaces at the ends of the caption 
' 'very easy if you read it carefully 
oldc = frm.Caption 

Do While Left(oldc, 1) = Space(1) 

DoEvents 
oldc = Right(oldc, Len(oldc) - 1) 
Loop 
Do While Right(oldc, 1) = Space(1) 

DoEvents 
oldc = Left(oldc, Len(oldc) - 1) 
Loop 

clen = Len(oldc) 

If InStr(oldc, "!") <> 0 Then 

If InStr(oldc, " ") <> 0 Then 
clen = clen * 1.5 
Else 
clen = clen * 1.4 
End If 

Else 

If InStr(oldc, " ") <> 0 Then 
clen = clen * 1.4 
Else 
clen = clen * 1.3 
End If 

End If 

' ''see how many characters can fit 
SpcF = frm.Width / 61.2244 ''how many space can fit it the caption 
SpcF = SpcF - clen 'How many spaces can fit-How much space the 
' 'caption takes up 
' ''Now the tricky part 

If SpcF > 1 Then 
DoEvents 'speed up the program 
frm.Caption = Space(Int(SpcF / 2)) + oldc 
Else 'if the form is too small for spaces 
frm.Caption = oldc 
End If 

End Sub 

Private Sub Form_Resize() 
If Me.Width = oldsize Then 'if the width hasn't changed 
Exit Sub 'then dont mess with it 
Else 
CenterC Me 
oldsize = Me.Width 
End If 

End Sub 

Private Sub Form_Load() 
CenterC Me 
oldsize = Me.Width 
End Sub 


يجعلك عندما تقرب الماوس فوق التست يبتعد ( يتحرك )

كود PHP:

Private Sub ****1_MouseMove(Button As Integer, Shift As Integer, _ 
X As Single, Y As Single) 
If ****1.Top = 600 Then ' Move it to the bottom 
For i = 600 To Form1.Height - 2 * ****1.Height Step Screen.TwipsPerPixelY 
****1.Top = i ' Change the command button's top property to i 
Next i ' Reapeat 

Else  Move it to the top 
For i = Form1.Height - 2 * ****1.Height To 600 Step -Screen.TwipsPerPixelY 
****1.Top = i 
Next i 
End If 
End Sub 


جعل الفورم أبعاد ثلاثية اضف كوماند للفورم

كود PHP:

Sub ThreeDForm(frmForm As Form) 

Const cPi = 3.1415926 

Dim intLineWidth As Integer 

intLineWidth = 5 

' 'save scale mode 
Dim intSaveScaleMode As Integer 
intSaveScaleMode = frmForm.ScaleMode 
frmForm.ScaleMode = 3 

Dim intScaleWidth As Integer 
Dim intScaleHeight As Integer 

intScaleWidth = frmForm.ScaleWidth 
intScaleHeight = frmForm.ScaleHeight 

' 'clear form 
frmForm.Cls 

' 'draw white lines 
frmForm.Line (0, intScaleHeight)-(intLineWidth, 0), &HFFFFFF, BF 
frmForm.Line (0, intLineWidth)-(intScaleWidth, 0), &HFFFFFF, BF 

' 'draw grey lines 
frmForm.Line (intScaleWidth, 0)-(intScaleWidth - intLineWidth, _ 
intScaleHeight), &H808080, BF 
frmForm.Line (intScaleWidth, intScaleHeight - intLineWidth)-(0, _ 
intScaleHeight), &H808080, BF 

' 'draw triangles(actually circles) at corners 
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 '-180 * _ 
cPi / 180, -224 * cPi / 180 

frmForm.Circle (intScaleWidth - intLineWidth, intLineWidth), _ 
intCircleWidth, QBColor(15), -0.78539815, -1.5707963 ' -45 * _ 
cPi / 180, -90 * cPi / 180 

' 'draw black frame 
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 cmdDraw_Click() 
ThreeDForm Me 
End Sub 


التحكم في الجهاز عن طريق فجوال

كود PHP:

' Display the Control Panel 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL", vbNormalFocus) 

'Display the Accessibility Properties 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL access.cpl", vbNormalFocus) 

'Display Add/Remove Programs 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL appwiz.cpl", vbNormalFocus) 

'Show the Display Settings (Background) 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL desk.cpl,,0", vbNormalFocus) 

'Show the Display Settings (Screensaver) 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL desk.cpl,,1", vbNormalFocus) 

'Show the Display Settings (Appearance) 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL desk.cpl,,2", vbNormalFocus) 

'Show the Display Settings (Settings) 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL desk.cpl,,3", vbNormalFocus) 

'Display Internet Properties 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL inetcpl.cpl", vbNormalFocus) 

'Display Regional Settings 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL intl.cpl", vbNormalFocus) 

'Display the Joystick Settings 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL joy.cpl", vbNormalFocus) 

'Display the Mouse Settings 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL main.cpl @0", vbNormalFocus) 

'Display the Keyboard Settings 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL main.cpl @1", vbNormalFocus) 

'Display Printers 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL main.cpl @2", vbNormalFocus) 

'Display Fonts 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL main.cpl @3", vbNormalFocus) 

'Display Multimedia Settings 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL mmsys.cpl", vbNormalFocus) 

'Display Modem Settings 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL modem.cpl", vbNormalFocus) 

'Display Dial-Up Networking Wizard (on Win9x) 
Call ****l("rundll32.exe rnaui.dll,RnaWizard", vbNormalFocus) 

'Display System Properties 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL sysdm.cpl", vbNormalFocus) 

'Run 'Add New Hardware' Wizard (on Win9x) 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL sysdm.cpl @1", vbNormalFocus) 

'Display 'Add New Printer' Wizard (on Win9x) 
Call ****l("rundll32.exe ****l32.dll,SHHelpShortcuts_RunDLL AddPrinter", vbNormalFocus) 

'Display Themes Settings 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL themes.cpl", vbNormalFocus) 

'Display Time/Date Settings 
Call ****l("rundll32.exe ****l32.dll,Control_RunDLL timedate.cpl", vbNormalFocus) 


لتعطيل القائمة التي تظهر عند النقر بالزر اليمين وأنت موجود في ****Box
ضع هذا الكود في Module

كود PHP:

Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic Const GWL_WNDPROC = -4 

Public Const WM_RBUTTONUP = &H205 
Public lpPrevWndProc As Long 
Private lngHWnd As Long 

Public Sub Hook(hWnd As Long) 
lngHWnd=hWnd 
lpPrevWndProc = SetWindowLong(lngHWnd, GWL_WNDPROC, AddressOf WindowProc) 
End Sub 

Public Sub UnHook() 
Dim lngReturnValue As Long 
lngReturnValue = SetWindowLong(lngHWnd, GWL_WNDPROC, lpPrevWndProc) 
End Sub 

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 

Select Case uMsg 

Case WM_RBUTTONUP 
'Do nothing 
'Or popup you own menu 
Case Else 
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam) 
End Select 
End Function 
----------------------------------------------------------------

طريقة الاستخدام .... 

---------------------------------------------------------
Call Hook(****1.hWnd) ' لتعطيل القائمة 

Call UnHook(****1.hWnd) ' لارجاعها للوضع الطبيعي .. ويفضل وضعه عند قبل انهاء البرنامج 
------------------------------------------------------- 


دالة التقريب لاقرب جزء من المائة

كود PHP:

Private Sub Command1_Click() 
MsgBox Round(12.8815, 2) 
End Sub 
Function Round(nValue As Double, nDigits As _ 
Integer) As Double 
Round = Int(nValue * (10 ^ nDigits) + _ 
0.5) / (10 ^ nDigits) 
End Function 


كود يصنع ابعاد ثلاثية للليبل و التست

كود PHP:

'Set form's AutoRedraw property toTrue 
Sub PaintControl3D(frm As Form, Ctl As Control) 
' This Sub draws lines around controls to make them 3d 

' darkgrey, upper - horizontal 
frm.Line (Ctl.Left, Ctl.Top - 15)-(Ctl.Left + _ 
Ctl.Width, Ctl.Top - 15), &H808080, BF 
' darkgrey, left - vertical 
frm.Line (Ctl.Left - 15, Ctl.Top)-(Ctl.Left - 15, _ 
Ctl.Top + Ctl.Height), &H808080, BF 
' white, right - vertical 
frm.Line (Ctl.Left + Ctl.Width, Ctl.Top)- _ 
(Ctl.Left + Ctl.Width, Ctl.Top + Ctl.Height), &HFFFFFF, BF 
' white, lower - horizontal 
frm.Line (Ctl.Left, Ctl.Top + Ctl.Height)- _ 
(Ctl.Left + Ctl.Width, Ctl.Top + Ctl.Height), &HFFFFFF, BF 

End Sub 

Sub PaintForm3D(frm As Form) 
' This Sub draws lines around the Form to make it 3d 

' white, upper - horizontal 
frm.Line (0, 0)-(frm.ScaleWidth, 0), &HFFFFFF, BF 
' white, left - vertical 
frm.Line (0, 0)-(0, frm.ScaleHeight), &HFFFFFF, BF 
' darkgrey, right - vertical 
frm.Line (frm.ScaleWidth - 15, 0)-(frm.ScaleWidth - 15, _ 
frm.Height), &H808080, BF 
' darkgrey, lower - horizontal 
frm.Line (0, frm.ScaleHeight - 15)-(frm.ScaleWidth, _ 
frm.ScaleHeight - 15), &H808080, BF 

End Sub 

'DEMO USAGE 
'Add 1 label and 1 ****box 

Private Sub Form_Load() 

Me.AutoRedraw = True 
PaintForm3D Me 
PaintControl3D Me, Label1 'Label1 is name of label 
PaintControl3D Me, ****1 '****1 is name of ****box 

End Sub 


لإيقاف لوحة المفاتيح والماوس عن العمل وإعادتها للعمل مرة اخرى

كود PHP:

Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Activate()
    DoEvents
    ' إيقاف لوحة المفاتيح والماوس عن العمل
    BlockInput True
    ' الانتظار عشر ثواني
    Sleep 10000
     إعادة لوحة المفاتيح والماوس للعمل مرة أخرى
    BlockInput False
End Sub 


اختبار إذا كان البرنامج لا يشتغل من القرص المدمج فإنه يقوم بإنهائه

كود PHP:

Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" _
    (ByVal nDrive As String) As Long

Private Sub Form_Load()
Dim driveType As Long
driveType = GetDriveType(Mid(App.Path, 1, 3))
If driveType <> 5 Then
إنهاء البرنامج إذا كان لايشتغل من القرص المدمج
    End
End If
End Sub 


تحويل اي حرف إلى حرف ASCII

كود PHP:

Dim temp as String
temp=asc(****1.****)
MsgBox temp 


تأثيرات مروعة على الفورم

كود PHP:

'Declarations
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

Private Sub Form_Paint()
    Call XFormBlueFade(Me)'Makes it Fade Blue
End Sub
'You Can only have 1 of these Commands i
'     n the Form


Private Sub Form_Paint()
    Call XFormFireFade(Me)'Makes it FIRE!! My FAV
End Sub
'You Can only have 1 of these Commands i
'     n the Form


Private Sub Form_Paint()
    Call XFormGreenFade(Me)'Makes it Fade Green
End Sub
'You Can only have 1 of these Commands i
'     n the Form


Private Sub Form_Paint()
    Call XFormIceFade(Me)'Makes it Fade ICE
End Sub
'You Can only have 1 of these Commands i
'     n the Form


Private Sub Form_Paint()
    Call XFormPurpleFade(Me)'Makes it Fade Purple
End Sub
'You Can only have 1 of these Commands i
'     n the Form


Private Sub Form_Paint()
    Call XFormRedFade(Me)'Makes it Fade Red
End Sub
'You Can only have 1 of these Commands i
'     n the Form


Private Sub Form_Paint()
    Call XFormSilverFade(Me)'Makes it Fade Silver
End Sub 


اصنع مربعات النصوص بنفسك

كود PHP:

'****box1 form ****box6 
'Initialize each ****Box with a border s
'     tyle or special effect,
'and foreground and background colors
'****Box1 initially uses a borderstyle
****Box1.**** = "Single Style"
****Box1.BorderStyle = fmBorderStyleSingle
****Box1.BorderColor = RGB(255, 128, 128)'Color - Salmon
****Box1.ForeColor = RGB(255, 255, 0)'Color - Yellow
****Box1.BackColor = RGB(0, 128, 64)'Color - Green #2
'****Boxes 2 through 6 initially use spe
'     cial effects
****Box2.**** = "Flat"
****Box2.SpecialEffect = fmSpecialEffectFlat
****Box2.ForeColor = RGB(64, 0, 0) 'Color - Brown
****Box2.BackColor = RGB(0, 0, 255) 'Color - Blue
'Ensure the background style for ****Box
'     2 is initially opaque.
****Box2.BackStyle = fmBackStyleOpaque
****Box3.**** = "Etched"
****Box3.SpecialEffect = fmSpecialEffectEtched
****Box3.ForeColor = RGB(128, 0, 255)'Color - Purple
****Box3.BackColor = RGB(0, 255, 255)'Color - Cyan
'Define BorderColor for later use (when 
'     borderstyle=fmBorderStyleSingle)
****Box3.BorderColor = RGB(0, 0, 0) 'Color - Black
****Box4.**** = "Bump"
****Box4.SpecialEffect = fmSpecialEffectBump
****Box4.ForeColor = RGB(255, 0, 255)'Color - Magenta
****Box4.BackColor = RGB(0, 0, 100) 'Color - Navy blue
****Box5.**** = "Raised"
****Box5.SpecialEffect = fmSpecialEffectRaised
****Box5.ForeColor = RGB(255, 0, 0) 'Color - Red
****Box5.BackColor = RGB(128, 128, 128) 'Color - Gray
****Box6.**** = "Sunken"
****Box6.SpecialEffect = fmSpecialEffectSunken
****Box6.ForeColor = RGB(0, 64, 0) 'Color - Olive
****Box6.BackColor = RGB(0, 255, 0) Color - Green #1 


تحيه حسب الوقت

كود PHP:

Private Sub Form_Load()


    If Time <= "11:30 AM" Then
        MsgBox ("Good Morning YourNameHere!")
        End
    End If


    If Time > "11:30 AM" And Time < "5:00 PM" Then
        MsgBox ("Good Afternoon YourNameHere!")
        End
    End If


    If Time > "5:00 PM" Then
        MsgBox ("Good Evening YourNameHere!")
        End
    End If


    If Time >= "12:01 AM" Then
        MsgBox ("Good Morning YourNameHere!")
        End
    End If
End Sub 


[جموح]

يعطيك العافية عالجهد المبذول

لا عدمناك