أكواد للمبتدئين

مغلقاستطلاعرائج

بدأه عبد الله فتحي في 3 أبريل 2003 · 211 رد · 28,321 مشاهدة · في لغة Ms Visual Basic 6 وما قبلها من إصدارات

#265 أبريل 2003 في 07:26

(f)الكود التاسع عشر(f)

تشغيل ملف من نوع AVI دون الحاجة إلى أي أدوات:

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 



Private Sub Form_Click() 

Dim Ret As Long, A$, x As Integer, y As Integer 

x = 10 

y = 10 

A$ = "c:Filename.avi" 

Ret = mciSendString("stop movie", 0&, 128, 0) 

Ret = mciSendString("close movie", 0&, 128, 0) 

Ret = mciSendString("open AVIvideo!" & A$ & " alias movie parent " & Form1.hWnd & " style child", 0&, 128, 0) 

Ret = mciSendString("put movie window client at " & x & " " & y & " 0 0", 0&, 128, 0) 

Ret = mciSendString("play movie", 0&, 128, 0) 

End Sub 



Private Sub Form_DblClick() 

End 

End Sub 



Private Sub Form_Terminate() 

Dim Ret As Long 

Ret = mciSendString("close all", 0&, 128, 0) 

End Sub

#275 أبريل 2003 في 07:28

(f)الكود العشرين(f)

رش الألوان على الفورم

Private Sub Form_Load()

Me.AutoRedraw = True

End Sub



Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

X = Me.CurrentX

Y = Me.CurrentY

End Sub



Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Me.PSet (X + Rnd * 255, Y + Rnd * 255), RGB(Rnd * 255, Rnd * 255, Rnd * 255)

Me.PSet (X + Rnd * 255, Y + Rnd * 255), RGB(Rnd * 255, Rnd * 255, Rnd * 255)

Me.PSet (X + Rnd * 255, Y + Rnd * 255), RGB(Rnd * 255, Rnd * 255, Rnd * 255)

Me.PSet (X + Rnd * 255, Y + Rnd * 255), RGB(Rnd * 255, Rnd * 255, Rnd * 255)

End Sub

#285 أبريل 2003 في 23:19

فهرس الأكواد السابقة

(1) لمعرفة اسم اليوم (f)

(2) لمعرفة اسم الشهر (f)

(3) لإضافة نص متحرك (f)

(4) هل الجهاز متصل بالنت (f)

(5) التأكد من وجود ملف (f)

(6) حجم الملف بالبايت (f)

(7) وقت تشغيل الويندوز (f)

(8) تشغيل ملف صوتـMDIــي (f)

(9) ملف فيديو في صورة (f)

(10) التعامل الحافظة (f)

(11) حذف أي ملف (f)

(12) عمل ملف جديد (f)

(13) الفرق بين تاريخين (f)

(14) معرف مسار الـTemp (f)

(15) تحميل ملف من النت (f)

(16) الزمن والتاريخ (f)

(17) نسخ الملفات (f)

(18) فتح صفحة إنترنت (f)

(19) ملف فيديـ AVI ـو (f)

(20) رش الألوان على الفورم (f)

(f)

أرجو من الأخوة أن يقومو بإضافة أصواتهم، فلن يستغرق ذلك سوى ثوان معدودة، ولكنه يهمني كثيراً

(f)

#296 أبريل 2003 في 11:53

(f)الكود الحادي والعشرون(f)

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

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

#306 أبريل 2003 في 11:56

(f)الكود الثاني والعشرون(f)

التحكم في رفع وخفض الصوت

Private Declare Function waveOutSetVolume Lib "Winmm.dll" (ByVal DevID As Integer, ByVal Vol As Long) As Long



Sub SetVol(Volume As Long)

 Dim Vol&

 Vol = CLng("&H" & Hex(Volume + 65536))

 waveOutSetVolume 0, Vol

End Sub



Private Sub Command1_Click()

SetVol Text1.Text

End Sub



Private Sub Form_Load()

Text1.Text = "ضع قيمة عددية تنحصر ما بين 0 و 65536"

End Sub

#316 أبريل 2003 في 12:06

(f)الكود الثالث والعشرون(f)

إنشاء مجلد جديد

Private Type SECURITY_ATTRIBUTES

  nLength As Long

  lpSecurityDescriptor As Long

  bInheritHandle As Boolean

