egy-cgi
15-07-2002, 02:32 AM
بسم الله الرحمن الرحيم
اقدم الى اخوتى بعض اكواد الفيجوال بيسك الهامه التى من الممكن ان يحتاجوها فى برامجهم
رجو ان تحوز اعجابكم ورضاكم
رجاء لا تترددوا فى طلب اى كود لبرنامج انشاء الله سالبى طلباتكم
اخوكم مازن
egysec2000@hotmail.com
اولا شفرة اغلاق الويندوز
هذه الشفره توضع فى منطقة التصريح
Private Const EWX_SHUTDOWN As Long = 1
Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
هذه الشفره توضع فى منطقة الكود
'أغلق الوندوز
lngResult = ExitWindowsEx(EWX_SHUTDOWN, 0&)
----------------------------------------------------------------------
شفرة اعادة تشغيل الوندوز
هذه الشفره توضع فى منطقة التصريح
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_LOGOFF = 0
Const EWX_FORCE = 4
Private Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long, _
ByVal dwReserved As Long) _
As Long
هذه الشفره توضع فى منطقة الكود
'cmdRestart اصنع زر تحكم باسم
Private Sub cmdRestart_Click()
'Restart Windows (works on Windows 95/NT)
ExitWindowsEx EWX_LOGOFF, 0
----------------------------------------------------------------------
شفرة تشغيل اضف جهاز جديد
add new hardware
هذه الشفره توضع فى منطقة الكود مباشره لا يوجد تصريح
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @1", 5)
----------------------------------------------------------------------
شفرة تشغيل برنامج اضف \ازل برنامج
add remove prog
هذه الشفره توضع فى منطقة الكود مباشرة لا يوجد تصريح
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1", 5)
----------------------------------------------------------------------
اخى هل اصابك الملل من الشكل التقليدى لنموذج الفيجول بيزك التقليدى (المستطيل)
اضف مودل جديد لمشروعك واضف اليه الكود التالى
Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
ثم اضف هذا الكود بالنموذج البرنامج ذاته
فى منطقة التحميلload
SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 300, 200), True
لاحظ انك
كلما غير الأرقام التي بين القوسين يتغير شكل النموذج
----------------------------------------------------------------------
هل واجهت مشكلة انك لا تستطيع تحريك البرنامج الذى بدون شريط عنوان
اذن الحل مع هذا الكود
اضف هذا الكود لمنطقة التصريح
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 Declare Sub ReleaseCapture Lib "User32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
اضف هذا الكود لمنطقة الكود
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long
If Button = 1 Then
Call ReleaseCapture
lngReturnValue = SendMessage(Form1.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
----------------------------------------------------------------------
مع تحياتى لأخوتى
اذا وجدت اقبال و رد على ما اكتبه ساستمر فى عرض الاكواد
لا تنسى اذا اردت اى كود راسلنى او اترك رساله بالمنتدى
egysec2000@hotmail.com
اقدم الى اخوتى بعض اكواد الفيجوال بيسك الهامه التى من الممكن ان يحتاجوها فى برامجهم
رجو ان تحوز اعجابكم ورضاكم
رجاء لا تترددوا فى طلب اى كود لبرنامج انشاء الله سالبى طلباتكم
اخوكم مازن
egysec2000@hotmail.com
اولا شفرة اغلاق الويندوز
هذه الشفره توضع فى منطقة التصريح
Private Const EWX_SHUTDOWN As Long = 1
Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
هذه الشفره توضع فى منطقة الكود
'أغلق الوندوز
lngResult = ExitWindowsEx(EWX_SHUTDOWN, 0&)
----------------------------------------------------------------------
شفرة اعادة تشغيل الوندوز
هذه الشفره توضع فى منطقة التصريح
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_LOGOFF = 0
Const EWX_FORCE = 4
Private Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long, _
ByVal dwReserved As Long) _
As Long
هذه الشفره توضع فى منطقة الكود
'cmdRestart اصنع زر تحكم باسم
Private Sub cmdRestart_Click()
'Restart Windows (works on Windows 95/NT)
ExitWindowsEx EWX_LOGOFF, 0
----------------------------------------------------------------------
شفرة تشغيل اضف جهاز جديد
add new hardware
هذه الشفره توضع فى منطقة الكود مباشره لا يوجد تصريح
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @1", 5)
----------------------------------------------------------------------
شفرة تشغيل برنامج اضف \ازل برنامج
add remove prog
هذه الشفره توضع فى منطقة الكود مباشرة لا يوجد تصريح
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1", 5)
----------------------------------------------------------------------
اخى هل اصابك الملل من الشكل التقليدى لنموذج الفيجول بيزك التقليدى (المستطيل)
اضف مودل جديد لمشروعك واضف اليه الكود التالى
Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
ثم اضف هذا الكود بالنموذج البرنامج ذاته
فى منطقة التحميلload
SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 300, 200), True
لاحظ انك
كلما غير الأرقام التي بين القوسين يتغير شكل النموذج
----------------------------------------------------------------------
هل واجهت مشكلة انك لا تستطيع تحريك البرنامج الذى بدون شريط عنوان
اذن الحل مع هذا الكود
اضف هذا الكود لمنطقة التصريح
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 Declare Sub ReleaseCapture Lib "User32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
اضف هذا الكود لمنطقة الكود
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long
If Button = 1 Then
Call ReleaseCapture
lngReturnValue = SendMessage(Form1.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
----------------------------------------------------------------------
مع تحياتى لأخوتى
اذا وجدت اقبال و رد على ما اكتبه ساستمر فى عرض الاكواد
لا تنسى اذا اردت اى كود راسلنى او اترك رساله بالمنتدى
egysec2000@hotmail.com