سنتر العرب
 

ماشاء الله تبارك الله ماشاء الله لاقوة الا بالله , اللهم اني اسالك الهدى والتقى والعفاف والغنى

   

 

 

    تويتر فيس بوك

 

Loading


العودة   منتديات سنتر العرب > سنتر العرب - الاقسام العامة > سنتر العرب - الأنترنت والكمبيوتر و الـ DSL > سنتر العرب لخدمات الويب > لغات البرمجه, php , asp,Ajax, visual basic Java

لغات البرمجه, php , asp,Ajax, visual basic Java لغات البرمجه, php , asp,Ajax, visual basic Java,لغات البرمجه, php , asp,Ajax, visual basic Java,لغات البرمجه, php , asp,Ajax, visual basic Java,لغات البرمجه, php , asp,Ajax, visual basic Java,

المواضيع المتشابهه
الموضوع كاتب الموضوع المنتدى مشاركات آخر مشاركة
اكواد فيجوال بيسك 1 ضمتني الين طاح عقالي لغات البرمجه, php , asp,Ajax, visual basic Java 3 04-26-2008 08:34 PM
اكواد فيجوال بيسك 2 ضمتني الين طاح عقالي لغات البرمجه, php , asp,Ajax, visual basic Java 1 03-23-2008 06:53 PM
اكواد فيجوال بيسك4 ضمتني الين طاح عقالي لغات البرمجه, php , asp,Ajax, visual basic Java 1 03-23-2008 06:51 PM
اكواد فيجوال بيسك ضمتني الين طاح عقالي لغات البرمجه, php , asp,Ajax, visual basic Java 1 03-23-2008 06:50 PM


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

لغات البرمجه, php , asp,Ajax, visual basic Java


إضافة رد
 
أدوات الموضوع
قديم 03-23-2008, 06:19 PM   رقم المشاركة : [1]
ضمتني الين طاح عقالي
आँखों

 الصورة الرمزية ضمتني الين طاح عقالي
 




ضمتني الين طاح عقالي is just really nice ضمتني الين طاح عقالي is just really nice ضمتني الين طاح عقالي is just really nice ضمتني الين طاح عقالي is just really nice

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

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


كود PHP:
rivate Sub Form_Load()
'تعريف المتغيرات

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

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 LongByVal hWndInsertAfter As Long_
        ByVal x 
As LongByVal y As LongByVal cx As Long_
        ByVal cy 
As LongByVal 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(Thwnd00000SWP_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
App.Path
If Mid(sLen(s), 1) <> "\" Then s = s + ""
ShockwaveFlash1.Movie = s + "
a4.swf"

End Sub 

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

كود PHP:
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd _
    
As LongByVal wMsg As LongByVal wParam As LonglParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "User32" ()

Private 
Sub Form_MouseMove(Button As IntegerShift As IntegerAs Single_
 Y 
As Single)
    Const 
WM_NCLBUTTONDOWN = &HA1
    
Const HTCAPTION 2
    
If Button 1 Then
        ReleaseCapture
        SendMessage Me
.hWndWM_NCLBUTTONDOWNHTCAPTION0&
    
End If
End Sub 

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



كود PHP:
Private Sub Command1_Click()
For 
1 To Len(****1.****)
st1 Mid(****1.****, i1)
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 LongByVal hWnd2 As Long_
    ByVal lpsz1 
As StringByVal 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 hWnd5
End Sub 
يقوم هذا الاجراء بتحويل معظم الأدوات المستخدمة في الفيجوال بيسك من اليسار الى اليمين حتى وان كانت الفيجوال بيسك لا تدعم ذلك


كود PHP:
Option Explicit 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongByVal nIndex As Long) As Long 

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongByVal nIndex As LongByVal 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
.hwndGWL_EXSTYLEGetWindowLong(Ctl.hwndGWL_EXSTYLE) Or WS_EX_LAYOUTRTL 
Ctl
.Visible True 
End Sub 

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


كود PHP:
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As LongByVal x As LongByVal y As LongByVal nWidth As LongByVal nHeight As LongByVal bRepaint As Long) As Long 

