مجموعة مفيدة من أكواد فيجوال بيسك

تم تحميل الصفحة في 0,3811646 ثانية
مجموعة مفيدة من أكواد فيجوال بيسك
الحالة
مغلق و غير مفتوح للمزيد من الردود.

dimah

شبح المغرب
rankrankrankrank
إنضم
5 سبتمبر 2010
المشاركات
1,365
الإعجابات
247
النقاط
63





الحمدلله والصلاة والسلام على رسول الله وعلى آله وصحبه أجمعين..

-- أتيت لكم إخواني بمجموعة من أكواد فيجوا بيسك لكل محبين هده البرمجة ..
أكواد مفيدة تتمتل في تنضيم وتنسيق و إضافة حركات رائعة ... --




طريقة جعل برنامجك فوق النوافذ الأخرى (دوماً في المقدمة)


إنسخ الشيفرة التالية إلى Module

Public 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

ثم أضف الشيفرة التالية في حدث التحميل (Load) للفورم

Dim vWindowPos As Long

vWindowPos = SetWindowPos(Form1.hwnd, -1, 0, 0, 0, 0, 1 Or 2)

تحريك النافذة عند النقر والسحب فوق الفورم أو أي عنصر
1- أنشيء فورم وضع فيه أداة CommandButton .
2- أعلن عن المتغيرات التاليه في قسم General :
Dim vX, vY
Dim vM As Boolean
3- إكتب الشفره التاليه في حدث MouseDown للأداة Command1
vX = X
vY = Y
vM = True
4- ثم أضف التالي في الحدث MouseMove للأداة Command1
Dim frmX, frmY
frmX = Form1.Left + (X - vX)
frmY = Form1.Top + (Y - vY)
If vM = True Then
Form1.Move frmX, frmY
End If
- أخيراً أضف الكود التالي للحدث MouseUp التابع للأداة Command1
Vm = False
لاحظ أنه يمكنك تغيير موقع زر أوصورة بنفس الطريقة ولاكن أكتب إسم العنصر الذي تريد تحريكه بدلاً منForm1


تشغيل حافظة الشاشة
إصنع فورم وأضف إليه زر Command1
وإنسخ الكود التالي إلى كود الفورم دون النقر فوق الفورم مرتين أي في قسم General
Option Explicit
Private Const WM_SYSCOMMAND = &H112
Private Const SC_SCREENSAVE = &HF140&
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 Sub Command1_Click()

LaunchScreenSaver Me.hwnd
End Sub

Sub LaunchScreenSaver(pl_OwnerFormHwnd As Long)

