اكواد فيجول بيزك

هذا كود للتأكد من وجود ملف ، فإذا كان موجوداً تظهر رسالة مكتوب فيها الرقم 1 أما إذا لم يكن موجوداً فتظهر لك رسالة مكتوب فيها الرقم 0



private Declare Function SHFileExists Lib "shell32" Alias "#45" (ByVal szPath As String) As Long
Private Sub Form_Load()
MsgBox Str$(SHFileExists("c:\autoexec.bat"))
End Sub
-------------------------------------------------------------
كود لتحويل ألوان الصور إلى الرمادي
أضف زر كوماند ومربع صورة واكتب في الكوماند الكود التالي
Picture1.ScaleMode = vbPixels
x = Picture1.ScaleWidth
y = Picture1.ScaleHeight
For i = 0 To y - 1
For j = 0 To x - 1
pixel = Picture1.Point(j, i)
red = pixel Mod 256
green = ((pixel And &HFF00) / 256) Mod 256
blue = (pixel And &HFF0000) / 65536
g = ((red * 30) + (green * 60) + (blue * 20)) / 100
Picture1.PSet (j, i), RGB(g, g, g)
Next
Next
Picture1.ScaleMode = vbTwips
-------------------------------------
هذا الكود لمعرفة هل أنت متصل بالإنترنت أم لا
ضع هذا في قم التصريحات General
Private Declare Function InternetGetConnectedState _
Lib "wininet.dll" (ByRef lpSFlags As Long, _
ByVal dwReserved As Long) As Long
Private Function Online() As Boolean
Online = InternetGetConnectedState(0&, 0&)
End Function
أضف زر كوماند واكتب الكود التالي
MsgBox Online()
تحياتي..
----------------------------------------------
لإلغاء تحميل فورم ما وليكن
Form2 إستعمل الكود
Unload Form2
--------------------------------
لتشغيل حدث معين عند الضغط على مفتاح Enter وليكن ظهور رسالة إكتب الكود التالي
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
MsgBox "Syphonfilter مع تحيات"
End If
End Sub
-------------------------------------
ما هو التصريح ؟
التصريح هو كلام تكتبه مع الكود من غير إحتسابه كود أي لا يتعامل معه فيجوال بيسيك ككود ولاكن كتصريح .
ماذا نستفيد من التصريح ؟
يمكنك من خلال التصريح توصيل معلومة أو ملاحظة للمستخدم البرنامج إذا كنت لم تحول البرنامج إلى إمتداد EXE
لوضع تصريح ما عليك إلا كتابة الرمز (') ثم كتابة الكلام الذي تريد .
تحياتي
---------------------------------------
هل تريد مسح الكتابة المحدد في اليست إذاً إكتب الكود
If List1.ListIndex > -1 Then
List1.RemoveItem List1.ListIndex
End If
تحياتي
--------------------------------------
هل تريد جعل الفورم في حجم واحد لا يتغير إستخدم الكود التالي
Private Sub Form_Resize()
Width = 3000
Height = 3000
End Sub
----------------------------------------
هل تريد حذف النص المحدد في ال TextBox إكتب الكود
Text1.Seltext = Clear
تحياتي
----------------------------------------
هل تريد تشغيل كود زر الأمر بمجرد الضغط على مفتاح Enter من لوحة المفاتيح ما عليك تحديد زر الأمر ومن ثم تغيير خاصية Default إلى True
تحياتي
-----------------------------------------
هل فكرة يوماً أن تغير لون زر الأمر Command ، تستطيع ذلك من خلال تغيير خاصية Style إلى 1 ثم اختيار اللون الذي تريد من خلال خاصية BackGround
تحياتي
-------------------------------------------------------
هل سمعة عن أداة ما ولم تجدها في صندوق الأدوات ، تستطيع إضافة الأداة التي تريد وذلك من خلال الضغط على Ctrl+t ثم اختيار الأدات التي ترد بوع علامة صح أمام الآدات ثم الضغط على Enter
تحياتي
------------------------------------------------------------
هل تريد فتح ملف نصي تلقائياً في برنامج ال Notepad أضف الكود التالي مع تغيير المسار إلى مسار الملف الذي تريد
Shell "notepad.exe" & " " & "C:\windows\desktop\books.txt", vbNormalFocus
تحياتي
---------------------------------------------
هل تريد عمل رقم سري لبرنامجك ؟ هذا الكود يمكنك من عمل ذلك ( كلمة السر هي فلسطين )
[a = InputBox("إدخل الرقم السري", "الرقم السري")
If a = "فلسطين" Then '
MsgBox "كلمة السر صحيحة"
Else
MsgBox "كلمة السر خاطئة"
End If
تحيات
-----------------------------------------------
هذا الكود لإظهار رسالة للمستخدم عند الضغط بزر الفأرة الأيمن
ضع الكود في حدث MouseMove
IF Button = 2 then
MsgBox "ممنوع الضغط بزر الفأرة الأيمن"
End if
------------------------------------------
إذا كنت تريد ظهور رسالة عند الضغط بزر الفأرة الأيسر إكتب الكود التالي في حدث MouseMove
IF Button = 1 then
MsgBox "ممنوع الضغط بزر الفأرة الأيسر"
End if
------------------------------------------
لإضافة النص من التسكت بوكس إلى اليست بوكس إتبع الآتي :
1- أضف زر Command .
2- أضف TextBox و ListBox .
3- إكتب الكود التالي في زر الأمر Command في حدث Click
List1.AddItem Text1.text
تحياتي
----------------------------------------
هل تريد عمل ساعة رقمية ؟؟ هذا الكود يمكنك من ذلك ؟!
إتبع الخطواة التالية :
1- أضف Timer إلى الفورم .
2- أضف Label إلى الفورم وامسح الكتابة الموجودة في خاصية Caption أي إجعله بدون إسم .
3- إجعل خاصية Enterval للتايمر بقيمة 100 .
4- أضف الكود التالي للتايمر :
Label1.Caption = Time
تحياتي
------------------------------------------
لجعل الخط في التكست بوكس غامق
Text1.FontBold = True
تحياتي
-----------------------------------
لجعل الخط مائل
Text1.FontItalic = True
لجعل خط تحت الكلمات في التكست بوكس
Text1.FontUnderline = True
تحياتي
------------------------------------
لتغيير لون الخط في التكست بوكس ما عليك إلا كتابة الكود
Text1.ForeColor = Color
مع تغيير كلمة Color إلى شفرة اللون الذي تريد
تحياتي..
---------------------------------------
هذا الكود يحول الحروف الإنجليزية لإحرف كبيرة
Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr$(KeyAscii)))
End Sub
--------------------------------------------------------------------------------
هل تريد إدارج التاريخ في التكست بوكس ..إذاً إكتب الكود التالي
Text1.text = Date
--------------------------------------------------------------------------------
هذا الكود لإضافة الوقت للتكست بوكس
Text1.text = Time
--------------------------------------------------------------------------------
هذا الكود لإظهار رسالة للمستخدم
MsgBox "String", vbInformation, "Title"
حيث String تضع فيها جسم الرسالة من نوع بيانات String و vbInformation نوع الرسالة أي رسالة خطأ أو معلومات فهنا وضعت شكل رسالة معلومات تستطيع تبديلها لتكون vbyesno أي زر نعم أو لا
و ال Title هو العنوان
-----------------------------------------------------------------------------
هذا الكود لقلب الصورة بشكل عمودي
Picture2.PaintPicture Picture1.Picture, 0, 0, _
Picture1.Width, Picture1.Height, 0, Picture1.Height, _
Picture1.Width, -Picture1.Height, vbSrcCopy
--------------------------------------------------------------------------------
هذا الكود لمعرفة مجلد الملفات الؤقته
strTempDir = Environ$("temp")
MsgBox strTempDir
--------------------------------------------------------------------------------
هذا الكود لطباعة النص الموجود في التكست بوكس
Printer.Print Text1.Text
--------------------------------------------------------------------------------
هذا الكود لمعرفة عدد الأسطر في التكست بوكس
ضع هذا في قسم التصريحات General