Private Sub Command1_Click() 
MoveWindow(Me.hwnd90903002501
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(oldc1) = Space(1

DoEvents 
oldc 
Right(oldcLen(oldc) - 1
Loop 
Do While Right(oldc1) = Space(1

DoEvents 
oldc 
Left(oldcLen(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 IntegerShift As Integer
As SingleAs 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 Form1.Height * ****1.Height To 600 Step -Screen.TwipsPerPixelY 
****1.Top 
Next i 
End 
If 
End Sub 


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



كود PHP:
Sub ThreeDForm(frmForm As Form

Const 
cPi 3.1415926 

Dim intLineWidth 
As Integer 

intLineWidth 


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

Dim intScaleWidth 
As Integer 
Dim intScaleHeight 
As Integer 

intScaleWidth 
frmForm.ScaleWidth 
intScaleHeight 
frmForm.ScaleHeight 

' 'clear form 
frmForm
.Cls 

' 'draw white lines 
frmForm
.Line (0intScaleHeight)-(intLineWidth0), &HFFFFFFBF 
frmForm
.Line (0intLineWidth)-(intScaleWidth0), &HFFFFFFBF 

' 'draw grey lines 
frmForm
.Line (intScaleWidth0)-(intScaleWidth intLineWidth
intScaleHeight
), &H808080BF 
frmForm
.Line (intScaleWidthintScaleHeight intLineWidth)-(0
intScaleHeight
), &H808080BF 

' 'draw triangles(actually circlesat corners 
Dim intCircleWidth 
As Integer 
intCircleWidth 
Sqr(intLineWidth intLineWidth intLineWidth intLineWidth
frmForm.FillStyle 
frmForm
.FillColor QBColor(15
frmForm.Circle (intLineWidthintScaleHeight 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 (0intScaleHeight)-(00), 
frmForm
.Line (00)-(intScaleWidth 10), 
frmForm
.Line (intScaleWidth 10)-(intScaleWidth 1intScaleHeight 1), 
frmForm
.Line (0intScaleHeight 1)-(intScaleWidth 1intScaleHeight 1), 
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 LongByVal hWnd As LongByVal Msg As LongByVal wParam As LongByVal lParam As Long) As Long 

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

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

Public Sub Hook(hWnd As Long
lngHWnd=hWnd 
lpPrevWndProc 
SetWindowLong(lngHWndGWL_WNDPROCAddressOf WindowProc
End Sub 

Public Sub UnHook() 
Dim lngReturnValue As Long 
lngReturnValue 
SetWindowLong(lngHWndGWL_WNDPROClpPrevWndProc
End Sub 

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

Select 
Case uMsg 

Case WM_RBUTTONUP 
'Do nothing 
'
Or popup you own menu 
Case Else 
WindowProc CallWindowProc(lpPrevWndProchwuMsgwParamlParam
End Select 
End 
Function 
----------------------------------------------------------------

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

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

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


كود PHP:
Private Sub Command1_Click() 
MsgBox Round(12.88152
End Sub 
Function Round(nValue As DoublenDigits 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 FormCtl As Control
' This Sub draws lines around controls to make them 3d 

darkgreyupper horizontal 
frm
.Line (Ctl.LeftCtl.Top 15)-(Ctl.Left 
Ctl
.WidthCtl.Top 15), &H808080BF 
' darkgrey, left - vertical 
frm.Line (Ctl.Left - 15, Ctl.Top)-(Ctl.Left - 15, _ 
Ctl.Top + Ctl.Height), &H808080, BF 
whiteright vertical 
frm
.Line (Ctl.Left Ctl.WidthCtl.Top)- 
(Ctl.Left Ctl.WidthCtl.Top Ctl.Height), &HFFFFFFBF 
' 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 
whiteleft vertical 
frm
.Line (00)-(0frm.ScaleHeight), &HFFFFFFBF 
' darkgrey, right - vertical 
frm.Line (frm.ScaleWidth - 15, 0)-(frm.ScaleWidth - 15, _ 
frm.Height), &H808080, BF 
darkgreylower horizontal 
frm
.Line (0frm.ScaleHeight 15)-(frm.ScaleWidth
frm
.ScaleHeight 15), &H808080BF 

End Sub 

'DEMO USAGE 
'
Add 1 label and ****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.Path13))
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 (0intLoop)-(Screen.WidthintLoop 1), RGB(0255 intLoop0), '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 (0intLoop)-(Screen.WidthintLoop 1), RGB(250100 intLoop), '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 (0intLoop)-(Screen.WidthintLoop 1), RGB(255 intLoop255 intLoop255 intLoop), '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(2552550)'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(6400'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(1280255)'Color - Purple
****Box3.BackColor = RGB(0, 255, 255)'
Color Cyan
'Define BorderColor for later use (when 
'     
borderstyle=fmBorderStyleSingle)
****
Box3.BorderColor RGB(000'Color - Black
****Box4.**** = "Bump"
****Box4.SpecialEffect = fmSpecialEffectBump
****Box4.ForeColor = RGB(255, 0, 255)'
Color Magenta
****Box4.BackColor RGB(00100'Color - Navy blue
****Box5.**** = "Raised"
****Box5.SpecialEffect = fmSpecialEffectRaised
****Box5.ForeColor = RGB(255, 0, 0) '
Color Red
****Box5.BackColor RGB(128128128'Color - Gray
****Box6.**** = "Sunken"
****Box6.SpecialEffect = fmSpecialEffectSunken
****Box6.ForeColor = RGB(0, 64, 0) '
Color Olive
****Box6.BackColor RGB(02550Color 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 

توقيع ضمتني الين طاح عقالي
 

لاتغتر بحلمي .... سعة صدري ليست عجز .... لكنني مللت من تربية المشردين أخلاقياً
هذا قلبي ... فليرني امرؤ قلبه
ضمتني الين طاح عقالي غير متواجد حالياً   رد مع اقتباس
قديم 03-23-2008, 06:52 PM   رقم المشاركة : [2]
جموح
.
 




جموح is a jewel in the rough جموح is a jewel in the rough جموح is a jewel in the rough

 
افتراضي رد: اكواد فيجوال بيسك3

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

لا عدمناك

توقيع جموح
 





سبحان الله وبحمده سبحان الله العظيم
جموح غير متواجد حالياً   رد مع اقتباس
إضافة رد

مواقع النشر (المفضلة)


الذين يشاهدون محتوى الموضوع الآن : 1 ( الأعضاء 0 والزوار 1)
 
أدوات الموضوع

تعليمات المشاركة
لا تستطيع إضافة مواضيع جديدة
لا تستطيع الرد على المواضيع
لا تستطيع إرفاق ملفات
لا تستطيع تعديل مشاركاتك

BB code is متاحة
كود [IMG] متاحة
كود HTML متاحة

الانتقال السريع

  Bookmark and Share

  


الساعة الآن 07:20 PM

|

www.swsws.net® Version 3.8.6
Copyright ©2000 - 2012, 7: swsws Ltd.
تنبية جميع ما يتم كتابته في المنتدى يعبر عن رأي كاتبه فقط ولا تتحمل إدارة منتديات سنتر العرب أدنى مسؤولية

Security team