Call SendMessage(pl_OwnerFormHwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
End Sub

كود يعطيك معلومات عن محرك الأقراص . إسمه ' نظام ملفاته ' رقمه التسلسلي
أنسخ الأسطر التالية في قسم Module كما هي
Declare Function GetVolumeInformation Lib "kernel32.dll" Alias _ "GetVolumeInformationA" (ByVal lpRootPathName As String, _ ByVal lpVolumeNameBuffer As String, _ ByVal nVolumeNameSize As Integer, _ lpVolumeSerialNumber As Long, _ lpMaximumComponentLength As Long, _ lpFileSystemFlags As Long, _ ByVal lpFileSystemNameBuffer As String, _ ByVal nFileSystemNameSize As Long) As Long Function GetDiskProperties(strDrive As String, DiskName As String, DiskSystemFiles As String, DiskSerialNumber As Long) As Long Dim Res As Long DiskName = String$(255, Chr$(0)) DiskSystemFiles = String$(255, Chr$(0)) Res = GetVolumeInformation(strDrive, DiskName, _ Len(DiskName), DiskSerialNumber, 0, 0, DiskSystemFiles, Len(DiskSystemFiles)) GetDiskProperties = Res End Function

ثم أضف للفورم ثلاث زر Command1 و ثلاث خانات نص Text1 و Text2 و Text3 و قائمة منسدلة Combo1
ثم أنسخ الكود التالي وأضفة للفورم ، ثم نفذ( F5 ) وآختر احد الأزارير .

Dim NamDisk As String, SysFile As String, SerNum As Long Dim Drive As String Private Sub Form_Load() Combo1.AddItem "A:\" Combo1.AddItem "B:\" Combo1.AddItem "C:\" Combo1.AddItem "D:\" Combo1.AddItem "E:\" Combo1.AddItem "F:\" Combo1.ListIndex = 0 End Sub Private Sub Command1_Click() Drive = Combo1.Text Re = GetDiskProperties(Drive, NamDisk, SysFile, SerNum) Text1.Text = NamDisk Text2.Text = SysFile Text3.Text = SerNum End Sub


نبض الفورم
1 - اصنع فورم Form1 وضع فيه زر أمر Command1 وأدات التوقيت Timer1 وإنسخ مايلي الى الشيفرة

Option Explicit Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long Private mb_Flashing As Boolean Private Sub Command1_Click() mb_Flashing = Not mb_Flashing Timer1.Enabled = mb_Flashing If mb_Flashing = False Then Call FlashWindow(Me.hwnd, 0) End If End Sub Private Sub Timer1_Timer() Call FlashWindow(Me.hwnd, 1) End Sub

طريقة تشغيل موقع ويب وبريد الكتروني من داخل برنامجك(هام)
ضع الشيفرة التالية في Module أي وحدة نمطية

Option Explicit ' by kaled alzeeby alnamer soft Public Const URL = "http://www.kaled1.jeeran.com" Public Const email = "[email protected]" Public Declare Function ****************lExecute Lib "****************l32.dll" Alias "****************lExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Public Const SW_SHOWNORMAL = 1 Public Sub goto************() Dim Success As Long Success = ****************lExecute(0&, vbNullString, URL, vbNullString, "C:\", SW_SHOWNORMAL) End Sub Public Sub sendemail() Dim Success As Long Success = ****************lExecute(0&, vbNullString, "mailto:" & email, vbNullString, "C:\", SW_SHOWNORMAL) End Sub

اصنع فورم Form1 أضف اليه زرين Command1 _ Command2

أكتب في الأول الشيفرة التالية :
goto************

أكتب في الثاني الشيفرة التالية:
sendemail



CTRL+ALT+DEL كيفية ابطال عمل مفاتيح

ويهدف هذا الإجراء إلى منع المستخدم من إغلاق برنامجك أثناء التنفيذ حيث أن الضغط على هذه المفاتيح يمكنه من إنهاء البرنامج أو إنهاء ويندوز بكاملها
ويتم ذلك باستخدام الأسطر التالية
Declarations ضع التعريفين التاليين في قسم التعريفات

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
لإبطال عمل المفاتيح ضع السطر التالي في المكان المناسب
Call DisableCtrlAltDelete(True)
لإعادة عمل المفاتيح ضع السطر التالي في المكان المناسب
Call DisableCtrlAltDelete(False)


هـل الملف موجود أم لا ؟
قد يحتاج برنامجك في بعض الأحيان أن يعرف عن أحد الملفات كونه موجوداً على القرص أم لا ، يمكن عمل ذلك باستخدام الأسطر التالية :
If Dir(myfilename, vbNormal or vbReadOnly or vbHidden or vbSystem or vbArchive) = "" then
Msgbox "الملف غير موجود"
Else
Msgbox "الملف موجود"
End If
عدل السطور السابقة حسب إحتياجك

كيف تجعل النص يظهر بشكل عمودي في الأداة Label

يمكن عمل ذلك باستخدام الرمز vbCrLf ، حيث يوضع بعد كل حرف في محتوى الأداة Label كما يلي :
Private Sub Form_Activate()
Dim s As String
For i = 1 To Len(Label1)
s = s & Mid$(Label1, i, 1) & vbCrLf
Next
Label1 = s
End Sub
كيفية إغلاق ويندوز من داخل البرنامج أو إعادة تشغيل ويندوز
قد تحتاج في بعض البرامج أن تقوم بإعادة تشغيل ويندوز بعد قيام المستخدم بتعديل بعض الخيارات أو لدواع أمنية أو غير ذلك
لعمل ذلك ألصق الأسطر التالية في قسم التعريفات من برنامجك
Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Declare Function ExitWindowsEx Lib "user32" Alias _
"ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved _
As Long) As Long
وفي المكان المناسب ، ضع السطر التالي و الذي يقوم بإغلاق ويندوز
t& = ExitWindowsEx(EWX_REBOOT, 0)
EWX_REBOOT و يلاحظ أنه يمكن وضع أي من المتغيرات الموجودة أعلاه بدلاً من

