أكواد الفيجوال بيسيك كلها

هذة من بعض الأكواد التي أعرفها

لكن أريد أكواد أخرى من فضلكم

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

لإضافة نص متحرك

Dim Llabel As Integer 

Private Sub Form_Load() 
Form1.ScaleMode = 3 
Timer1.Interval = 100 
End Sub 

Private Sub Timer1_Timer() 
Llabel = Llabel + 10 
Label1.Left = Llabel 
If Llabel > 300 Then 
Timer1.Interval = 0 
Timer2.Interval = 100 
End If 
End Sub 

Private Sub Timer2_Timer() 
Llabel = Llabel - 10 
Label1.Left = Llabel 
If Llabel < 0 Then 
Timer1.Interval = 100 
Timer2.Interval = 0 
End If 
End Sub

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

لمعرفة هل الجهاز متصل بالإنترنت أم لا

ضع هذا الكود في موديول

Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long 
Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long 
Public Const RAS95_MaxEntryName = 256 
Public Const RAS95_MaxDeviceType = 16 
Public Const RAS95_MaxDeviceName = 32 

Public Type RASCONN95 
dwSize As Long 
hRasCon As Long 
szEntryName(RAS95_MaxEntryName) As Byte 
szDeviceType(RAS95_MaxDeviceType) As Byte 
szDeviceName(RAS95_MaxDeviceName) As Byte 
End Type 

Public Type RASCONNSTATUS95 
dwSize As Long 
RasConnState As Long 
dwError As Long 
szDeviceType(RAS95_MaxDeviceType) As Byte 
szDeviceName(RAS95_MaxDeviceName) As Byte 
End Type

ضع هذا الكود في الفورم

Public Function IsConnected() As Boolean 

Dim TRasCon(255) As RASCONN95 
Dim lg As Long 
Dim lpcon As Long 
Dim RetVal As Long 
Dim Tstatus As RASCONNSTATUS95 

TRasCon(0).dwSize = 412 
lg = 256 * TRasCon(0).dwSize 

RetVal = RasEnumConnections(TRasCon(0), lg, lpcon) 

If RetVal <> 0 Then 
MsgBox "ERROR" 
Exit Function 
End If 

Tstatus.dwSize = 160 
RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus) 

If Tstatus.RasConnState = &H2000 Then 
IsConnected = True 
Else 
IsConnected = False 
End If 

End Function 

Private Sub Command1_Click() 
If IsConnected() = True Then 
MsgBox ("الجهاز متصل بالانترنت") 
Else 
MsgBox ("الجهاز غير متصل بالانترنت") 
End If 
End Sub

(f)الكود الخامس(f)

للتأكد من وجود الملف

 
Private Sub Command1_Click() 
On Error GoTo Error: 
Open "ضع مسار الملف الذي تريد التأكد من وجوده هنا" For Input As #1 
Close 
MsgBox ("الملف موجود") 
Exit Sub 
Error: 
MsgBox ("الملف غير موجود") 

End Sub

مجموعة ا

(f)الكود السادس(f)

لمعرفة حجم الملف بالبايت

 
Private Sub Command1_Click() 
Print FileLen("c:Autoexec.bat") 
End Sub

(f)الكود السابع(f)

لمعرفة الوقت الذي مضى على تشغيل الويندوز بالدقيقة

 
Private Declare Function GetTickCount Lib "Kernel32" () As Long 

Private Sub Command1_Click() 
Print Format(GetTickCount / 10000 / 6, "0") 
End Sub

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

لتشغيل ملف من نوع mdi

قم بوضع اداة mmcontrol

ثم قم بكتابة هذا الكود:

 
Private Sub Form_Load() 
MMControl1.Visible = False 
MMControl1.DeviceType = "sequencer" 
MMControl1.FileName = ("c:FileName.mid") 
MMControl1.Command = "open" 
MMControl1.Command = "play" 
End Sub

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

لتشغيل ملف فيديو في Picture

قم بوضع اداة mmcontrol

ثم قم بكتابة هذا الكود:

 
Private Sub Form_Load() 
MMControl1.FileName = ("c:FileName.dat") 
MMControl1.Command = "open" 
MMControl1.hWndDisplay = Picture1.hWnd 
End Sub

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

لوضع صورة في الحافظة:

 
Private Sub Command1_Click() 
Clipboard.Clear 
Clipboard.SetData Image1.Picture 
End Sub

ولوضع نص في الحافظة:

 
Private Sub Command1_Click() 
Clipboard.Clear 
Clipboard.SetText (Text1.Text) 
End Sub

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

لحذف أي ملف:

 
Private Sub Command1_Click() 
Kill ("C:FileName.fnm") 
End Sub

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

لعمل ملف جديد من خلال برنامجك:

 
open "c:FileName.txt" for append as #1 
Print #1,"Willkommen auf die Erde" 
Close #1

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

لمعرفة الفرق ما بين تاريخين باليوم

 
Private Sub Command1_Click() 
On Error GoTo 1 
Dim Form1Date As Date 
Dim Form2Date As Date 
Form1Date = Text1.Text 
Form2Date = Text2.Text 
Text3.Text = DateDiff("d", Text1.Text, Text2.Text) & " يوم" 
Exit Sub 
1 MsgBox ("من فضلك أدخل التاريخ بشكل صحيح") 
End Sub

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

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

ضع هذا الكود في Module

 
Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

وهذا الكود في الـ Form

Public Function TheTempDir() As String

Dim lpBuffer As String

Dim TempPath As Long

lpBuffer = Space(255)

TempPath = GetTempPath(255, lpBuffer)

