بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - محمد ايمن - 05-05-20
السلام عليكم ورحمت الله وبركتوه
المره السابقاه نشرات بعض الاواد المفيده و الندره في البرمجه وده الجزاء الثاني
) أكواد الحافظة....
الحافظة في الفيجوال بيسك تأخذ الأسم 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
PHP كود :
ده الجزاء الثاني من الاكود
كيفية تحريك النافذة عن طريق مؤشر الفأرة ضع الكود التالي في قس الجنرال 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);
وده الثالث
PHP كود :
جميع اكواد في قاعدة بيانات وتحديثها
اقدم لكم طريقة الإضافة والحذف وتحديث في VB باستخدام كل من الأداتين data control/ Adodc والطريقة كما يلي: - قم بتشغيل فيجوال بيسك واختيار Standar EXE . 2 - أضف أحدا الأداتين data control أو Adodc وقم بربطها بقاعدة بيانات موجودة . 3- أضف أربع أدوات من نوع CommandButton وقم بتنسيقها كما يلي : A : Name cmdAction , Caption &AddNwe index 0 B : Name cmdAction , Caption &Cancel index 1 C : Name cmdAction , Caption &Delete index 2 D : Name cmdAction , Caption &Refresh index 3 لاحظ إن جميع الأزرار تأخذ اسماً واحداً وذلك لتسهيل عملية كتابة النص(Code) ويعطى كلاً منها رقم Index يبدأ من صفر . بعد الانتهاء من إضافة أزرار الأمر قم بكتابة النص التالي في قسم التعريفات العامة : Option Explicit Private Enum FormMode fmAdd = True fmEdit = False End Enum وبعد ذلك قم بكتابة الكود التالي : Public Sub ADOAdd() On Error GoTo LocalErr ' With Data1.Recordset If cmdAction(0).Caption = "&AddNew" Then .AddNew
cmdAction(0).Caption = "&Save" setFormModeTo fmAdd Else .Update cmdAction(0).Caption = "&AddNew" setFormModeTo fmEdit End If End With Exit Sub LocalErr: MsgBox Err.Des***ption, vb***tical, "Error: " & CStr(Err.Number) End Sub وبعد ذلك قم بكتابة الكود التالي : Public Sub ADOCancel() If MsgBox("Undo changes?", vbYesNo + vbQuestion, "Cancel Edits") = vbYes Then Data1.Refresh cmdAction(0).Caption = "&AddNew" setFormModeTo fmEdit End If ' End Sub وبعد ذلك قم بكتابة الكود التالي : Public Sub ADOCancel() ' If MsgBox("Undo changes?", vbYesNo + vbQuestion, "Cancel Edits") = vbYes Then Data1.Refresh cmdAction(0).Caption = "&AddNew" setFormModeTo fmEdit End If ' End Sub
وبعد ذلك قم بكتابة الكود التالي : Public Sub ADORefresh() ' Data1.Refresh setFormModeTo fmEdit ' End Sub
وبعد ذلك قم بالنقر على اى زر من أزرار الامر نقراً مزدوجاً وأكتب الكود التالي Private Sub cmdAction_Click(Index As Integer) ' With Data1 Select Case Index Case 0: ADOAdd Case 1: ADOCancel Case 2: ADODelete Case 3: ADORefresh End Select End With ' End Sub انتهينا .........................................................................
طريقة التعامل مع ملفات التهيئة
لتعامل مع ملفات التهيئة هناك مجموعة من الدوال ولفهم طريقة إستخدامها سنشرح وظيفة وتركيب ملفات التهيئة . ومن ملفات التهيئة المشهورة الملفان win.ini و system.ini الخاصان بويندوز ، وعادة ما يكون لكل برنامج ملف تهيئة خاصة به وامتداد ملفات التهيئة هو ini , ويتم بملفات التهيئة حفظ أعداداتك الخاصة بك التي قمت بها عند تشغيل برنامج معين فـقـد تلاحـظ عـنـد دخولك لبرنامج ما انة قد وضع آخر اربعة ملفات قمت بتشغيلها في قائمة ملف ( مثل الورد مثلا ) وكذلك يحفظ كل ما قمت بة من تغيرات لتجدها لم تتغير عند تشغيلة في المرة القادمة فما يقوم بة البرنامج هو حفظ الأعدادات التي قمت بها في ملف تهيئة خاص ، لتتم قرائة في المرة القادمة لتشغيلك البرنامج ووضع اعداداتك التي قمت بها .
الشكل العام لملفات التهيئة :
[Desktop] Wallpaper = (بلا) TileWallpaper = 1 . . [windows] run= C:\Scan.exe load= BaseCodePage = 1256
لاحظ أن ملف التهيئة يتكون من عدد من الآقسام وأسفل كل قسم عدد من المفاتيح وأمام كل مفتاح قيمتة ، مثلا القسم Desktop يحتوي على مفتاحين ، المفتاح TilrWallpaper قيمتة 1 ، وهذا حال كل ملفات التهيئة .
الإجراء WritePrivateProfileString و يعلن عنة كالتالي :
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
وظيفتة :
يستخدم للكتابة لملف التهيئة .
المتغيرات :
lpApplicationName وهو من النوع String وهو يمثل اسم القسم المراد الكتابة بة . lpKeyName وهو من النوع Any وهو يمثل اسم المفتاح . lpString وهو من النوع Any وهو يمثل القيمة التي تريد كتابتها. lpFileName وهو من النوع String وهم يمثل اسم ومسار ملف التهيئة .
القيمة المعادة :
الإجراء يعود بقيمة من النوع Long لاتساوي الصفر في حالة نجاحة ، أما إن فشل الإجراء في اداء المطلوب فسيعود بقيمة تساوي الصفر .
ملاحظات :
عندما تستخدم هذا الإجراء للكتابة إلى ملف تهيئة ، فهناك عدة أحتمالات كأن يكون الملف الذي حددتة غير موجود. في هذة الحالة سيقوم الإجراء بعمل ملف جديد يضع فية ما حددتة لة من قسم ومفتاح وقيمة . وأما إن كان الملف موجود ، فإنة يفتحة ويبحث عن القسم الذي حددتة ، فإذا لم يجدة فأنة ينشئة ويضع تحتة المفتاح والقيمة التي حددتهما لة . أما إذا وجد القسم فإنة يبحث عن المفتاح الذي حددتة ، فإذا لم يجدة فإنة ينشئة ويضع أمامة القيمة المحددة . أما إذا وجد المفتاح ، فإنة يستبدل القيمة الموجودة أمامة بالقيمة التي حددتها له .
الإجراء GetPrivateProfileString و يعلن عنه كالتالي :
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
وظيفتة :
يستخدم للقراءة من ملف التهيئة
المتغيرات :
lpApplicationName وهو من النوع String وهو يمثل اسم القسم المراد الكتابة بة . lpKeyName وهو من النوع Any وهو يمثل اسم المفتاح . lpDefault وهو من النوع String وهو يمثل القيمة الافتراضية التي يعود بها الإجراء إن لم يجد المفتاح المحدد . lpReturnedString وهم من النوع String وهو عبارة عن متغير حرفي يتم تخزين قيمة المفتاح المحدد بها أن وجدة الإجراء . nSize وهو من النوع Long وهو يمثل حجم المتغير الحرفي . lpFileName وهو من النوع String وهم يمثل اسم ومسار ملف التهيئة .
القيمة المعادة :
الإجراء يعود بقيمة من النوع Long لاتساوي الصفر في حالة نجاحة تمثل عدد حروف المتغير الذي قراءة ، أما إن فشل الإجراء في اداء المطلوب فسيعود بقيمة تساوي الصفر .
ملاحظة
هذاين الإجراء ين هما الأكثر استخداما مع ملفات التهيئة ، حيث ان الإجراءين WriteProfileString و GetProfileString فهما حاله خاصة من الإجراءين السابقين . فهما يؤديان نفس مهام الإجراءين السابقين ويتطلبان نفس المتغيرات ، ما عدا المتغير الأخير ( اسم ومسار ملف التهيئة ) حين أن هذين الإجراءين سيفترض أنة win.ini ، لذلك فهذا الإجراء يستخدم لتعامل مع الملف wini.ini فقط . .......................................................................... بعض مميزات مخفية في بيئة دلفي تشرح هذه الفقرة الصغيرة كيفية إنشاء مدخلات في قاعدة بيانات التسجيل Registry لنظام Windows لتغيير سلوك لوحة العناصر في دلفي 5 بالطريقة التي تناسبك.
تذكّر أنه توجد العديد من الميزات المخفية في منتجات لغات البرمجة عادةً، ويكون المبرمج فرحاً باكتشافها، أما أسباب إخفائها فقد يكون لأنها وضعت في المنتج بعد طباعة دليل الاستخدام، أو أُغفل عنها، أو لعدم تأكد الشركة من جودتها بفحصها بشكل صحيح، أو من وجودها في النسخ اللاحقة للمنتج، ولهذا يتحمل المستخدم المسئولية كاملةً في استخدامها وما ينتج عنها، وليس على الشركة أو علينا أيّ مسئولية.
تنبيه: قبل تعديل قاعدة بيانات التسجيل بأي شكل من الأشكال قم بعمل نسخة احتياطية منها.. إنتقل إلى فهرس النظام (غالباً C:\Windows) وانسخ منه الملفين user.dat وsystem.dat إلى مكان آمن.
ملف قاعدة بيانات التسجيل Registry هو المفتاح:
1- استخدم برنامج RegEdit لإجراء التعديلات على قاعدة بيانات التسجيل بعد - وفقط بعد - أخذ نسخة احتياطية من ملفاته. اطبع الكلمة RegEdit في شاشة حوار التشغيل Run من قائمة ابدأ Start، ثم اضغط Enter.
2- انتقل إلى المفتاح HKEY_CURRENT_USER\Software\Borland\Delphi\5.0. - أضف مفتاح فرعي جديد باسم Extras.
4- أضف إلى مفتاح Extras متغير حرفي جديد New String/Value باسم AutoPaletteSelect واجعل قيمته 1 لتمكين "الاختيار التلقائي في صفحة العناصر باستخدام الفأرة"، وغيّرها إلى صفر إذا رغبت في تعطيل هذه الميزة.
وده الربع
PHP كود :
التحقق من التاريخ بالسنوات Public Function ValidDate(MDate) 'Purpose: Check for 4 digit yyyy DATE 'Input: String from text box 'Output: True or False
'Default is false ValidDate = False
'Exit if length less than "m/d/yyyy" If Len(MDate) < 8 Then Exit Function
'Exit if not a valid date wrong If IsDate(MDate) = False Then Exit Function
'Exit if not ending or starting with "yyyy" Dim StartDate As String Dim EndDate As String
EndDate = Right(MDate, 4) StartDate = Left(MDate, 4)
If ValidChar(EndDate, "0123456789") = False And _ ValidChar(StartDate, "0123456789") = False Then Exit Function
'Set to true if it passes all these tests! ValidDate = True
End Function
معرفة ماهو الشهر الحالي Private Sub Command1_Click() Mmonth = Mid(Date, 4, 2) Label1 = MonthName(Mmonth) End Sub
إخفاء وإظهار زر ابدأ Const SW_SHOWNORMAL = 1 Private Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long 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 Const SW_HIDE = 0
Public Function hideStartButton() 'This Function Hides the Start Button' OurParent& = FindWindow("Shell_TrayWnd", "") OurHandle& = FindWindowEx(OurParent&, 0, "Button", _ vbNullString) ShowWindow OurHandle&, SW_HIDE End Function
Public Function showStartButton() 'This Function Shows the Start Button' OurParent& = FindWindow("Shell_TrayWnd", "") OurHandle& = FindWindowEx(OurParent&, 0, "Button", _ vbNullString)
ShowWindow OurHandle&, SW_SHOWNORMAL End Function
Private Sub Command1_Click() hideStartButton End Sub
Private Sub Command2_Click() showStartButton End Sub
لإضافة عروض الفلاش إلى برنامجك
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
تشفير فك تشفير ملف Private Sub FileEncodeAndDecode(InputFile As String, OutputFile As String, PasswordKey As String) Dim temp As Single Dim Char As String * 1 Dim XORMask As Single Dim temp1 As Integer Open InputFile For Binary As #1 Open OutputFile For Binary As #2 For x = 1 To Len(PasswordKey) temp = Asc(Mid$(PasswordKey, x, 1)) For Y = 1 To temp temp1 = Rnd Next Y ' Re-seed to throw off prying eyes Randomize temp1 Next x Counter = 0 For z = 1 To FileLen(InputFile) 'Generate random mask XORMask = Int(Rnd * 256) 'Get the char & change it Get 1, , Char Char = Chr$((Asc(Char) Xor XORMask)) Put 2, , Char Counter = Counter + 1 If Counter > Len(PasswordKey) Then Counter = 1 ' Pull random numbers from the hat For x = 1 To (Asc(Mid$(PasswordKey, Counter, 1)) * 2) temp = Rnd Next x Next z
Close #1 Close #2 End Sub
Private Sub Command1_Click()
Dim InputFile As String Dim OutputFile As String Dim PasswordKey As String InputFile = InputBox("Enter thr filename to encode/decode") OutputFile = InputBox("Enter the new filename this file will become ") PasswordKey = InputBox("Enter the password") Call FileEncodeAndDecode(InputFile, OutputFile, PasswordKey) MsgBox "File written to " + OutputFile End End Sub
إرسال ملف إلى سلة المحذوفات Private Type SHFILEOPSTRUCT hwnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAnyOperationsAborted As Long hNameMappings As Long lpszProgressTitle As Long End Type
Private Declare Function SHFileOperation Lib _ "shell32.dll" Alias "SHFileOperationA" (lpFileOp _ As SHFILEOPSTRUCT) As Long
Private Const FO_DELETE = &H3 Private Const FOF_ALLOWUNDO = &H40
Private Sub Command1_Click() Dim SHop As SHFILEOPSTRUCT Dim strFile As String
strFile = "C:\autoexec.bat"
With SHop .wFunc = FO_DELETE .pFrom = strFile .fFlags = FOF_ALLOWUNDO End With
SHFileOperation SHop
End Sub
إغلاق جميع النماذج المحملة حاليا
'Add 1 CommandButton To Your Form. 'Insert the following code to your form:
Private Sub Command1_Click() Dim Form As Form For Each Form In Forms Unload Form Set Form = Nothing Next Form End Sub طباعة نص 'Add 1 Command Button to your form.
'Form Code Private Sub Command1_Click() ' the following example will print hello on the form Printer.Print "hello" ' use the EndDoc command if this text is the last thing you want ' to print on the paper Printer.EndDoc End Sub
تحديد رقم إصدار الويندوز 'Module Code Public Type OSVERSIONINFOEX dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type
Public Const VER_PLATFORM_WIN32s = 0 Public Const VER_PLATFORM_WIN32_WINDOWS = 1 Public Const VER_PLATFORM_WIN32_NT = 2
Declare Function GetVersionEx Lib "kernel32" _ Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFOEX) As Long
'Form Code Public Function OSVersion() As String Dim udtOSVersion As OSVERSIONINFOEX Dim lMajorVersion As Long Dim lMinorVersion As Long Dim lPlatformID As Long Dim sAns As String udtOSVersion.dwOSVersionInfoSize = Len(udtOSVersion) GetVersionEx udtOSVersion lMajorVersion = udtOSVersion.dwMajorVersion lMinorVersion = udtOSVersion.dwMinorVersion lPlatformID = udtOSVersion.dwPlatformId Select Case lMajorVersion Case 5 sAns = "Windows 2000" Case 4 If lPlatformID = VER_PLATFORM_WIN32_NT Then sAns = "Windows NT 4.0" Else sAns = IIf(lMinorVersion = 0, _ "Windows 95", "Windows 98") End If Case 3 If lPlatformID = VER_PLATFORM_WIN32_NT Then sAns = "Windows NT 3.x" Else sAns = "Windows 3.x" End If Case Else sAns = "Unknown Windows Version" End Select OSVersion = sAns End Function
Private Sub Form_Load() MsgBox "Windows version detected: " & OSVersion End Sub
فتح لوحة التحكم Private Sub Command1_Click() Shell "rundll32.exe shell32.dll,Control_RunDLL", vbNormalFocus End Sub
فتح قائمة ابدأ
'Add a module to your project (In the menu choose Project -> Add Module, Then click Open) 'Add 1 CommandButton (named Command1) to your form.
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" _ (ByVal wCode As Long, ByVal wMapType As Long) As Long Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan _ As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Const KEYEVENTF_KEYUP = &H2
Private Sub Command1_Click() Const MENU_KEYCODE = 91 keybd_event MENU_KEYCODE, 0, 0, 0 keybd_event MENU_KEYCODE, 0, KEYEVENTF_KEYUP, 0 End Sub
لتشغيل شاشة التوقف Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Private Const WM_SYSCOMMAND = &H112& Private Const SC_SCREENSAVE = &HF140&
Private Sub Command1_Click()
Dim Res As Long Res = SendMessage(Me.hWnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
End Sub
معرفة بعض معلومات النظام '=================================================== 'Sub: OSInfo 'Description: Gets information about the users Operating System (version of Windows, etc.) 'Where to place code: Module 'Notes: In your code, first call OSInfo. After this, you may use the ' following public variables in your code: ' OSMajorVersion = Long, The Major Version of the operating system ' OSMinorVersion = Long, The Minor Version of the operating system ' OSBuildNumber = Long, The build number of the operating system ' (Note: on Windows 95, build 1000 represents OEM service release #2) ' OS = String, will contain "Windows 3.1", "Windows95 or Windows98", or "WindowsNT" ' OSAddInfo = String, Contains additional info about the operating system ' 'http://www.littleguru.com '==================================================
Public Declare Function GetVersionEx& Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO)
Public Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type
Public OSMajorVersion As Long Public OSMinorVersion As Long Public OSBuildNumber As Long Public OS As String Public OSAddInfo As String
Public Const VER_PLATFORM_WIN32s = 0 Public Const VER_PLATFORM_WIN32_WINDOWS = 1 Public Const VER_PLATFORM_WIN32_NT = 2
Public Sub OSInfo() Dim typOSInfo As OSVERSIONINFO typOSInfo.dwOSVersionInfoSize = 148 If GetVersionEx(typOSInfo) = 0 Then ' Insert Error handling code here End If OSMajorVersion = typOSInfo.dwMajorVersion OSMinorVersion = typOSInfo.dwMinorVersion OSBuildNumber = typOSInfo.dwBuildNumber OSAddInfo = typOSInfo.szCSDVersion Select Case typOSInfo.dwPlatformId Case VER_PLATFORM_WIN32s OS = "Windows 3.1" Case VER_PLATFORM_WIN32_WINDOWS OS = "Windows95 or Windows98" Case VER_PLATFORM_WIN32_NT OS = "WindowsNT" End Select End Sub
تسجيل البرنامج عند بدء التشغيل 'Martin Anbu Selvan 'St.joseph's college of Engineering,chennai. 'tissot_swiss@yahoo.com
'Function for RegWrite Private Function RegWrite(Key1, SValue As String) Set WSHShell = CreateObject("WScript.Shell") WSHShell.RegWrite Key1, SValue End Function
'Button to create an Autorun Key Private Sub Command1_Click() RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\notepad.exe", " path of the notepad" End Sub لتحميل صورة من الانترنت Private Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long Public Sub DownloadFile(ByVal URL As String) DoFileDownload StrConv(URL, vbUnicode) End Sub Private Sub Command1_Click() DownloadFile "http://www.alhosamnet.com/images/logo.gif" End Sub
إضافة موقع إلى المفضلة
' ضع الشفرة التالية فيModule
Private Declare Function SHGetSpecialFolderLocation _ Lib "shell32.dll" (ByVal hwndOwner As Long, _ ByVal nFolder As SpecialShellFolderIDs, _ pidl As Long) As Long
Private Declare Function SHGetPathFromIDList _ Lib "shell32.dll" Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, _ ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" _ (ByVal pv As Long)
Public Enum SpecialShellFolderIDs CSIDL_DESKTOP = &H0 CSIDL_INTERNET = &H1 CSIDL_PROGRAMS = &H2 CSIDL_CONTROLS = &H3 CSIDL_PRINTERS = &H4 CSIDL_PERSONAL = &H5 CSIDL_FAVORITES = &H6 CSIDL_STARTUP = &H7 CSIDL_RECENT = &H8 CSIDL_SENDTO = &H9 CSIDL_BITBUCKET = &HA CSIDL_STARTMENU = &HB CSIDL_DESKTOPDIRECTORY = &H10 CSIDL_DRIVES = &H11 CSIDL_NETWORK = &H12 CSIDL_NETHOOD = &H13 CSIDL_FONTS = &H14 CSIDL_TEMPLATES = &H15 CSIDL_COMMON_STARTMENU = &H16 CSIDL_COMMON_PROGRAMS = &H17 CSIDL_COMMON_STARTUP = &H18 CSIDL_COMMON_DESKTOPDIRECTORY = &H19 CSIDL_APPDATA = &H1A CSIDL_PRINTHOOD = &H1B CSIDL_ALTSTARTUP = &H1D CSIDL_COMMON_ALTSTARTUP = &H1E CSIDL_COMMON_FAVORITES = &H1F CSIDL_INTERNET_CACHE = &H20 CSIDL_COOKIES = &H21 CSIDL_HISTORY = &H22 End Enum
Public Sub AddFavorite(SiteName As String, URL As String) Dim pidl As Long Dim intFile As Integer Dim strFullPath As String
On Error GoTo Goodbye
intFile = FreeFile strFullPath = Space(255)
If SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, pidl) = 0 Then If pidl Then If SHGetPathFromIDList(pidl, strFullPath) Then If InStr(1, strFullPath, Chr(0)) Then strFullPath = Mid(strFullPath, 1, _ InStr(1, strFullPath, Chr(0)) - 1) End If
If Right(strFullPath, 1) <> "\" Then strFullPath = strFullPath & "\" End If
strFullPath = strFullPath & SiteName & ".URL" Open strFullPath For Output As #intFile Print #intFile, "[InternetShortcut]" Print #intFile, "URL=" & URL Close #intFile
End If CoTaskMemFree pidl End If End If
Goodbye:
End Sub
نسخ ملف '=================================================== 'Sub: CopyAFile 'Description: Copies a file 'Where to place code: Module 'Notes: strOrigFile is the file that you want to copy ' strNewFile is the file that you want to copy strOrigFile to ' If lngOverwrite is set to a nonzero value (1), the function will fail if the destination file already exists ' If lngOverwrite is set to 0, the destination file will be overwritten if it exists ' 'http://www.littleguru.com '==================================================
Public Declare Function CopyFile& Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long)
Public Sub CopyAFile(strOrigFile As String, strNewFile As String, lngOverwrite As Long) CopyAFile = CopyFile(OrigFile, NewFile, Overwrite) If CopyAFile = 0 Then ' Insert Error Handling routine here Exit Sub End If
كلمت شكر تكفي
RE: بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - منه - 04-07-20
ممكن كود التحقق من أن الحافظه فارغه ام لا
RE: بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - محمد ايمن - 04-07-20
(04-07-20, 09:52 AM)منه كتب : ممكن كود التحقق من أن الحافظه فارغه ام لا
اسف بس ولله مش عندي
RE: بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - alsouf - 06-07-20
بارك الله فيك .... و جزاك خيرا على المجهود
شفرة الحافظة غير صحيحة اي اول كود في الاعلى
------------------------------------------------
سوف اضيف لشفرات الحافظة المجربة التالية
-----------------------------------------------
كود :
Public Class Form1
Public Shared Sub Clear()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
' Cut Text
Clipboard.Clear()
Clipboard.SetText(MyText.Text)
MyText.Text = ""
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
If Clipboard.ContainsText = Nothing Then
MessageBox.Show("Clipboard est Vide ! ")
Else
MessageBox.Show("Clipboard Ne Sans Pas Vide ! ")
End If
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Clipboard.Clear()
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Clipboard.Clear()
Clipboard.SetText(MyText.Text)
End Sub
End Class
شرح الشفرات على التوالي:
اولا اضافة اجراء
ثانيا قص و نقل للحافظة
ثالثا التاكد من محتوى الحافظة
رابعا مسح الحافظة
و اخير الزر 3 لنسخ الى الحافظة
اليك الاجابة اخي محمد ايمن
RE: بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - محمد ايمن - 06-07-20
(06-07-20, 04:45 PM)alsouf كتب : بارك الله فيك .... و جزاك خيرا على المجهود
شفرة الحافظة غير صحيحة اي اول كود في الاعلى
------------------------------------------------
سوف اضيف لشفرات الحافظة المجربة التالية
-----------------------------------------------
كود :
Public Class Form1
Public Shared Sub Clear()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
' Cut Text
Clipboard.Clear()
Clipboard.SetText(MyText.Text)
MyText.Text = ""
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
If Clipboard.ContainsText = Nothing Then
MessageBox.Show("Clipboard est Vide ! ")
Else
MessageBox.Show("Clipboard Ne Sans Pas Vide ! ")
End If
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Clipboard.Clear()
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Clipboard.Clear()
Clipboard.SetText(MyText.Text)
End Sub
End Class
شرح الشفرات على التوالي:
اولا اضافة اجراء
ثانيا قص و نقل للحافظة
ثالثا التاكد من محتوى الحافظة
رابعا مسح الحافظة
و اخير الزر 3 لنسخ الى الحافظة
اليك الاجابة اخي محمد ايمن
شكران اخي انت من الاعضاء القليلين المميزين في المجموعه
RE: بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - خالد العصاوي - 15-11-22
مشكور جدا جدا جدا
RE: بعض اكود التي ستفيدك فا البرمج الجزاء الثاني - أبووسم - 04-12-22
مع ان الموضوع قديم ، ولكن يحمل في طياته الكثير من الفوائد والدروس
ولكن كلمة شكراً لا تكفي ، فلك الف شكر وتقدير
و جزاك الله خير
|