code:--------------------------------------------------------------------------------
Private Declare Function SendMessageLong Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const EM_GETLINECOUNT = &HBA
--------------------------------------------------------------------------------
وهذا في زر Command مثلاً
Dim lineCount As Long
On Local Error Resume Next
lineCount = SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, 0)
MsgBox Format$(lineCount, "##,###")
--------------------------------------------------------------------------------
هذا الكود لإبطال عمل مفاتيح Ctrl+Del+Shift
ضع هذا في قسم التصريحات General
Private Declare Function SystemParametersInfo Lib _
"user32" Alias "SystemParametersInfoA" (ByVal uAction _
As Long, ByVal uParam As Long, ByVal lpvParam As Any, _
ByVal fuWinIni As Long) As Long
Sub DisableCtrlAltDelete(bDisabled As Boolean)
Dim X As Long
X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub
--------------------------------------------------------------------------------
لإبطال عمل المفاتيح
code:--------------------------------------------------------------------------------
Call DisableCtrlAltDelete(True)
--------------------------------------------------------------------------------
لإرجاعها

Call DisableCtrlAltDelete(False)
--------------------------------------------------------------------------------
ا الكود لمعرفة مجلد الويندوز
Dim winPath As String
winPath = Environ$("windir")
--------------------------------------------------------------------------------
هذا الكود لمنع إستخدام المسافة في صندوق النص
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 32 Then
KeyAscii = 0
End If
End Sub
تستطيع منع مفتاح آخر من لوحة المفاتيح وذلك بتغيير القيمة 32 إلى قيمة المفتاح الذي تريد منعه
--------------------------------------------------------------------------------
هذا الكود للربط بين صندوق اليسة مع صندوق ليسة بوكس آخر
List2.ListIndex = List1.ListIndex
--------------------------------------------------------------------------------
هل تريد معرفة دقة الشاشة عندك ..ضع هذا الكود في Command
Dim intWidth As Integer
Dim intHeight As Integer
intWidth = Screen.Width \ Screen.TwipsPerPixelX
intHeight = Screen.Height \ Screen.TwipsPerPixelY
MsgBox "Screen Resolution:" + Str$(intWidth) + " x" + Str$(intHeight)
--------------------------------------------------------------------------------
إذا كنت تريد فتح أي ملف ما عليك إلا كتابة الكود
Shell ""
ضع عنوان الملف المراد مع إسمه بين علامتي الإقتباس
--------------------------------------------------------------------------------
لإظهار فورم ما وليكن إسمه Form2 إكتب الكود التالي
Form2.Show
--------------------------------------------------------------------------------
ولإخفاءه
Form2.Hide
--------------------------------------------------------------------------------
لتغيير إسم الخط في التكست بوكس إكتب الكود
Text1.FontName = Andalus
تستطيع إختيار إسم الخط الذي تريد وذلك بتغيير Andalusإلى إسم الخط الذي تريد
تحياتي
--------------------------------------------------------------------------------
لجعل النص في التكست بوكس يتوسطه خط إكتب الكود
Text1.FontStrikethru = True
ولتغيير حجم الخط إكتب الكود
Text1.FontSize = 12
غير الرقم 12 إلى الرقم الذي تريد
تحياتي
--------------------------------------------------------------------------------
لتحميل صورة إلى ال Picture Box إكتب الكود التالي
Picture1 = LoadPicture("C:\Picture.bmp")
ولحفظ صورة إكتب الكود التالي
savepicture picture1.picture, "C:\Picture.bmp
--------------------------------------------------------------------------------
لتحميل جميع خطوط الكمبيوتر في ال Combo Box إكتب الكود
Private Sub Form_Load()
Dim i As Integer
For i = 0 To Screen.FontCount - 1
Combo1.AddItem Screen.Fonts(i)
Next i
Combo1.Text = Combo1.List(0)
End Sub
تحياتي
--------------------------------------------------------------------------------
تستطيع إخفاء زر الكوماند أو أي شيء آخر وذلك بالكود التالي كمثال نطبق على زر الأمر Command
Command1.Visible = False
حيث أنه يغير في الخصائص أي تستطيع عمل هذا التغيير مباشرة من الخصائص
تحياتي
--------------------------------------------------------------------------------
هل تريد تجميد الويندوز ؟ إستخدم الكود التالي
أضف هذا الكود في قسم التصريحات General
Public Declare Function SetParent Lib "user32" (ByVal _
hWndChild As Long, ByVal hWndNewParent As Long) As Long
وأضف هذا الكود في زر الأمر Command
SetParent Me, Me
تحياتي
--------------------------------------------------------------------------------
هذا الكود لعمل فورم رخامي
ضع هذا الكود في قسم التصريحات General
Private Sub GradientFill()
Dim i As Long
Dim c As Integer
Dim r As Double
r = ScaleHeight / 3.142
For i = 0 To ScaleHeight
c = Abs(220 * Sin(i / r))
Me.Line (0, i)-(ScaleWidth, i), RGB(c, c, c + 30) 'Notice the bias To blue. You can be more subtle by reducing this number (try 10). Try other colours too.
Next
End Sub
وهذا الكود في حدث Resize للفورم
GradientFill
تحياتي
--------------------------------------------------------------------------------
هل تريد الخروج من البرنامج بواسطة الضغط على مفتاح Esc إكتب الكود التالي :
في حدث التحميل للفورم إكتب الكود
Form1.KeyPreview = True
وفي حدث KeyPress للفورم إكتب
If KeyAscii = 27 Then
End
End If
--------------------------------------------------------------------------------
هذه الدالة لتحميل صفحة من الإنترنت
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Sub Command1_Click()
lngRetVal = URLDownloadToFile(0, "http://www.arabsgate.com/", "c:\Arabsgate.htm", 0, 0)
End Sub
في هذا المثال وضعت موقع بوابة العرب للتحميل
--------------------------------------------------------------------------------
هذه الدالة تقوم بنقل ملف من مسار إلى مسار آخر
Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long
Private Sub Command1_Click()
MoveFile "c:\Windows\Desktop\a.txt", "c:\a.txt"
End Sub
--------------------------------------------------------------------------------
هذه الدالة تقوم بتعطيل زر إغلاق Close الذي يوجد في كل نافذة
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Const MF_BYPOSITION = &H400&
Private Sub Form_Load()
Dim a As Long, b As Long
a = GetSystemMenu(Me.hwnd, False)
b = GetMenuItemCount(a)
RemoveMenu a, b - 1, MF_BYPOSITION
DrawMenuBar Me.hwnd
End Sub
--------------------------------------------------------------------------------
هذا الكود للكتابة في ال TextBox
Text1.Text = "القدس لنا"
--------------------------------------------------------------------------------
هذه الدالة لتغيير ألوان الواجهة للويندوز
Private Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Const COLOR_ACTIVECAPTION = 2
Private Sub Form_Load()
a = GetSysColor(COLOR_ACTIVECAPTION)
SetSysColors 1, COLOR_ACTIVECAPTION, RGB(255, 200, 140)
MsgBox "The old title bar color was" + Str$(a) + " And is now" + Str$(GetSysColor(COLOR_ACTIVECAPTION))
End Sub
--------------------------------------------------------------------------------
هذا الكود للتحويل من المئوي إلى الفهرنهايتي
أضف 2 تكست بوكس الأول للإدخال والثاني للقيمة بعد التحويل ، واضف زر كوماند واكتب بداخله الشفرة التالية
Private Sub Command1_Click()
Dim m
m = Text1.Text
Text2.Text = (9 / 5 * m) + 32
End sub
تحياتي
--------------------------------------------------------------------------------
هذه الدالة تعرض مربع حوار تهيئة القرص المرن
Const SHFD_CAPACITY_DEFAULT = 0
Const SHFD_FORMAT_QUICK = 0
Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwndOwner As Long, ByVal iDrive As Long, ByVal iCapacity As Long, ByVal iFormatType As Long) As Long
Private Sub Form_Load()
SHFormatDrive Me.hwnd, 0, SHFD_CAPACITY_DEFAULT, SHFD_FORMAT_QUICK
End Sub
--------------------------------------------------------------------------------
هذا الكود لإعادة تشغيل الجهاز
أضف هذا الكود في قسم التعريفات General
Private Declare Function SetupPromptReboot Lib "setupapi.dll" (ByRef FileQueue As Long, ByVal Owner As Long, ByVal ScanOnly As Long) As Long
أضف هذا الكود في حدث الضغط على زر Command
SetupPromptReboot ByVal 0&, Me.hWnd, 0
تحياتي
--------------------------------------------------------------------------------
هذا الكود يقوم بإخبارك هب يوجد كرت صوت أم لا أي هل تستطيع تشغيل ملفات الأصوات في جهازك
ضع هذا الكود في الموديل Module
Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
اضف زر Command وضع فيه الكود التالي
Dim i As Integer
i = waveOutGetNumDevs()
If i > 0 Then
MsgBox "بالإمكان تشغيل ملفات الأصوات في جهازك", _
vbInformation, "التأكد من وجود كرت الصوت"
Else
MsgBox "ليس بالإمكان تشغيل ملفات الأصوات في جهازك", _
vbInformation, "التأكد من وجود كرت الصوت"
End If
--------------------------------------------------------------------------------
هل تريد التعرف على خصائص الطابعة أي هل تريد إظهار نافذة خصائص الطابعة إتبع ما يلي :
إضغط على ctrl+t
إختر من النافذة التي سوف تظهر لك Microsoft Common Dialog وذلك بوضع أمامه صح ثم OK
أضفه في الفورم واكتب الكود التالي في حدث الضغط على زر
Dim BeginPage, EndPage, NumCopies, i
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
CommonDialog1.ShowPrinter
BeginPage = CommonDialog1.FromPage
EndPage = CommonDialog1.ToPage
NumCopies = CommonDialog1.Copies
For i = 1 To NumCopies
Next i
Exit Sub
ErrHandler:
Exit Sub
--------------------------------------------------------------------------------
ل تريد عمل قائمة منبثقة إتبع الآتي :
إصنع قائمة عادية وضع خاصية Visible للقائمة الأولى False الآن إكتب الكود التالي في حدث Mouse Down
if button = 2 then
PoPupMenu MenuName
إستبدل ال Menu Name بإسم قائمتك
--------------------------------------------------------------------------------
هذا الكود يقوم بتحديد كلي للنص الموجود في مربع النص TextBxo
With Text1
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
Text1.SetFocus
End With
--------------------------------------------------------------------------------
هذا الكود لستبدال كلمة أو حرف أو جملة في ال TextBox
أضف زر Command و TextBox إلى الفورم
ضع هذا في حدث التحميل للفورم
Text1.Text = "فلسطين لنا"
وهذا في حدث الضغط على زر Command
Text1.Text = Replace(Text1.Text, "فلسطين", "القدس", 1)
--------------------------------------------------------------------------------
هذا الكود يقوم بإظار رسالة للمستخدم عند إدخال غير الأرقام في ال TextBox
ضع الكود التالي في حدث التغيير لل TextBox
If Text1.Text <> Numeric Then
MsgBox "يجب أن تدخل أرقاماً وليس حروفاً أو رموزاً", vbInformation, "Syphonfilter مع تحيات"
End If
--------------------------------------------------------------------------------
هذا الكود لإزالة جميع العناصر الموجودة في ال ListBox
List1.Clear
وهذا الكود لإزالة عنصر واحد من ال ListBox
List1.RemoveItem "1"
تحياتي
--------------------------------------------------------------------------------
هذا الكود يقوم بجمع الأرقام الموجود في Text1 و Text2 ويضع الناتج في Label1
Label1.Caption = Val(Text1.Text) + Val(Text2.Text)
وهذا الكود يقوم بطرح ال Text1 من ال Text2 ويضع الناتج في ال Label1
Label1.Caption = Val(Text1.Text) - Val(Text2.Text)
هذا الكود يقوم بضرب Text1 بـ Text2 ويضع الناتج في ال Label1
Label1.Caption = Val(Text1.Text) * Val(Text2.Text)
هذا الكود يقوم بقسمة Text1 على Text2 ويضع الناتج في ال Label1
Label1.Caption = Val(Text1.Text) / Val(Text2.Text
--------------------------------------------------------------------------------
'يقوم بنسخ النص من مربع النص الأول إلى مربع النص الثاني الموجود في الفورم الثاني
Form2.Text1 = Form1.Text1.Text
'يقوم بإخفاء الفورم الأول
Unload Form1
End Sub

شكرا لك و جزاك الله خيرا
:كط: :كط: :كط: :كط:

:رائع: :رائع: :رائع:

:رائع: :مكم: :منمنم:

ماأجمل تلك المشاعر التي
خطها لنا قلمكِ الجميل هنا
لقد كتبتِ وابدعتِ
كم كانت كلماتكِ رائعه في معانيها
فكم استمتعت بموضوعك الجميل
بين سحر حروفكِ التي
ليس لها مثيل

جزاك الله كل خير اخى
بارك الله فيك
جعله الله فى ميزان حسنات وحسناتنا
وفقق الله