.................................................. ......................
هذا الكود يقوم بإخبارك هب يوجد كرت صوت أم لا أي هل تستطيع تشغيل ملفات الأصوات في جهازك
ضع هذا الكود في الموديل 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
.................................................. .........................
هذا الكود يقوم بجمع الأرقام الموجود في 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)
.................................................. ......................
هذا الكود لمعرفة البارامترات التي يتم تمريرها للبرنامج في سطر الأوامر :
Function GetCommandLine(Optional MaxArgs)
Dim C, CmdLine, CmdLnLen, InArg, I, NumArgs
If IsMissing(MaxArgs) Then
MaxArgs = 10
End If
ReDim ArgArray(MaxArgs)
NumArgs = 0:
InArg = False
CmdLine = Command()
CmdLnLen = Len(CmdLine)
For I = 1 To CmdLnLen
C = Mid(CmdLine, I, 1)
If (C <> " " And C <> vbTab) Then
If Not InArg Then
If NumArgs = MaxArgs Then
Exit For
End If
NumArgs = NumArgs + 1
InArg = True
End If
ArgArray(NumArgs) = ArgArray(NumArgs) & C
Else
InArg = False
End If
Next I
ReDim Preserve ArgArray(NumArgs)
GetCommandLine = ArgArray()
End Function
Private Sub Form_Activate()
Dim I
s = GetCommandLine
For I = 1 To UBound(s)
Print s(I)
Next I
End Sub
.................................................. ......................
كيف تضع محتويات ملف في ليستا
Private Sub Command1_Click()
Dim StringHold As String
Open "C:\test.txt" For Input As #1
List1.Clear
While Not EOF(1)
Input #1, StringHold
List1.AddItem StringHold
Wend
Close #1
End Sub
.................................................. .......................
كيف تعرف اذا تم تغيير محتويات TextBox
Private bChanged As Boolean
Private Sub Text1_Change()
bChanged = True
End SubPrivate
Sub Form_Unload(Cancel As Boolean)
If bChanged Then
If Msgbox("Save Changes?", vbYesNo, "Save") = vbYes Then
'Save Changes Here.
End If
End If
End Sub
.................................................. .........................
كيف تصنع قائمة فرعية من خلال زر امر
First, create a menu with the menu editor.
It should look like this:
Button Menu (Menu name: mnuBtn, Visible: False - Unchecked)
....SubMenu Item 1 (Menu name: mnuSub, Index: 0)
....SubMenu Item 2 (Menu name: mnuSub, Index: 1)
....SubMenu Item 3 (Menu name: mnuSub, Index: 2)
....SubMenu Item 4 (Menu name: mnuSub, Index: 3)
I hope you understand the above. Also create a CommandButton.
Then add this code:
Private Sub mnuSub_Click(Index As Integer)
Call MsgBox("Menu sub-item " & Index + 1 & " clicked!", _
vbExclamation)
End Sub
Private Sub Command1_Click()
Call PopupMenu(mnuBtn)
End Sub
P.S. For added effect, replace the line:
Call PopupMenu(mnuBtn)
With this one:
Call PopupMenu(Menu:=mnuBtn, X:=Command1.Left, Y:=Command1.Top + _
Command1.Height) ' Even more viola!
Or this one:
Call PopupMenu(mnuBtn, vbPopupMenuCenterAlign, Command1.Left + _
(Command1.Width / 2), Command1.Top + Command1.Height
.................................................. .........................
نسخ محتويات مربع نص الى مربع نص اخر
If you have VB6.0 you can use the Replace Function to
easily replace any Character(s) with something else, eg.
Text2 = Replace(Text1, vbCrLf, "" & vbCrLf)
Otherwise, you'll need to step though the Text yourself
checking for instances of vbCrLf, e.g.
code:
Dim sString As String
Dim sNewString As Strings
String = Text1
While Instr(sString, vbCrLf)
sNewString = sNewString & Left(sString, _
Instr(sString, vbCrLf) - 1) & "" & vbCrLf
sString = Mid(sString, Instr(sString, vbCrLf) + 2)
Wend
Text2 = sNewString
.................................................. .........................
) أكواد الحافظة....
الحافظة في الفيجوال بيسك تأخذ الأسم Clipboard ، حيث يتم ربط توابع معينة بهذا
الكائن لكي تتم أوامر الحافظة...سأكتب الأكواد على فرض أن لدينا صندوق نص اسمه
txtMyText...
*** كود القص:
Clipboard.clear
Clipboard.SetText txtMyText.SelText
txtMyText.SelText=""
إن المنهج Clear يقوم بتفرغة كل محتويات الحافظة... كما يقوم الأمر SetText بإضافة النص المحدد إلى الحافظة... و إذا أردنا معرفة ما تحملة العبارة التالية txtMyText.SelText فهي تحمل قيمة النص المحدد... أي أن SelText تشير إلى النص المحدد...
ثم في العبارة الأخيرة، نحذف النص المحدد لكي تتم عملية القص...
*** كود النسخ:
Clipboard.clear
Clipboard.SetText txtMyText.SelText
هذا الكود يماثل تماما الكود السابق، لكن الفرق أننا لا نقوم بحذف النص المحدد و الذي نود نسخه...
*** كود اللصق:
txtMyText.SelText=ClopBoard.GetText( )
إن العبارة ClipBoard.GetText() تحمل قيمة النص الموجود في الحافظة.... و نحن نأمر الجهاز في هذا الكود بوضع قيمة الحافظة مكان النص المحدد...
2) كود الأحداث المعلقة:
من المؤكد أنكم تتسائلون " ما هي الأحداث المعلقة؟ "، أنا سأشرح لكم...
إن بعض البرامج تحتوي على Loop أي حلقة ... و لهذه الحلقة أشكال كثيرة، أشهرها و
أكثرها شيوعا:
For I=0 to 100
.......
.....
.......
if I=100 then I=0
next I
إذا قمنا بتحليل عمل هذا البرنامج، نتوصل إلى انه سيقوم بتنفيذ الأوامر الموجودة داخل الحلقة إلى ما لا نهاية... و بذلك، فإن أي حدث تقوم بتنفيذه خلال عمل هذه الحلقة فإنه لن يستجيب.....
أعرف أنكم لم تفهموا، سأوسع الشرح...
لنفرض أنه لدينا برنامج يقوم برسم نقاط عشوائية على نموذج معين، و هذه النقاط غير منتهية.... و لدينا زري أوامر، الأول للبدء الحلقة، و الثاني لإنهاءها...
إذا ضغطنا زر البدء، فإن الحلقة ستبدأ إلى ما لا نهاية.... و سترسم نقاطا على النموذج إلى ما لا نهاية... فعند القيام بحدث الضغط على زر إنهاء الحلقة، فأنه لن يستجيب أبدا، و ذلك بسبب عمل الحلقة.... فما الحل إذن...
يوجد تابع خاص لهذه المشكلة و هو DoEvents... عند وضع هذا التابع ضمن الحلقة، فإنه ينفذ الحدث الذي قمت به، ثم يكمل تنفيذ الحلقة....
3) كود تنفيذ أي برنامج عن طريق الفيجوال بيسك:
إذا أردت أن تشغل إي برنامج في جهازك عن طريق الفيجوال بيسك، اكتب العبارة التالية....
Dim A
A = Shell ("programpath",n)
حيث A متغير... و اكتب مكان الــ programpath مسار البرنامج كاملا، و اكتب مكان n رقم من 0 إلى 6، حيث كل رقم له دلالته...
0 تظهر نافذة البرنامج مخفية.
1 تظهر نافذة البرنامج بحجمها الطبيعي و معها التركيز.
2 تظهر النافذة مصغرة و معها التركيز.
3 تظهر النافذة مكبرة و ومعها التركيز.
4 تظهر نافذة عادية و بدون تركيز.
6 تظهر نافذة مصغرة بدون تركيز.
و إن التابع Shell يرجع قيمة عددية تحفظ في المتغير A تشير إلى مقبض النافذة الذي يعترف عليه Windows
ملاحظة: الفائدة من وضع القيمة 0 للمتغير n ، هي لظهور النافذة مخفية، و بالتالي يتم تحميل النافذة في الذاكرة دون أن نراها. و نستغيد من هذه الحالة في تشغيل ملف تنفيذي لكي يؤدي وظائف معينة دون أن يشاهد المستخدم نافذة البرنامج (برامج الفيروسات و التجسس)
4) كود للقيام باتصال هاتفي:
يجب أولا تضمين أداة جديدة و هي MSComm، و ذلك بالخطوات التالية:
* اضغط بزر اليمين على مكان فارغ شريط الأدوات.
* اختر الخيار Components
* اختر الأداة MSComm من القائمة و اضغط على الزر موافق.
* ستظهر لك أداة جديدة لها شكل الهاتف على شريط الأدوات.
بعد تضمين هذه الأداة في النموذج، نسميها على سبيل المثال Comm1....
و إليك الكود:
Dim PhoneNumber as String
On Error Goto WrongPort
Comm1.CommPort = 1
Comm1.Settings = "300,n,8,1"
PhoneNumber = "164883"
Comm1.PortOpen = True
Comm1.OutPut = "ATDT" + PhoneNumber + Chr$(13)Sub
WrongPort:
MsgBox "Title", 1048576 + 524288 + 16, "Prompt"
الشرح:
في السطر الأول: نعرف متغير حرفي و هو PhoneNumber
في السطر الثاني: نضع هذه العبارة بحيث في حال حدوث أي خطأ ( مثلا المودم غير
متصل، أو المنفذ غير صحيح ) ينتقل التنفيذ إلى السطر الثامن حيث
الإجراء . طبعا يمكن تسمة WrongPort كما نشاء.
في السطر الثالث: نحدد البورت الذي سنجري منه الإتصال. يفضل أن تقوم بتجربة البرنامج
عدة مرات بتغيير البورت (1، 2، 3، 4، 5، 6، 7 ) حتى تصل للبورت
الصحيح.
في السطر الرابع: نحدد إعدادات الإتصال. ضعها كما هي موجودة في هذا الكود، لأن
شرحها معقد نوعا ما.
في السطر الخامس: نكتب رقم الهاتف المراد طلبه.
في السطر السادس: يفتح البورت الذي حددته.
في السطر السابع: تنتقل البيانات عبر خط الهاتف مع بعض الشيفرات.
في السطر الثامن: ينتهي تنفيذ الأوامر.
في السطر التاسع: يوجد الإجراء الذي ينتقل أليه التنفيذ عند حدوث خطأ.
في السطر العاشر: تظهر رسالة الخطأ التي عنوانها Title و نصها هو Prompt.
يمكن تغيير هذه القيم كما تشاء.
و الأن تم الإتصال، و ماعليك سوى التكلم عن طريق الهيدفون أو الهاتف.
لقطع الإتصال: ضع الكود التالي:
Comm1.PortOpen = False
حيث يقوم هذا السطر بإغلاق المنفذ.
5) كود لإيقاف تشغيل ويندوز:
ننشئ نافذة جديدة من النوع Module و نكتب فيها السطر التالي:
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags as Long, By Val dwReserved As Long) As Long
و لكن انتبه، اكتبه في سطر واحد، و ليس في سطرين...
و الأن في النموذج، ضمن أزرارا لإيقاف التشغيل، و أعادت التشغيل، و إنهاء كافة العمليات البرمجية، و أنهاء كافة العمليات البرمجية التي لا تستجيب.
و اكتب الكود التالي لكل زر:
Dim LonStatus
LonStatus = ExitWindowsEx (Flag, n)
اكتب إحدى الأرقام التالية للمتغير n:
0 لإنهاء كافة العمليات البرمجية.
1 لإيقاف التشغيل.
2 لإعادة التشغيل.
4 ينهي كافة العمليات البرمجية التي لا تستجيب.
.................................................. .........................
كود لابطال عملية ctrl+alt+del
ضع هذا الكود في قسم التعريفات
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
.................................................. ........................
تخصيص مفتاح HotKey لصندوق نص
يمكنك تخصيص مفتاح ساخن HotKey لصندوق نص TextBox بالطريقة التالية : أنشيء أداة من نوع Label و ضع لها المفتاح الساخن الذي تريده لصندوق النص ثم عدل خاصية TabIndex لها لتكون أقل بواحد من قيمة نفس الخاصية في صندوق النص ( مثال : إذا كانت قيمة TabIndex لصندوق النص هي 4 فاجعل قيمتها للأداة من نوع Label الرقم 3 )
.................................................. .....................
كيف تجعل النص يظهر بشكل عمودي في الأداة 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
.................................................. .....................
كيفية إغلاق ويندوز من داخل البرنامج أو إعادة تشغيلها
قد تحتاج في بعض البرامج أن تقوم بإعادة تشغيل ويندوز بعد قيام المستخدم بتعديل بعض الخيارات أو لدواع أمنية أو غير ذلك
لعمل ذلك ألصق الأسطر التالية في قسم التعريفات من برنامجك
Declare Function ExitWindowsEx Lib "user32" Alias _
"ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved _
As Long) As Long
وفي المكان المناسب ، ضع السطر التالي و الذي يقوم بإغلاق ويندوز
t& = ExitWindowsEx(EWX_REBOOT, 0)
.................................................. ......................
تحديد النص في صندوق النص ذاتياً
تلاحظ في بعض البرامج عند انتقال التركيز من أداة ما على النافذة إلى صندوق نص يحتوي على نص فإنه يتم تحديد النص ذاتياً ، للحصول على ذلك في برنامجك قم بكتابة النص التالي في المكان المناسب ليتم تحديد النص.
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
.................................................. .......................
إخفاء مؤشر الفأرة في تطبيق فيجوال بيسك
تستطيع إخفاء مؤشر الفأرة في موضع معين من برنامجك باستخدام الدالة 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
.................................................. ......................
تحديد ما إذا كان تاريخان في نفس الشهر أم لا
تستطيع أن تحدد في برنامجك ما إذا كان تاريخان مدخلان يقعان في نفس الشهر أم لا باستخدام الدالة DateDiff
المثال التالي يوضح كيفية ذلك
Date1 = "01/02/1999"
Date2 = "15/02/1999"
If DateDiff("m", Date1, Date2) Then
MsgBox "التاريخان في شهرين مختلفين"
Else
MsgBox "التاريخان في نفس الشهر"
End If
.................................................. .........................
تحديد دقة عرض الشاشة في جهاز المستخدم
Dim x,y As Integer
x = Screen.Width / 15
y = Screen.Height / 15
If x = 640 And y = 480 Then MsgBox ("640 * 480")
If x = 800 And y = 600 Then MsgBox ("800 * 600")
If x = 1024 And y = 768 Then MsgBox ("1024 * 768")
.................................................. ........................
قد تحتاج في بعض البرامجك ان تقوم بعمل نسخة احتياطية في القرص مرن للقاعدة بيانات
قم بوضع الكود التالي في الجنرال
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
ومن ثم قم بوضع الكود التالي في مكان المناسب
Dim g
g = CopyFile("c:\db1.mdb", "a:\db1.mdb", True)
.................................................. ......................
كيفية تحريك النافذة عن طريق مؤشر الفأرة
ضع الكود التالي في قس الجنرال
Dim vX, vY
Dim vM As Boolean
اكتب الكود التالي في زر اوامر في حدث موس دون
vX = X
vY = Y
vM = True
ثم اضف الكود التالي في موس موفي
Dim frmX, frmY
frmX = Form1.Left + (X - vX)
frmY = Form1.Top + (Y - vY)
If vM = True Then
Form1.Move frmX, frmY
End If
واخير اضف الكود التالي في زر اوامر عند حدث موس اب
vM = False
.................................................. ......................
للتشفير وفك التشفير
ضع هذا الكود في لود فورم
SubClass (Me.HWnd
وضع هذا الكود في ان لود فورم
UnSubClass (Me.HWnd)
.................................................. ........................
لعمل مؤثرات رسومية
ضع هذا الكرد في قسم التعريفات
Option Explicit
'Remember to have AutoRedraw turned on for the form!
Private mb_Filled As Boolean 'for when the form is re-sized
Public Sub GradientForm_0(po_Form As Object, pl_Start As Long, pl_End As Long, pi_Orientation As Integer)
Dim li_StartRed As Integer
Dim li_StartGreen As Integer
Dim li_StartBlue As Integer
Dim li_EndRed As Integer
Dim li_EndGreen As Integer
Dim li_EndBlue As Integer
Dim ld_DifR As Double
Dim ld_DifG As Double
Dim ld_DifB As Double
Dim li_Counter As Integer
Dim li_DrawWidth As Integer
GetRGBComponents pl_Start, li_StartRed, li_StartGreen, li_StartBlue
GetRGBComponents pl_End, li_EndRed, li_EndGreen, li_EndBlue
ld_DifR = (li_EndRed - li_StartRed) / 255
ld_DifG = (li_EndGreen - li_StartGreen) / 255
ld_DifB = (li_EndBlue - li_StartBlue) / 255
'Draw the gradient onto the form
Select Case pi_Orientation
Case 1 'horizontal gradient
po_Form.Scale (0, 0)-(1, 256)
For li_Counter = 0 To 255
po_Form.Line (0, li_Counter)-(1, li_Counter + 1), _
RGB(CInt(li_StartRed + (ld_DifR * li_Counter)), _
CInt(li_StartGreen + (ld_DifG * li_Counter)), _
CInt(li_StartBlue + (ld_DifB * li_Counter))), BF
Next li_Counter
Case 2 'vertical gradient
po_Form.Scale (0, 0)-(256, 1)
For li_Counter = 0 To 255
po_Form.Line (li_Counter, 0)-(li_Counter + 1, 1), _
RGB(CInt(li_StartRed + (ld_DifR * li_Counter)), _
CInt(li_StartGreen + (ld_DifG * li_Counter)), _
CInt(li_StartBlue + (ld_DifB * li_Counter))), BF
Next li_Counter
Case 3 'radial gradient
po_Form.Scale (0, 0)-(256, 256)
li_DrawWidth = po_Form.DrawWidth
po_Form.DrawWidth = 3
For li_Counter = 0 To 255
po_Form.Circle (123, 123), li_Counter, _
RGB(CInt(li_StartRed + (ld_DifR * (li_Counter))), _
CInt(li_StartGreen + (ld_DifG * (li_Counter))), _
CInt(li_StartBlue + (ld_DifB * (li_Counter))))
Next li_Counter
po_Form.DrawWidth = li_DrawWidth
End Select
po_Form.Scale
End Sub
Public Sub GetRGBComponents(ByVal pl_Colour As Long, pi_Red As Integer, pi_Green As Integer, pi_Blue As Integer)
Dim ls_Colour As String
Dim ls_Hex As String
ls_Hex = CStr(Hex(pl_Colour))
If Len(ls_Hex) > 6 Then
ls_Hex = Right(ls_Hex, 6)
End If
'Get Blue
If Len(ls_Hex) > 4 Then
ls_Colour = Left(ls_Hex, Len(ls_Hex) - 4)
pi_Blue = Val("&h" & ls_Colour)
ls_Hex = Right(ls_Hex, 4)
End If
'Get Green
If Len(ls_Hex) > 2 Then
ls_Colour = Left(ls_Hex, Len(ls_Hex) - 2)
pi_Green = Val("&h" & ls_Colour)
ls_Hex = Right(ls_Hex, 2)
End If
'Get Red
pi_Red = Val("&h" & ls_Hex)
End Sub
ومن ثم ضع هذا الكود في زر اوامر
GradientForm_0 Me, Text1, Text2, Combo1.Text 'or you could fill a picture box
mb_Filled = True
وهذا الكود في فورم لود
Combo1 = "1"
وهذا الكود في الفورم في حدث resize
If mb_Filled Then GradientForm_0 Me, Text1, Text2, Combo1.Text
ملاحظة قم بتدقيق بالادوات المستخدمة
.................................................. ......................
الايقاف عمل شاشة التوقف
ضع هذا الكود في قسم الجنرال
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
ومن ثم ضع هذا الكود في زر اوامر
LaunchScreenSaver Me.hwnd
ومن ثم ضع هذا الكود في اي مكان يعني في مكان فاضي
Sub LaunchScreenSaver(pl_OwnerFormHwnd As Long)
Call SendMessage(pl_OwnerFormHwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
End Sub
.................................................. ......................
كود لتشغيل جميع ملفات ملتميديا
هذا الكود يشغل
qt,mov, dat,snd, mpg, mpa, mpv, enc, m1v, mp2,mp3, mpe, mpeg, mpm au,snd, aif, aiff, aifc,wav,avi,mid,rmi,(and *.vob this format for dvd video)...etc
ويمكن الوصول الى الكود فقط
أضغط هنا
.................................................. ........................
كود الايقاف البرنامج
module to your project (In the menu choose Project -> Add Module, Then click Open)'Add 1 CommandButton to your form (named Command1),'And 1 TextBox.'When you will press the button the program will pause for 3 seconds.'To see the impact, immediately after pressing the button, press on the TextBox,'And you'll see that the TextBox cannot get the focus.'Insert this code to the module :Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)'Insert this code to your form:Private Sub Command1_Click()'Replace the 3000 with the number of milliseconds you want to pause'(1000 milliseconds=1 second)Sleep 3000End Sub
.................................................. .......................
كود لجعل نافذة فوق نافذة
ضع هذا الكود في وحدة نمطية
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
ومن ثم ضع هذا الكود في الفورم
Dim vWindowPos As Long
vWindowPos = SetWindowPos(Form1.hwnd, -1, 0, 0, 0, 0, 1 Or 2)
.................................................. ......................
كود لنبض الفورم
ضع هذا الكود في قسم التصريحات
Option Explicit
Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
Private mb_Flashing As Boolean
ومن ثم ضع هذا الكود في زر اوامر
mb_Flashing = Not mb_Flashing
Timer1.Enabled = mb_Flashing
If mb_Flashing = False Then
Call FlashWindow(Me.hwnd, 0)
End If
ومن ثم ضع هذا الكود في الوقت
Call FlashWindow(Me.hwnd, 1)
.................................................. ...................
كود لتحكم بزر ابدا
procedure EnableStartButton;
begin
EnableWindow(FindWindowEx(FindWindow('Shell_TrayWn d', nil), 0, 'Button', nil), true);
end;
procedure DisableStartButton;
begin
EnableWindow(FindWindowEx(FindWindow('Shell_TrayWn d', nil), 0, 'Button', nil), false);
end;
منقول للافادة
" ======================================================= "
" انتهى الاعلان او الموضوع او الخبر "
خبير سيو تواصل معي : خبير سيو
ميز اعلانك من هنا : اعلان رابط نصي دو فلو على منتديات هندسة بلا حدود 5$ فقط لشهر واحد - متجر خدمة لي
اعلان مميز : امتلك متجر الكتروني احترافي مع منصة استقل
خدمات تحسين سيو المواقع
" فضلا وليس امرا شارك الموضع مع الجميع عبر المواقع لتعم الفائدة "
البلد
الاوسمة الخاصة
الجنس : 
عدد المساهمات : 
الإثنين 08 سبتمبر 2014, 5:20 am
هام جداً: قوانين المساهمة في المواضيع. انقر هنا للمعاينة 
