MR:HACK

Member










~ حبيت انزل لكم بـعض الاكواد [ للفيجوال بيسـك 6 ] ~


ان شاء الله تعجبكم








كـود .. الانتقال الى الموقع


PHP:
Dim x As Object
Set x = CreateObject("internetexplorer.application")
x.navigate "www.google.com"
x.Visible = True




كود افراغ حقول التكسـت



PHP:
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




كود لنسخ من التكسـت



PHP:
With Text1
.SelStart = 0
.SelLength = Len(.Text)
Clipboard.Clear
.SetFocus
Clipboard.SetText .Text
End With

MsgBox "تم النـســـــخ", , "عملية النســـخ"
( لاكن لا تنسى ان تغير الحقل المراد النسخ منه Text1 )









كـود فتح الـ ( CD-ROM )




في الجينرال



PHP:
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
في الزر



PHP:
Private Sub command1_click()
Private Sub emptyrecyclebin()
End Sub





كود يقوم بحماية برنامجك حيث يعمل عدد من المرات (تحددها بنفسك)



PHP:
Private Sub Form_Load()
retvalue = GetSetting("A", "0", "Runcount")
GD$ = Val(retvalue) + 1
SaveSetting "A", "0", "RunCount", GD$
If GD$ > 3 Then  ' الرقم (3) يحدد عدد مرات التشغيل
MsgBox "عليك بشراء النسخة الاصلية .. انتهت مدة نشغيل البرنامج"
Unload FRM '
End If
End Sub

If GD$ > 3 Then ' الرقم (3) يحدد عدد مرات التشغيل

هنا رقم 3 نقوم بتغييره الى عدد المرات التي يقوم برنامجك بتشغيل فقط [ اي بعد ثلاث مرات من تشغيل برنامج بعدها تضهر رسال للمستخدم [ نتهت مدة تشغيل البرنامج .. عليك بشراء النسخة الاصلية ]











كود
إخفاء شريط المهام



PHP:
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private 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










كود
تحريك Label بشكل طولي





PHP:
Private Sub Form_Load()
Timer1.Interval = 100
End Sub
Private Sub Timer1_Timer()
Label1.Move 2000, Label1.Top - 100
If Label1.Top < 0 Then
Label1.Top = Form1.Height
End If
End Sub











كود لفتح الفورم بكريقة جميلة جدا



PHP:
Sub Explode(form1 As Form)
form1.Width = 0
form1.Height = 0
form1.Show
For X = 0 To 5000 Step 1
form1.Width = X
form1.Height = X
With form1
.Left = (Screen.Width - .Width) / 2
.Top = (Screen.Height - .Height) / 2
End With
Next

End Sub
Private Sub Form_Load()
Explode Me
End Sub










كود لاغلاق الفورم بطريقة جميلة جدا




PHP:
Sub SlideWindow(frmSlide As Form, iSpeed As Integer)
While frmSlide.Left + frmSlide.Width < Screen.Width
DoEvents
frmSlide.Left = frmSlide.Left + iSpeed
Wend
While frmSlide.Top - frmSlide.Height < Screen.Height
DoEvents
frmSlide.Top = frmSlide.Top + iSpeed
Wend
Unload frmSlide
End Sub
Private Sub Command1_Click()
Call SlideWindow(form1, 100)
End Sub

بالنسبة للكود لفتح الـ ( CD-ROM )



في الجينرال



PHP:
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

في الزر المخصص للفتح





PHP:
Private Sub Command1_Click()
OpenCDDriveDoor (True)
End Sub
في الزر المخصص للاغلاق



PHP:
Private Sub Command2_Click()
OpenCDDriveDoor (False)
End Sub




اما بالنسبة للكود لاخفاء شريط المهام




في الجينرال





PHP:
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private 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

في الزر المخصص للاخفاء





PHP:
Private Sub Command1_Click()
Dim Task As Long
Task = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Task, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End Sub

في الزر المخصص للاظهار





PHP:
Private Sub Command2_Click()
Dim Task As Long
Task = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Task, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End Sub







هذا ما لدي اليوم

( اتمنى ان تكون الاكواد مفيدة لكم )








هذا الموضوع البسيط اهداء الى كل

اداري ,

مشرف ,

عضو ,

زائر ,


و اهداء خاص لصديقي ( Mahmodemos )






و في النهاية ,,


إن آصبت فآ هو من فضل ربي علي ، وآن آخطآت فآ هو من شيطآنيَ


آخوكم : مسترَ هـاك ~ Mr:Hack


في امان الله ,, :SnipeR (29):

 

التعديل الأخير بواسطة المشرف:

المواضيع المشابهة

admin

Administrator

رد: ~ اكواد [ للفيجوال بيسـك 6 ] ~

يعطيك العافية
موضوع مفيد بارك الله فيك
يتبت حتى يفيد اكبر عدد ممكن
شكرا لك + تم التقيم
 

MR:HACK

Member

رد: ~ اكواد [ للفيجوال بيسـك 6 ] ~

بالنسبة للكود لفتح الـ ( CD-ROM )



في الجينرال



PHP:
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

في الزر المخصص للفتح





PHP:
Private Sub Command1_Click()
OpenCDDriveDoor (True)
End Sub

في الزر المخصص للاغلاق



PHP:
Private Sub Command2_Click()
OpenCDDriveDoor (False)
End Sub






اما بالنسبة للكود لاخفاء شريط المهام




في الجينرال





PHP:
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private 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



في الزر المخصص للاخفاء





PHP:
Private Sub Command1_Click()
Dim Task As Long
Task = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Task, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End Sub



في الزر المخصص للاظهار





PHP:
Private Sub Command2_Click()
Dim Task As Long
Task = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Task, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End Sub










ارجو من الـ ( Admin )


التعديل



 


رد: ~ اكواد [ للفيجوال بيسـك 6 ] ~

شكرا على الاهداء :rolleyes:

مبارك التثبيت

<www.sqorebda3.com>

شكرا لك لإضافة تقييم لمستوى هذا العضو، سيكون حظك موفقا كي تتلقى نفس التقييم من هذا العضو أو غيره.

موضوعك قمـــة
 

أعلى