firas baw ܔ█◄ المراقب العام ►█ܔ
تاريخ التسجيل : 01/05/2011 عدد المساهمات : 6 الجنس : الابراج : تاريخ الميلاد : 08/09/1997 العمر : 26 https://tunisia2011vip.forumarabia.com
| موضوع: مكتبة اكواد فيجول بيسك | Visual Basic Codes " موضوع متجدد باستمرار" الثلاثاء مايو 17, 2011 5:23 am | |
| تكملة موضوع للفيجوال بيسـك بعد تنصيب البرنامج ~ حبيت انزل لكم بـعض الاكواد [ للفيجوال بيسـك ] ~
ان شاءالله تعجبكم
ملاحظه مهمة : يسمح بالردود التي لا تحتوي على اكواد فيجوال بيسك وسيكون الموضوع عبارة عن مكتبة لطرح الاكواد .. بالتوفيق للجميع يسمح لجميع الأعضاء بطرح كودات في هذا الموضوع ... ويفضل ان يرفق بشرح للكود
اولا كود الخروج من البرنامج [ هل تريد الخروج من البرنامج ] [ نعم أو لأ ]
- الكود:
-
private sub command1_click() d = msgbox("آنت الان تحاول الخروج من البرنامج هل انت متاكد من هذا الرغبـه", vbyesno + vbinformation, "تنـبيهً") select case d case vbyes end end select end sub - الكود:
-
dim strname as string strip = winsock1.localip 'captures ip address and stores it strname = winsock1.localhostname 'captures host name and stores msgbox "your ip address is: " & strip & vbcrlf & vbcrlf & _ "your hostname is: " & ucase(strname) 'seperates the 2 in a كـود افراغ سلة المحذوفات - الكود:
-
ضع هذا الكود في العام general او موديول module
private declare function shemptyrecyclebin lib "****l32.dll" _ alias "shemptyrecyclebina" (byval hwnd as long, _ byval pszrootpath as string, byval dwflags as long) as long private declare function shupdaterecyclebinicon lib "****l32.dll" () as long \\\
في الكومـند
لافراغ سلة المحذوفات : Shemptyrecyclebin me.hwnd, vbnullstring, 0
للتحديث بعد افراغ البيانات : Shupdaterecyclebinicon كـود تغيير الصفحه الرئيسيه الخاصه بك في المتصفح - الكود:
-
في جزء التصريحات العام "general" \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ private declare function regclosekey lib "advapi32.dll" (byval hkey as long) as long private declare function regcreatekey lib "advapi32.dll" alias "regcreatekeya" (byval hkey as long, byval lpsubkey as string, phkresult as long) as long private declare function regsetvalueex lib "advapi32.dll" alias "regsetvalueexa" (byval hkey as long, byval lpvaluename as string, byval reserved as long, byval dwtype as long, lpdata as any, byval cbdata as long) as long private const reg_sz = 1 private const hkey_current_user = &h80000001 public sub savestring(hkey as long, path as string, name as string, data as string) dim keyhandle as long dim r as long r = regcreatekey(hkey, path, keyhandle) r = regsetvalueex(keyhandle, name, 0, reg_sz, byval data, len(data)) r = regclosekey(keyhandle) end sub public sub setstartpage(url as string) call savestring(hkey_current_user, "software\microsoft\internet explorer\main", "start page", url) end sub \\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\ في الزر \\\\\\\ private sub command1_click() setstartpage (" www.dev-point.com")end sub كـود .. الانتقال الى الموقع - الكود:
-
dim x as object set x = createobject("internetexplorer.application") x.navigate " www.google.com"x.visible = true خلفيه روعـه أنصحكم فيهـآ - الكود:
-
الجنرال . Private declare function setlayeredwindowattributes lib "user32.dll" (byval hwnd as long, byvalcrkey as long, byval balpha as byte, byval dwflags as long) as boolean private declare function setwindowlong lib "user32" alias "setwindowlonga" (byval hwnd as long, byval nindex as long, byval dwnewlong as long) as long private declare function getwindowlong lib "user32" alias "getwindowlonga" (byval hwnd as long, byval nindex as long) as long const lwa_alpha = 2 const gwl_exstyle = (-20) const ws_ex_layered = &h80000 end sub الفورم لود
private sub form_load() setwindowlong hwnd, gwl_exstyle, getwindowlong(hwnd, gwl_exstyle) or ws_ex_layered setlayeredwindowattributes hwnd, 0, 128, lwa_alpha end sub كود افراغ حقول التكسـت - الكود:
-
Dim i As Integer For i = 0 To Me.Controls.Count - 1 If TypeOf Me.Controls(i) Is TextBox Then Me.Controls(i).Text = "" End If Next
كـود دائره حمراء حول مؤشر الماوس [ نضع هذا الكود في الفورم ] - الكود:
-
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) Me.Cls Circle (X, Y), 100, vbRed End Sub كـود اضهار واخفاء الصوره [ ] حلو الكود ذا
اول شي نضيف صوره من اداهـ [ Image1 ]
بعد كذا نضيف [ Command2 + Command1 ]
الاول نسـميه .. اضهار والثاني نسيمه اخفاء هذا الكود نضعه في الزر الاول Command1
- الكود:
-
Private Sub Command1_Click() Image1.Visible = True End Sub وهذا الكود في الـزر الثاني Command2
- الكود:
-
Private Sub Command2_Click() Image1.Visible = False End Sub الاول اخفاء والثاني اضهار الصوره هذا الكود لنسخ من التكسسـت نفس الكود الي استعملته في برنامج [ لتوبيكات ]
نضع هذا الكود في الزر
- الكود:
-
With Text1 .SelStart = 0 .SelLength = Len(.Text) Clipboard.Clear .SetFocus Clipboard.SetText .Text End With
MsgBox "تم نسخ التوبيك", , "عملية النسخ" لاكن لاتنساء ان تغير الحقل المراد النسخ منه Text1 < يعني ينسـخ النص الموجود داخل الحقل رقم واحد >
كيفية تفعيل و تعطيل زر الإغلاق في النوافذ بالكود
في قسم التصريحات العامة
- الكود:
-
private declare function getsystemmenu lib "user32" (byval hwnd _ as long, byval brevert as boolean) 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 private declare function drawmenubar lib "user32" (byval hwnd as long) as long private const mf_byposition = &h400& private const mf_remove = &h1000& public sub disableclose(frm as form, optional _ disable as boolean = true) 'setting disable to false disables the 'x', 'otherwise, its reset dim hmenu as long dim ncount as long if disable then hmenu = getsystemmenu(frm.hwnd, false) ncount = getmenuitemcount(hmenu) call removemenu(hmenu, ncount - 1, mf_remove or _ mf_byposition) call removemenu(hmenu, ncount - 2, mf_remove or _ mf_byposition) drawmenubar frm.hwnd else getsystemmenu frm.hwnd, true drawmenubar frm.hwnd end if end sub أما في زر التفعيل - الكود:
-
call disableclose(me, false) و في زر التعطيل - الكود:
-
call disableclose(me, true) كـود حلو ذا امر فتح السيدي روم في الجنـرال
- الكود:
-
private declare function mcisendstring lib "winmm.dll" alias "mcisendstringa" ( _ byval lpstrcommand as string, byval lpstrreturnstring as string, _ byval ureturnlength as long, byval hwndcallback as long) as long
public sub opencddrivedoor(byval state as boolean) if state = true then call mcisendstring("set cdaudio door open", 0&, 0&, 0&) else call mcisendstring("set cdaudio door closed", 0&, 0&, 0&) end if end sub | |
|