TheTempDir = Left(lpBuffer, TempPath)

End Function

Private Sub Command1_Click()

Text1.Text = TheTempDir

End Sub[/php

أجعل ادواتك بشكل ادوات ويندوز اكس بى

كيف تـجعل برنامجك يـتـأثـر بـــ ( Themes Windows XP )

} قم بعمل مشروع جديد ثم اتبع الأتى بنفس النظام {

أولا قم بوضع التعريف التالى فى قسم الاعلانات .

CODE

Private Declare Function InitCommonControls Lib "comctl32.dll" () As Long

ثانيا ضع هذا الكود فى حدث ( Form_Initialize ) وليس فى حدث( Form_Load ) .

CODE

Private Sub Form_Initialize()

InitCommonControls ' ضع هذا الكود فى حدث

End Sub

ثالتا ضع الادوات الاتيه على الفورم .

Command1

VScroll1

Check1

Option1

Drive1

رابعا قم بحفظ المشروع وعمل exe للبرنامج ( اهم خطوة ) .

خامسا ادخل فى المجلد الذى انشأت به المشروع وقم بالضغط ( Right Click )

واختر ( New ) ثم ( Text Document ) .

قم بفتحه وانسخ فيه الكود التالى

CODE

Type your Project Name Here

type="win32"

name="Microsoft.Windows.Common-Controls"

version="6.0.0.0"

language="*"

processorArchitecture="*"

publicKeyToken="6595b64144ccf1df"

/>

سادسا قم بحفظ هذا الملف داخل مجلد مشروعك باختيار ( Save As ) على النسق التالى .

اسم مشروعك)).exe.mainfest

فمثلا اذا كان اسم مشروعك هو Project1

فسوف تحفظ الملف بهذا الأسم ( project1.EXE.MANIFEST )

الان شغـل ملف الــ ( ( exe الذى قمت بانشائه لبرنامجك وسوف ترى انه قد اخذ Xp Themes ) )

والان نأتى لتفصيل هذا الموضوع وكيف يعمل هذا الكود

وملخصه كالاتى :

عندما نقوم بتشغيل اى برنامج وبه هذا الكود يقوم الويندوز بالبحث عن هذا الملف الذى صنعناه

فاذا لم يجده لن يأخذ البرنامج شكل ( ( Themes الويندوز واذا وجده يتأثر البرنامج با لـ ( Themes ( الخاصة بالويندوز وكادليل على كلامى اذهب الى ا لــ

( C:Program FilesMessenger )

سوف تجد ان هناك ملف اسمه ( msmsgs.exe.manifest )

قم بانشاء تكست جديد واسحب فيه هذا الملف سوف تجد نفس الاكواد التى كتبناها بالاعلى

او قم بعمل( ( Search فى ( ( MyComputer بحيث يكون عنوان الــ ( Search )( MainFest.* ) وسوف تجد العديد من الملفات بهذا الامتداد قم بسحب اى منها فى

تكست جديد سوف تجد نفس الاكواد التى كتبناها بالاعلى واخيرا كتفصيل اكثر لهذه الدالة انها تقوم باخبار الويندوز انها تود استخدام هذه الميزه الموجوده فى ( COMCTL32.DLL )

المرفق فى ملفات الويندوز بالتحديد فى ( System32 )

ملاحظات هامة :

1- يجب ان ترفق هذا الملف ضمن مشروعك عند توزيعه حتى يتأثر بــ الـ ( Themes ) الفعالة للــ ( Xp )

2- فى السطر الموجود به هذه العباره ( Type your Project Name Here ) اكتب اسم مشروعك مع ملاحظة انه سوف تظهر لك رسالة خطأ اذا كتبته باللغة العربيه ولن يعمل البرنامج

3- لن تستطيع رؤية هذه التاثيرات عند قيامك بعمل ( Run ) للبرنامج من داخل الفيجوال بيسك يجب ان يكون هذا من خلال الــ ( exe ) الخاص بالمشروع فقط

4- لاتجهد نفسك فى محاولة ان تجعل مثلا اداه مثل( ProgressBar ) تأخذ شكل ا لــ (Xp) بهذا الكود لان هذا الكود لا يؤثر الا على الادوات القياسيه ويتضح هذا الكلام لك من خلال اسم الدالة ( InitCommonControls ) وهو يعنى الأدوات الشائعة

5- هذة الملاحظة ذكرها لى الأستاذ محمد حمود مشرف القسم العام بمنتدى فيجوال بيسك العرب

(إذا قمت بعمل الخطوات السابقة مع المف التنفيذي للفيجوال بيسك نفسه:

VB6.EXE

فإن الأدوات ستظهر بشكل ال XP حالما يتم وضعها على النموذج أثناء التصميم.

)

اسف للاطاله عليكم لكن كان يجب ان يأخذ الموضوع حقه فى الشرح ويوجد مع الرساله مثال

على هذا الموضوع والدرس مكتوب فى ملف وورد

} وارجو من الأخوة المشرفين تثبيت الموضوع لبعض الوقت حتى يستفيد منه اكبر قدر من الأعضاء لأهميته {

راجع هذا الرابط به برنامج بالكود ويحتوي على مجموعة كبيرة من الأكواد

http://www.vb4arab.com/vb/showthread.php?s...&threadid=30256

هذا رابط به أكواد عن الوقت والتاريخ :

http://www.vb4arab.com/vb/showthread.php?s...&threadid=31219

وعند فتحك لأي من المواضيع ستجد في التوقيع أربعة دروس + أربعة برامج بالكود يمكنك الاستفادة منها .