End Type

Private Declare Function CreateDirectory Lib "kernel32.dll" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long



Private Sub Command1_Click()

Dim attr As SECURITY_ATTRIBUTES  ' security attributes structure

Dim rval As Long

' Set  security attributes

attr.nLength = Len(attr)  'size of the structure

attr.lpSecurityDescriptor = 0  'normal level of security

attr.bInheritHandle = 1  'default setting

' Create directory.

rval = CreateDirectory(Text1.Text, attr)

End Sub



Private Sub Form_Load()

Text1.Text = "c:Abdu"

Command1.Caption = "New Directory"

End Sub

#326 أبريل 2003 في 12:08

(f)الكود الرابع والعشرون(f)

معرفة مسار مجلد الـ System

ضع الكود التالي في الـ Module

Declare Function GetSystemDirectory Lib "Kernel32.dll" Alias "GetSystemDirectoryA" (ByVal strBuffer As String, ByVal lngSize As Long) As Long

والكود التالي في الفورم

Public Function TheSystemDir() As String

Dim strBuffer As String

Dim L As Long

strBuffer = Space(255)

L = GetSystemDirectory(strBuffer, 255)

TheSystemDir = Left(strBuffer, L)

End Function



Private Sub Command1_Click()

Text1.Text = TheSystemDir

End Sub

#336 أبريل 2003 في 12:12

(f)الكود الخامس والعشرون(f)

جعل الماوس منحصرة داخل نطاق معين

Private Declare Sub ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINT)

Private Declare Sub ClipCursor Lib "user32" (lpRect As Any)

Private Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long)

Private Declare Sub GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT)

Private Type RECT

Left As Integer

Top As Integer

Right As Integer

Bottom As Integer

End Type

Private Type POINT

X As Long

Y As Long

End Type





Private Sub Command1_Click() 'هذا الايعاز يجعل الماوس لا يخرج عن نطاق الفورم

Dim Client As RECT

Dim Up As POINT

ClientToScreen Me.hwnd, Up

GetClientRect Me.hwnd, Client

OffsetRect Client, Up.X, Up.Y

Up.X = Client.Left

Up.Y = Client.Top

ClipCursor Client

End Sub





Private Sub Command2_Click() 'هذا الايعاز يحرر حركة الماوس

ClipCursor ByVal 0&

End Sub



' في هذا المثال سوف تنحصر حركة الماوس داخل الفورم

' كما يمكنك حصرها داخل أداة أخرى

' me.hwnd   باستبدال الكلمة

'أو غيرها  text1.hwnd   , label1.hwnd باسم

#346 أبريل 2003 في 12:17

فهرس الأكواد السابقة

(1) لمعرفة اسم اليوم (f)

(2) لمعرفة اسم الشهر (f)

(3) لإضافة نص متحرك (f)

(4) هل الجهاز متصل بالإنترنت (f)

(5) التأكد من وجود ملف (f)

(6) حجم الملف بالبايت (f)

(7) وقت تشغيل الويندوز (f)

(8) تشغيل ملف صوتـMDIــي (f)

(9) ملف فيديو في صورة (f)

(10) التعامل مع الحافظة (f)

(11) حذف أي ملف (f)

(12) عمل ملف جديد (f)

(13) الفرق بين تاريخين (f)

(14) معرف مسار الـTemp (f)

(15) تحميل ملف من على الإنترنت (f)

(16) الزمن والتاريخ (f)

(17) نسخ الملفات (f)

(18) فتح صفحة إنترنت (f)

(19) ملف فيديـ AVI ـو (f)

(20) رش الألوان على الفورم (f)

(21) إغلاق الفورم بطريقة جميلة (f)

(22) التحكم في رفع وخفض الصوت (f)

(23) إنشاء مجلد جديد (f)

(24) معرفة مسار مجلـSystemـد (f)

(25) حصر الماوس داخل نطاق محدد (f)

قم بالتصويت من فضلك

#356 أبريل 2003 في 12:22

يعطيك العافية اخوي .. الف شكر (f)

Do as I say, not as I do

We are Anonymous. We are Legion. We don't forgive. We don't forget

#366 أبريل 2003 في 12:32

جزاك الله خيرا

قد استفدت منها كثيرا

#377 أبريل 2003 في 00:30