تحديد النص في صندوق النص ذاتياًعند الضغط على زر مثلاً
تلاحظ في بعض البرامج عند انتقال التركيز من أداة ما على النافذة إلى صندوق نص يحتوي على نص فإنه يتم تحديد النص ذاتياً ، للحصول على ذلك في برنامجك قم بكتابة النص التالي في المكان المناسب ليتم تحديد النص
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
Text1.SetFocus

إخفاء مؤشر الفأرة في تطبيق فيجوال بيسك
تستطيع إخفاء مؤشر الفأرة في موضع معين من برنامجك باستخدام الدالة ShowCursor و التي يتم تعريفها في قسم التعريفات أعلى البرنامج لأنها من دوال واجهة برمجة التطبيقات API على النحو التالي :
Private Declare Function ShowCursor Lib "user32" _
(ByVal bShow As Long) As Long
ومن ثم تستطيع اخفاء المؤشر بتنفيذ الدالة بالشكل التالي
x = ShowCursor(False)
و تستطيع إعادة إظهار المؤشر بتنفيذ الدالة بالشكل التالي
x = ShowCursor(True)

هل يحتوي مشغل الأقراص المدمجة على قرص أم لا ؟؟
تستطيع من خلال إضافة السطور التالية إلى برنامجك تحديد ما إذا كان مشغل الأقراص المدمجة يحتوي على قرص أم لا
Dim FSO As FileSystemObject
Dim aDrive As Drive
Set FSO = New FileSystemObject
For Each aDrive In FSO.Drives
If aDrive.DriveType = CDRom And aDrive.IsReady = False Then
MsgBox "لا يوجد قرص في المشغل"
Exit For
ElseIf aDrive.DriveType = CDRom Then
MsgBox aDrive.VolumeName
Exit For
End If
Next
Set FSO = Nothing

ظهور رسالة MsgBox في وقت معين:

أضف زر أمر Command1
ضع الكود التالي في قسم التصريحات General:
Public Sub Delay(HowLong As Date)
TempTime = DateAdd("s", HowLong, Now)
While TempTime > Now
DoEvents
Wend
End Sub
ضع السطر التالي في الزر أو في أي مكان أخر


Delay 5
MsgBox " خالد الزعبي", vbExclamation, " النمر"


تدرج اللون لصندوق الصورة Picture



أضف Picture1 و زر أمر Command1
إنسخ الكود التالي إلى زر الأمر Command1
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


أرجوا أن ينال موضوعي إعجابكم


و في
الأخير شكر خاص لكل من زار موضوعي و قام برد و كلمة شكر و التقييم..

و لكل أعضاء و مشرفين منتدانا الحبيب..


و أتمنى ما تنسوا التقييم

نطمح للبلس-...







 
إنضم
22 أغسطس 2010
المشاركات
1,925
الإعجابات
747
النقاط
0
رد: مجموعة مفيدة من أكواد فيجوال بيسك

موضوع باين عليه متعوب عليه :)

تسلم يا غالي

ليك احلي تقييم ان امكن

:32:
 
إنضم
22 أغسطس 2010
المشاركات
1,925
الإعجابات
747
النقاط
0
رد: مجموعة مفيدة من أكواد فيجوال بيسك

تم التقييم بنجاح :)
:9:
 

dimah

شبح المغرب
rankrankrankrank
إنضم
5 سبتمبر 2010
المشاركات
1,365
الإعجابات
247
النقاط
63
رد: مجموعة مفيدة من أكواد فيجوال بيسك

مرورك يا غالي شرف لي:8:
تسلم على التقييم :30:
 
إنضم
28 أكتوبر 2009
المشاركات
6,862
الإعجابات
1,078
النقاط
113
رد: مجموعة مفيدة من أكواد فيجوال بيسك

تسلم يا غالي
:32::32::32::32::32:
ليك احلي تقييم
:32::32::32::32::32::32:
 
إنضم
12 يناير 2010
المشاركات
5,085
الإعجابات
1,012
النقاط
0
العمر
28
رد: مجموعة مفيدة من أكواد فيجوال بيسك

[font=ae_almothnna]وعليكم السلام ورحمة الله و بركاته[/font]

[font=ae_almothnna]ماشاء الله موضوع مفيد [/font]

[font=ae_almothnna]و تنسيق جميل يحبب قراءته[/font]

[font=ae_almothnna]يعطيك العافية على الطرح المميز[/font]

لقد أعطيت تقييم أكثر من اللازم خلال 24 الماضية, حاول ثانية فيما بعد.

[font=ae_almothnna]سيصلك التقييم حالما يفك إن شاء الله[/font]

[font=ae_almothnna]تحياتي لك :9:[/font]

 
إنضم
9 مارس 2011
المشاركات
257
الإعجابات
17
النقاط
18
رد: مجموعة مفيدة من أكواد فيجوال بيسك

متعوب عليه بصراحه ويعطيك العافيه تستاهل التقيم ومفروض تاخذ البلس:32:

لقد أعطيت تقييم أكثر من اللازم خلال 24 الماضية, حاول ثانية فيما بعد.:31:
 

Mr.ONLY

Beginner Developer
rank
إنضم
10 مارس 2011
المشاركات
129
الإعجابات
20
النقاط
0
رد: مجموعة مفيدة من أكواد فيجوال بيسك

مبدع بارك الله بيك تحياتي لك
 

CaTmAn

VIP DeveloPer
إنضم
29 أغسطس 2010
المشاركات
7,525
الإعجابات
6,875
النقاط
113
العمر
99
الإقامة
الرياض
رد: مجموعة مفيدة من أكواد فيجوال بيسك

هذي هي المواضيع الحلوووة :6:
جاري التقييم
 

dimah

شبح المغرب
rankrankrankrank
إنضم
5 سبتمبر 2010
المشاركات
1,365
الإعجابات
247
النقاط
63
رد: مجموعة مفيدة من أكواد فيجوال بيسك

مشكوورين إخواني على المرور الطيب
و الردود الجميلة تفتح النفس أنا عن جد أشكرم إخواني مروركم أفضل من 100 تقييم :30:
 

Abo Ziad

.:: Administrative ::.
طاقم الإدارة
إنضم
27 أغسطس 2008
المشاركات
24,154
الإعجابات
22,171
النقاط
113
رد: مجموعة مفيدة من أكواد فيجوال بيسك

روعه والله
آكواد في غايه الروعه والجمال
تسسلم إيدك يا بطل
كان نفسي اقيمك ولكن
لقد أعطيت تقييم أكثر من اللازم خلال 24 الماضية, حاول ثانية فيما بعد.
 

xSA

ExpErt DeveloPer
rankrankrankrankrank
إنضم
5 أغسطس 2007
المشاركات
2,196
الإعجابات
794
النقاط
113
رد: مجموعة مفيدة من أكواد فيجوال بيسك

يعطيك الف عافيه
يجب أن تضع للبعض سمعات قبل إعطائها إلى dimah مرة أخرى.
 

AL-3NEED

ExpErt DeveloPer
rankrankrankrankrank
إنضم
15 أغسطس 2010
المشاركات
2,387
الإعجابات
484
النقاط
83
رد: مجموعة مفيدة من أكواد فيجوال بيسك

بارك الله فيك يالغلا ..

وجارى تقيمك

واصل يابطل
 

Mr.CoBrA

ExpErt DeveloPer
rankrankrankrankrank
إنضم
25 أكتوبر 2009
المشاركات
2,298
الإعجابات
265
النقاط
83
رد: مجموعة مفيدة من أكواد فيجوال بيسك

بارك الله فيك
واصل حبيبي ولا تحرمنا من جديدك
:9:
 
إنضم
26 ديسمبر 2009
المشاركات
8,093
الإعجابات
951
النقاط
113
رد: مجموعة مفيدة من أكواد فيجوال بيسك

شغل متعوب عليه بجد


يعطيك الف عافيه

تم التقييم
:13::9:
 
إنضم
19 نوفمبر 2006
المشاركات
16,544
الإعجابات
9,173
النقاط
113
العمر
33
الإقامة
فُتنه فلا تقربونّ ♥
رد: مجموعة مفيدة من أكواد فيجوال بيسك

يجب أن تضع للبعض سمعات قبل إعطائها إلى dimah مرة أخرى.
الله يعطيك العافيه ,

موضوع مميز ويستحق 5 نجوم

ا
 
الحالة
مغلق و غير مفتوح للمزيد من الردود.

الأعضاء النشطين حاليآ الذين يشاهدون هذا الموضوع (1 عضو و 0 ضيف)

خيارات الاستايل

نوع الخط
مودك
اخفاء السايدر بار OFF
توسيط المنتدى OFF
فصل الأقسام OFF
الأقسام الفرعية OFF
عرض المشاركات
حجم الخط
معلومات العضو OFF
إخفاء التوقيع OFF

إرجاع خيارات الإستايل