اشكرك على هذه الاكواد المفيده..

واتمنى ان تزودني بأكواد كثيره عن تحريك الصور بأشكال مختلفة ومتلاحقه

وعن تحريك النصوص...

تحياتي لك

جزاك الله الف خير

توته:)

#387 أبريل 2003 في 21:50

(f)الكود السادس والعشرون(f)

يقوم هذا الامر بازالة اسم البرنامج من قائمة المهام الموجودة في ويندوز Ctrl + ALt + Delete

App.TaskVisible = False

#397 أبريل 2003 في 21:51

(f)الكود السابع والعشرون(f)

تغيير اسم القرص

Private Declare Function SetVolumeLabel Lib "kernel32.dll" Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long



Private Sub Command1_Click()

Dim rval As Long

rval = SetVolumeLabel("C:", Text1.Text)

End Sub



Private Sub Form_Load()

Text1.Text = "Driver 1"

End Sub

#407 أبريل 2003 في 21:56

(f)الكود الثامن والعشرون(f)

لعمل نسخة مشتركة من البرنامج تشتغل لعدد معين من المرات ثم تطلب منك شراء النسخة الأصلية:

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 Me

End If

End Sub

#417 أبريل 2003 في 21:57

(f)الكود التاسع والعشرون(f)

لطباعة نص

Printer.Print text1.text

#427 أبريل 2003 في 22:00

(f)الكود الثلاثون(f)

لمنع نسخ أو لصق أي ملف،، يمكن استخدامه في الـ Autorun لحماية برنامجك من النسخ.

Private Sub Form_Load()

Timer1.Interval = 1

End Sub



Private Sub Timer1_Timer()

    R = Clipboard.GetText

    If Len(R) = 0 Then

    Clipboard.Clear

    End If

End Sub

#437 أبريل 2003 في 22:01

فهرس الأكواد السابقة (2)

(26) لإزالة البرنامج من الـ Ctrl + Alt + Del (f)

(27) لتغيير اسم القرص الصلب (f)

(28) لعمل نسخة مشتركة من البرنامج (f)

(29) لطباعة نص (f)

(30) لمنع نسخ أو لصق أي ملف (f)

با

لت

صو

يت

فض

لك

#447 أبريل 2003 في 22:02

جزاك الله ألف خير ،،،

وبالتوفيق .

#457 أبريل 2003 في 22:41

أخي العزيز/ عبد الله فتحي

السلام عليكم ورحمة الله وبركاته وبعد:

جزاك الله خيرا على هذه الفكرة وما تحمله ةمن معلومات مفيده جعلها الله في موازين حسناتك يوم القيامة.

وأرجوا أن تستمر في هذا الموضوع الممتاز. وشكرا

أخوك/ الساكت1

#467 أبريل 2003 في 22:46

شكراً Visitor (f) وشكراً الساكت1 (f)

:o:o

#477 أبريل 2003 في 22:49

GO GO GO

Do as I say, not as I do

We are Anonymous. We are Legion. We don't forgive. We don't forget

#488 أبريل 2003 في 00:02

Thank you NOP NOP NOP

#498 أبريل 2003 في 00:04

(f)الكود الحادي والثلاثون(f)

لتشغيل ملف صوتي من نـramـوع

ولكنه يستلزم أداة ملف rmoc3260.dll

Private Sub Command1_Click()

RealAudio1.Source = "c:Demo.ram"

RealAudio1.DoPlay

End Sub

#508 أبريل 2003 في 00:06

(f)الكود الثاني والثلاثون(f)

تسجيل الخروج من الويندوز

Private Sub Command1_Click()

Shell "Rundll.exe User.exe,ExitWindows"

End Sub

هذا الموضوع مغلق.

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

مجموعة من الأكواد مع الشرح ( للمبتدئين ) هدية لجميع أعضاء المنتدى12 رد · 5 مارس 2003
برامج للمبتدئين هديه0 رد · 10 يونيو 2003
شرح vb للمبتدئين4 رد · 3 أبريل 2006
لغة سي بلس بلس للمبتدئين2 رد · 28 سبتمبر 2005
تعرف على VB.NET للمبتدئين1 رد · 18 مارس 2006
تعلم تصميم المواقع ...من الصفر للمبتدئين106 رد · 21 أكتوبر 2007