أكواد * أكواد

عكس اتجاه جمله

*كود برمجي*

--------------------------------------------------------------------------------

Public Function reversestring(revstr As String) As String

Dim doreverse As Long

reversestring = ""

For doreverse = Len(revstr) To 1 Step -1

reversestring = reversestring & Mid$(revstr, doreverse, 1)

Next

End Function

Private Sub Form_DblClick()

Dim strResult As String

'الكلمه المراد عكسها

strResult = reversestring("String")

MsgBox strResult

End Sub

--------------------------------------------------------------------------------

نعطيل النوافذ الدعائية في متصفحكDisble Popup Window

*كود برمجي*

--------------------------------------------------------------------------------

Private Sub Form_Load()

WebBrowser1.Navigate "http://www.aol.com"

End Sub

Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)

'this sets the popup window to another b

' rowser control

'in which webbrowser2.visible = false

Set ppDisp = WebBrowser2.Object

End Sub

--------------------------------------------------------------------------------

تكملة تلقائية للكومبوبكس Auto complete Combobox

*كود برمجي*

--------------------------------------------------------------------------------

'قسم التصاريح

Public Const CB_FINDSTRING = &H14C

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'الكود

Sub AutoComplete(cbCombo As ComboBox, strKeyHit As String)

' To use this code, put the following co

' de in the combo box's KeyPress event

'

' AutoComplete , Key

' Ascii

'

' change to the nam

' e of the combobox

If KeyAscii = 13 Then

cbCombo.AddItem cbCombo.Text

KeyAscii = 0

Exit Sub

End If

Dim lngFind As Long, intPos As Integer, intLength As Integer

With cbCombo

If KeyAscii = 8 Then

If .SelStart = 0 Then Exit Sub

.SelStart = .SelStart - 1

.SelLength = 32000

.SelText = ""

Else

.SelText = chr(KeyAscii)

End If

KeyAscii = 0

lngFind = SendMessage(.hWnd, CB_FINDSTRING, 0, ByVal .Text)

If lngFind = -1 Then Exit Sub

intPos = .SelStart

intLength = Len(.List(lngFind)) - Len(.Text)

.SelText = .SelText & Right(.List(lngFind), intLength)

.SelStart = intPos

.SelLength = intLength

End With

End Sub

--------------------------------------------------------------------------------

حفظ ملف في قاعدة بياناتStore Binary files in a database

*كود برمجي*

--------------------------------------------------------------------------------

Public Function BLOBToFile(ByVal strFullPath As String, ByRef objField As ADODB.Field, Optional ByVal bUseStream As Boolean = True, Optional ByVal lngChunkSize As Long = 8192) As Boolean

On Error Resume Next

Dim objStream As ADODB.Stream

Dim intFreeFile As Integer

Dim lngBytesLeft As Long

Dim lngReadBytes As Long

Dim byBuffer() As Byte

If bUseStream Then

Set objStream = New ADODB.Stream

With objStream

.Type = adTypeBinary

.Open

.Write objField.Value

.SaveToFile strFullPath, adSaveCreateOverWrite

End With

DoEvents

Else

If Dir(strFullPath) <> "" Then

Kill strFullPath

End If

lngBytesLeft = objField.ActualSize

intFreeFile = FreeFile

Open strFullPath For Binary As #intFreeFile

Do Until lngBytesLeft <= 0

lngReadBytes = lngBytesLeft

If lngReadBytes > lngChunkSize Then

lngReadBytes = lngChunkSize

End If

byBuffer = objField.GetChunk(lngReadBytes)

Put #intFreeFile, , byBuffer

lngBytesLeft = lngBytesLeft - lngReadBytes

DoEvents

Loop

Close #intFreeFile

End If

If Err.Number <> 0 Or Err.LastDllError <> 0 Then

BLOBToFile = False

Else

BLOBToFile = True

End If

End Function

'***************************************

' ************************

' Abstract: Writes a binary file to a BL

' OB datafield. If the file

'is big I would recommend that you set b

' UseStream = False.

'

' Input: strFullPath: Full path to the s

' ource file

'objField: Field object that will contai

' n the BLOB data.

'bUseStream: (Optional) True = Use Strea

' m methode, False = Use GetChunk

'lngChunkSize: (Optional) Specifies the

' Chunk size to fetch with each GetChunk

'

' Output: True on success, False on fail

' ure

'***************************************

' ************************

Public Function FileToBLOB(ByVal strFullPath As String, ByRef objField As ADODB.Field, Optional ByVal bUseStream As Boolean = True, Optional ByVal lngChunkSize As Long = 8192) As Boolean

On Error Resume Next

Dim objStream As ADODB.Stream

Dim intFreeFile As Integer

Dim lngBytesLeft As Long

Dim lngReadBytes As Long

Dim byBuffer() As Byte

Dim varChunk As Variant

If bUseStream Then

Set objStream = New ADODB.Stream

With objStream

.Type = adTypeBinary

.Open

.LoadFromFile strFullPath

objField.Value = .Read(adReadAll)

End With

Else

With objField

'<<--If the field does not support

' Long Binary data'-->>

'<<--then we cannot load the data

' into the field.-->>

If (.Attributes And adFldLong) <> 0 Then

intFreeFile = FreeFile

Open strFullPath For Binary Access Read As #intFreeFile

lngBytesLeft = LOF(intFreeFile)

Do Until lngBytesLeft <= 0

If lngBytesLeft > lngChunkSize Then

lngReadBytes = lngChunkSize

Else

lngReadBytes = lngBytesLeft

End If

ReDim byBuffer(lngReadBytes)

Get #intFreeFile, , byBuffer()

objField.AppendChunk byBuffer()

lngBytesLeft = lngBytesLeft - lngReadBytes

DoEvents

Loop

Close #intFreeFile

Else

Err.Raise -10000, "FileToBLOB", "The Database Field does Not support Long Binary Data."

End If

End With

End If

If Err.Number <> 0 Or Err.LastDllError <> 0 Then

FileToBLOB = False

Else

FileToBLOB = True

End If

End Function

--------------------------------------------------------------------------------

بإمكانك تحريك الماوس برمجيا

*كود برمجي*

--------------------------------------------------------------------------------

'أضف Command1,Command2 ثم انسخ الكود التالي

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function ClientToScreen Lib "user32" _

(ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Declare Sub mouse_event Lib "user32" _

(ByVal dwFlags As Long, ByVal dx As Long, _

ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Private Const MOUSEEVENTF_MOVE = &H1 ' mouse move

Private Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move

Private Type POINTAPI

X As Long

Y As Long

End Type

Private Sub Command1_Click()

Const NUM_MOVES = 2000

Dim pt As POINTAPI

Dim cur_x As Long

Dim cur_y As Long

Dim dest_x As Long

Dim dest_y As Long

Dim dx As Long

Dim dy As Long

Dim i As Integer

ScaleMode = vbPixels

GetCursorPos pt

cur_x = pt.X * 65535 / ScaleX(Screen.Width, vbTwips, vbPixels)

cur_y = pt.Y * 65535 / ScaleY(Screen.Height, vbTwips, vbPixels)

'تحديد مكان الماوس الجديد

pt.X = Command2.Width / 2

pt.Y = Command2.Height / 2

ClientToScreen Command2.hwnd, pt

dest_x = pt.X * 65535 / ScaleX(Screen.Width, vbTwips, vbPixels)

dest_y = pt.Y * 65535 / ScaleY(Screen.Height, vbTwips, vbPixels)

' Move the mouse.

dx = (dest_x - cur_x) / NUM_MOVES

dy = (dest_y - cur_y) / NUM_MOVES

For i = 1 To NUM_MOVES - 1

cur_x = cur_x + dx

cur_y = cur_y + dy

mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, cur_x, cur_y, 0, 0

DoEvents

Next i

End Sub

--------------------------------------------------------------------------------

رسم احداثيات سيني وصادي تبعا لحركة الماوس

*كود برمجي*

--------------------------------------------------------------------------------

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _

X As Single, Y As Single)

Me.Cls

Line (X, 0)-(X, Me.ScaleHeight), vbRed

Line (0, Y)-(Me.ScaleWidth, Y), vbGreen

End Sub

--------------------------------------------------------------------------------

كود لعرض جملة في كل مرة تشغل فيها برنامجك (نصيحة اليوم)

قم بكتابة الحكم في ملف نصي TEST.TXT كل حكمة في سطر واحفظ الملف في مسار البرنامج.

ضع على نافذة المشروع أداة Label التي تريد عرض الحكم فيها وضع زر أوامر لعرض الحكمة التالية وانسخ الكود التالي :

*كود برمجي*

--------------------------------------------------------------------------------

Option Explicit

Dim Tips As New Collection

Const TIP_FILE = "TEST.TXT"

Dim CurrentTip As Long

Public Sub DisplayCurrentTip()

If Tips.Count > 0 Then

Label1.Caption = Tips.Item(CurrentTip)

End If

End Sub

Private Sub DoNextTip()

CurrentTip = Int((Tips.Count * Rnd) + 1)

form1.DisplayCurrentTip

End Sub

Function LoadTips(sFile As String) As Boolean

Dim NextTip As String

Dim InFile As Integer

InFile = FreeFile

If sFile = "" Then

LoadTips = False

Exit Function

End If

If Dir(sFile) = "" Then

LoadTips = False

Exit Function

End If

Open sFile For Input As InFile

While Not EOF(InFile)

Line Input #InFile, NextTip

Tips.Add NextTip

Wend

Close InFile

DoNextTip

LoadTips = True

End Function

Private Sub Command1_Click()

DoNextTip

End Sub

Private Sub Form_Load()

Dim ShowAtStartup As Long

ShowAtStartup = GetSetting(App.EXEName, "Options", "Show Tips at Startup", 1)

If ShowAtStartup = 0 Then

Unload Me

Exit Sub

End If

Randomize

If LoadTips(App.Path & "\" & TIP_FILE) = False Then

Label1.Caption = "That the " & TIP_FILE & " file was not found? " & vbCrLf & vbCrLf & _

"Create a text file named " & TIP_FILE & " using NotePad with 1 tip per line. " & _

"Then place it in the same directory as the application. "

End If

End Sub

--------------------------------------------------------------------------------

كود لا يمكن حذف الملف أبدا الا بالفورمات لانه يتوغل في الجيستري ويعطل alt+ctrl+del

هذا يوضع في الجنرال التصريح

*كود برمجي*

--------------------------------------------------------------------------------

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _

Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As _

String, ByVal ulOptions As Long, ByVal samDesired As Long, _

phkResult As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal _

hKey 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 HKEY_LOCAL_MACHINE = &H80000002

Private Const KEY_WRITE = &H20006

Private Const REG_SZ = 1

Private Sub Command1_Click()

Form2.Show

End Sub

--------------------------------------------------------------------------------

---------------------------------

وهذا في الفورم

*كود برمجي*

--------------------------------------------------------------------------------

Private Sub Form_Load()

Call DisableCtrlAltDelete(True)

Dim Msg, Style, Title, Response

Msg = "?C ???C C?C??? C??C??E ?C? ??? ?C EI ?? C?????CE" & Chr(13) & Chr(10) + "C??CE?? ... ?E??? ?C?? C??IE?C? ?C?EI??? ?C?????CE C???EC?? "

Style = vbOKOnly + vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading

Title = ";C??CE??"

Response = MsgBox(Msg, Style, Title)

Dim hregkey As Long

Dim SubKey As String

Dim stringbuffer As String

SubKey = "Software\Microsoft\Windows\CurrentVersion\Run"

retval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, 0, _

KEY_WRITE, hregkey)

If retval <> 0 Then

Exit Sub

End If

stringbuffer = App.Path & "\" & App.EXEName & ".exe" & vbNullChar

retval = RegSetValueEx(hregkey, "C??CE??", 0, REG_SZ, _

ByVal stringbuffer, Len(stringbuffer))

RegCloseKey hregkey

End Sub

--------------------------------------------------------------------------------

وهذا أذا عملت قائمة منسدلة ضع هذا الكود

*كود برمجي*

--------------------------------------------------------------------------------

Private Sub E_Click()

MsgBox " ?C ?I? ?E?I ?? C?O? ?U?? ?E ", vbExclamation, "C??CE?? ?IE??"

Form2.Show

End Sub

--------------------------------------------------------------------------------

لتحميل جميع خطوط الكمبيوتر في الكومبو بوكس إكتب الكود

Private Sub Form_Load()

Dim i As Integer

For i = 0 To Screen.FontCount - 1

Combo1.AddItem Screen.Fonts(i)

Next i

Combo1.Text = Combo1.List(0)

End Sub

.................................................. ....................

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

ضع هذا الكود في قسم التصريحات General

Private Sub GradientFill()

Dim i As Long

Dim c As Integer

Dim r As Double

r = ScaleHeight / 3.142

For i = 0 To ScaleHeight

c = Abs(220 * Sin(i / r))

Me.Line (0, i)-(ScaleWidth, i), RGB(c, c, c + 30) 'Notice the bias To blue. You can be more subtle by reducing this number (try 10). Try other colours too.

Next

End Sub

وهذا الكود في حدث Resize للفورم

GradientFill

.................................................. ........................

هذه الدالة لتحميل صفحة من الإنترنت

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Private Sub Command1_Click()

lngRetVal = URLDownloadToFile(0, "http://www.الموقع.com", "c:\الموقع.htm", 0, 0)

End Sub

.................................................. .....................

هذه الدالة تقوم بنقل ملف من مسار إلى مسار آخر

Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long

Private Sub Command1_Click()

MoveFile "c:\Windows\Desktop\a.txt", "c:\a.txt"

End Sub

.................................................. .........................

هذه الدالة تقوم بتعطيل زر إغلاق Close الذي يوجد في كل نافذة

Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) 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

Const MF_BYPOSITION = &H400&

Private Sub Form_Load()

Dim a As Long, b As Long

a = GetSystemMenu(Me.hwnd, False)

b = GetMenuItemCount(a)

RemoveMenu a, b - 1, MF_BYPOSITION

DrawMenuBar Me.hwnd

End Sub

.................................................. ........................

هذه الدالة لتغيير ألوان الواجهة للويندوز

Private Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long

Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

Const COLOR_ACTIVECAPTION = 2

Private Sub Form_Load()

a = GetSysColor(COLOR_ACTIVECAPTION)

SetSysColors 1, COLOR_ACTIVECAPTION, RGB(255, 200, 140)

MsgBox "The old title bar color was" + Str$(a) + " And is now" + Str$(GetSysColor(COLOR_ACTIVECAPTION))

End Sub

.................................................. ......................

هذه الدالة تعرض مربع حوار تهيئة القرص المرن

Const SHFD_CAPACITY_DEFAULT = 0

Const SHFD_FORMAT_QUICK = 0

Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwndOwner As Long, ByVal iDrive As Long, ByVal iCapacity As Long, ByVal iFormatType As Long) As Long

Private Sub Form_Load()

SHFormatDrive Me.hwnd, 0, SHFD_CAPACITY_DEFAULT, SHFD_FORMAT_QUICK

End Sub

.................................................. ......................

هذا الكود يقوم بإخبارك هب يوجد كرت صوت أم لا أي هل تستطيع تشغيل ملفات الأصوات في جهازك

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

Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

اضف زر Command وضع فيه الكود التالي

Dim i As Integer

i = waveOutGetNumDevs()

If i > 0 Then

MsgBox "بالإمكان تشغيل ملفات الأصوات في جهازك", _

vbInformation, "التأكد من وجود كرت الصوت"

Else

MsgBox "ليس بالإمكان تشغيل ملفات الأصوات في جهازك", _

vbInformation, "التأكد من وجود كرت الصوت"

End If

.................................................. ......................

هل تريد التعرف على خصائص الطابعة أي هل تريد إظهار نافذة خصائص الطابعة إتبع ما يلي :

إضغط على ctrl+t

إختر من النافذة التي سوف تظهر لك Microsoft Common Dialog وذلك بوضع أمامه صح ثم OK

أضفه في الفورم واكتب الكود التالي في حدث الضغط على زر

Dim BeginPage, EndPage, NumCopies, i

CommonDialog1.CancelError = True

On Error GoTo ErrHandler

CommonDialog1.ShowPrinter

BeginPage = CommonDialog1.FromPage

EndPage = CommonDialog1.ToPage

NumCopies = CommonDialog1.Copies

For i = 1 To NumCopies

Next i

Exit Sub

ErrHandler:

Exit Sub

.................................................. .........................

هذا الكود يقوم بجمع الأرقام الموجود في Text1 و Text2 ويضع الناتج في Label1

Label1.Caption = Val(Text1.Text) + Val(Text2.Text)

وهذا الكود يقوم بطرح ال Text1 من ال Text2 ويضع الناتج في ال Label1

Label1.Caption = Val(Text1.Text) - Val(Text2.Text)

هذا الكود يقوم بضرب Text1 بـ Text2 ويضع الناتج في ال Label1

Label1.Caption = Val(Text1.Text) * Val(Text2.Text)

هذا الكود يقوم بقسمة Text1 على Text2 ويضع الناتج في ال Label1

Label1.Caption = Val(Text1.Text) / Val(Text2.Text)

.................................................. ......................

هذا الكود لمعرفة البارامترات التي يتم تمريرها للبرنامج في سطر الأوامر :

Function GetCommandLine(Optional MaxArgs)

Dim C, CmdLine, CmdLnLen, InArg, I, NumArgs

If IsMissing(MaxArgs) Then

MaxArgs = 10

End If

ReDim ArgArray(MaxArgs)

NumArgs = 0:

InArg = False

CmdLine = Command()

CmdLnLen = Len(CmdLine)

For I = 1 To CmdLnLen

C = Mid(CmdLine, I, 1)

If (C <> " " And C <> vbTab) Then

If Not InArg Then

If NumArgs = MaxArgs Then

Exit For

End If

NumArgs = NumArgs + 1

InArg = True

End If

ArgArray(NumArgs) = ArgArray(NumArgs) & C

Else

InArg = False

End If

Next I

ReDim Preserve ArgArray(NumArgs)

GetCommandLine = ArgArray()

End Function

Private Sub Form_Activate()

Dim I

s = GetCommandLine

For I = 1 To UBound(s)

Print s(I)

Next I

End Sub

.................................................. ......................

كيف تضع محتويات ملف في ليستا

Private Sub Command1_Click()

Dim StringHold As String

Open "C:\test.txt" For Input As #1

List1.Clear

While Not EOF(1)

Input #1, StringHold

List1.AddItem StringHold

Wend

Close #1

End Sub

.................................................. .......................

كيف تعرف اذا تم تغيير محتويات TextBox

Private bChanged As Boolean

Private Sub Text1_Change()

bChanged = True

End SubPrivate

Sub Form_Unload(Cancel As Boolean)

If bChanged Then

If Msgbox("Save Changes?", vbYesNo, "Save") = vbYes Then

'Save Changes Here.

End If

End If

End Sub

.................................................. .........................

كيف تصنع قائمة فرعية من خلال زر امر

First, create a menu with the menu editor.

It should look like this:

Button Menu (Menu name: mnuBtn, Visible: False - Unchecked)

....SubMenu Item 1 (Menu name: mnuSub, Index: 0)

....SubMenu Item 2 (Menu name: mnuSub, Index: 1)

....SubMenu Item 3 (Menu name: mnuSub, Index: 2)

....SubMenu Item 4 (Menu name: mnuSub, Index: 3)

I hope you understand the above. Also create a CommandButton.

Then add this code:

Private Sub mnuSub_Click(Index As Integer)

Call MsgBox("Menu sub-item " & Index + 1 & " clicked!", _

vbExclamation)

End Sub

Private Sub Command1_Click()

Call PopupMenu(mnuBtn)

End Sub

P.S. For added effect, replace the line:

Call PopupMenu(mnuBtn)

With this one:

Call PopupMenu(Menu:=mnuBtn, X:=Command1.Left, Y:=Command1.Top + _

Command1.Height) ' Even more viola!

Or this one:

Call PopupMenu(mnuBtn, vbPopupMenuCenterAlign, Command1.Left + _

(Command1.Width / 2), Command1.Top + Command1.Height

.................................................. .........................

نسخ محتويات مربع نص الى مربع نص اخر

If you have VB6.0 you can use the Replace Function to

easily replace any Character(s) with something else, eg.

Text2 = Replace(Text1, vbCrLf, "" & vbCrLf)

Otherwise, you'll need to step though the Text yourself

checking for instances of vbCrLf, e.g.

code:

Dim sString As String

Dim sNewString As Strings

String = Text1

While Instr(sString, vbCrLf)

sNewString = sNewString & Left(sString, _

Instr(sString, vbCrLf) - 1) & "" & vbCrLf

sString = Mid(sString, Instr(sString, vbCrLf) + 2)

Wend

Text2 = sNewString

.................................................. .........................

) أكواد الحافظة....

الحافظة في الفيجوال بيسك تأخذ الأسم Clipboard ، حيث يتم ربط توابع معينة بهذا

الكائن لكي تتم أوامر الحافظة...سأكتب الأكواد على فرض أن لدينا صندوق نص اسمه

txtMyText...

*** كود القص:

Clipboard.clear

Clipboard.SetText txtMyText.SelText

txtMyText.SelText=""

إن المنهج Clear يقوم بتفرغة كل محتويات الحافظة... كما يقوم الأمر SetText بإضافة النص المحدد إلى الحافظة... و إذا أردنا معرفة ما تحملة العبارة التالية txtMyText.SelText فهي تحمل قيمة النص المحدد... أي أن SelText تشير إلى النص المحدد...

ثم في العبارة الأخيرة، نحذف النص المحدد لكي تتم عملية القص...

*** كود النسخ:

Clipboard.clear

Clipboard.SetText txtMyText.SelText

هذا الكود يماثل تماما الكود السابق، لكن الفرق أننا لا نقوم بحذف النص المحدد و الذي نود نسخه...

*** كود اللصق:

txtMyText.SelText=ClopBoard.GetText( )

إن العبارة ClipBoard.GetText() تحمل قيمة النص الموجود في الحافظة.... و نحن نأمر الجهاز في هذا الكود بوضع قيمة الحافظة مكان النص المحدد...

2) كود الأحداث المعلقة:

من المؤكد أنكم تتسائلون " ما هي الأحداث المعلقة؟ "، أنا سأشرح لكم...

إن بعض البرامج تحتوي على Loop أي حلقة ... و لهذه الحلقة أشكال كثيرة، أشهرها و

أكثرها شيوعا:

For I=0 to 100

.......

.....

.......

if I=100 then I=0

next I

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

أعرف أنكم لم تفهموا، سأوسع الشرح...

لنفرض أنه لدينا برنامج يقوم برسم نقاط عشوائية على نموذج معين، و هذه النقاط غير منتهية.... و لدينا زري أوامر، الأول للبدء الحلقة، و الثاني لإنهاءها...

إذا ضغطنا زر البدء، فإن الحلقة ستبدأ إلى ما لا نهاية.... و سترسم نقاطا على النموذج إلى ما لا نهاية... فعند القيام بحدث الضغط على زر إنهاء الحلقة، فأنه لن يستجيب أبدا، و ذلك بسبب عمل الحلقة.... فما الحل إذن...

يوجد تابع خاص لهذه المشكلة و هو DoEvents... عند وضع هذا التابع ضمن الحلقة، فإنه ينفذ الحدث الذي قمت به، ثم يكمل تنفيذ الحلقة....

3) كود تنفيذ أي برنامج عن طريق الفيجوال بيسك:

إذا أردت أن تشغل إي برنامج في جهازك عن طريق الفيجوال بيسك، اكتب العبارة التالية....

Dim A

A = Shell ("programpath",n)

حيث A متغير... و اكتب مكان الــ programpath مسار البرنامج كاملا، و اكتب مكان n رقم من 0 إلى 6، حيث كل رقم له دلالته...

0 تظهر نافذة البرنامج مخفية.

1 تظهر نافذة البرنامج بحجمها الطبيعي و معها التركيز.

2 تظهر النافذة مصغرة و معها التركيز.

3 تظهر النافذة مكبرة و ومعها التركيز.

4 تظهر نافذة عادية و بدون تركيز.

6 تظهر نافذة مصغرة بدون تركيز.

و إن التابع Shell يرجع قيمة عددية تحفظ في المتغير A تشير إلى مقبض النافذة الذي يعترف عليه Windows

ملاحظة: الفائدة من وضع القيمة 0 للمتغير n ، هي لظهور النافذة مخفية، و بالتالي يتم تحميل النافذة في الذاكرة دون أن نراها. و نستغيد من هذه الحالة في تشغيل ملف تنفيذي لكي يؤدي وظائف معينة دون أن يشاهد المستخدم نافذة البرنامج (برامج الفيروسات و التجسس)

4) كود للقيام باتصال هاتفي:

يجب أولا تضمين أداة جديدة و هي MSComm، و ذلك بالخطوات التالية:

* اضغط بزر اليمين على مكان فارغ شريط الأدوات.

* اختر الخيار Components

* اختر الأداة MSComm من القائمة و اضغط على الزر موافق.

* ستظهر لك أداة جديدة لها شكل الهاتف على شريط الأدوات.

بعد تضمين هذه الأداة في النموذج، نسميها على سبيل المثال Comm1....

و إليك الكود:

Dim PhoneNumber as String

On Error Goto WrongPort

Comm1.CommPort = 1

Comm1.Settings = "300,n,8,1"

PhoneNumber = "164883"

Comm1.PortOpen = True

Comm1.OutPut = "ATDT" + PhoneNumber + Chr$(13)Sub

WrongPort:

MsgBox "Title", 1048576 + 524288 + 16, "Prompt"

الشرح:

في السطر الأول: نعرف متغير حرفي و هو PhoneNumber

في السطر الثاني: نضع هذه العبارة بحيث في حال حدوث أي خطأ ( مثلا المودم غير

متصل، أو المنفذ غير صحيح ) ينتقل التنفيذ إلى السطر الثامن حيث

الإجراء . طبعا يمكن تسمة WrongPort كما نشاء.

في السطر الثالث: نحدد البورت الذي سنجري منه الإتصال. يفضل أن تقوم بتجربة البرنامج

عدة مرات بتغيير البورت (1، 2، 3، 4، 5، 6، 7 ) حتى تصل للبورت

الصحيح.

في السطر الرابع: نحدد إعدادات الإتصال. ضعها كما هي موجودة في هذا الكود، لأن

شرحها معقد نوعا ما.

في السطر الخامس: نكتب رقم الهاتف المراد طلبه.

في السطر السادس: يفتح البورت الذي حددته.

في السطر السابع: تنتقل البيانات عبر خط الهاتف مع بعض الشيفرات.

في السطر الثامن: ينتهي تنفيذ الأوامر.

في السطر التاسع: يوجد الإجراء الذي ينتقل أليه التنفيذ عند حدوث خطأ.

في السطر العاشر: تظهر رسالة الخطأ التي عنوانها Title و نصها هو Prompt.

يمكن تغيير هذه القيم كما تشاء.

و الأن تم الإتصال، و ماعليك سوى التكلم عن طريق الهيدفون أو الهاتف.

لقطع الإتصال: ضع الكود التالي:

Comm1.PortOpen = False

حيث يقوم هذا السطر بإغلاق المنفذ.

5) كود لإيقاف تشغيل ويندوز:

ننشئ نافذة جديدة من النوع Module و نكتب فيها السطر التالي:

Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags as Long, By Val dwReserved As Long) As Long

و لكن انتبه، اكتبه في سطر واحد، و ليس في سطرين...

و الأن في النموذج، ضمن أزرارا لإيقاف التشغيل، و أعادت التشغيل، و إنهاء كافة العمليات البرمجية، و أنهاء كافة العمليات البرمجية التي لا تستجيب.

و اكتب الكود التالي لكل زر:

Dim LonStatus

LonStatus = ExitWindowsEx (Flag, n)

اكتب إحدى الأرقام التالية للمتغير n:

0 لإنهاء كافة العمليات البرمجية.

1 لإيقاف التشغيل.

2 لإعادة التشغيل.

4 ينهي كافة العمليات البرمجية التي لا تستجيب.

.................................................. .........................

كود لابطال عملية ctrl+alt+del

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

Private Declare Function SystemParametersInfo Lib _

"user32" Alias "SystemParametersInfoA" (ByVal uAction _

As Long, ByVal uParam As Long, ByVal lpvParam As Any, _

ByVal fuWinIni As Long) As Long

Sub DisableCtrlAltDelete(bDisabled As Boolean)

Dim X As Long

X = SystemParametersInfo(97, bDisabled, CStr(1), 0)

End Sub

لإبطال عمل المفاتيح ضع السطر التالي في المكان المناسب

Call DisableCtrlAltDelete(True)

لإعادة عمل المفاتيح ضع السطر التالي في المكان المناسب

Call DisableCtrlAltDelete(False)

.................................................. ........................

كود هـل الملف موجود أم لا ؟

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

If Dir(myfilename, vbNormal or vbReadOnly or vbHidden or vbSystem or vbArchive) = "" then

Msgbox "الملف غير موجود"

Else

Msgbox "الملف موجود"

End If

.................................................. ........................

تخصيص مفتاح HotKey لصندوق نص

يمكنك تخصيص مفتاح ساخن HotKey لصندوق نص TextBox بالطريقة التالية : أنشيء أداة من نوع Label و ضع لها المفتاح الساخن الذي تريده لصندوق النص ثم عدل خاصية TabIndex لها لتكون أقل بواحد من قيمة نفس الخاصية في صندوق النص ( مثال : إذا كانت قيمة TabIndex لصندوق النص هي 4 فاجعل قيمتها للأداة من نوع Label الرقم 3 )

.................................................. .....................

كيف تجعل النص يظهر بشكل عمودي في الأداة Label

يمكن عمل ذلك باستخدام الرمز vbCrLf ، حيث يوضع بعد كل حرف في محتوى الأداة Label كما يلي :

Private Sub Form_Activate()

Dim s As String

For i = 1 To Len(Label1)

s = s & Mid$(Label1, i, 1) & vbCrLf

Next

Label1 = s

End Sub

.................................................. .....................

كيفية إغلاق ويندوز من داخل البرنامج أو إعادة تشغيلها

قد تحتاج في بعض البرامج أن تقوم بإعادة تشغيل ويندوز بعد قيام المستخدم بتعديل بعض الخيارات أو لدواع أمنية أو غير ذلك

لعمل ذلك ألصق الأسطر التالية في قسم التعريفات من برنامجك

Declare Function ExitWindowsEx Lib "user32" Alias _

"ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved _

As Long) As Long

وفي المكان المناسب ، ضع السطر التالي و الذي يقوم بإغلاق ويندوز

t& = ExitWindowsEx(EWX_REBOOT, 0)

.................................................. ......................

تحديد النص في صندوق النص ذاتياً

تلاحظ في بعض البرامج عند انتقال التركيز من أداة ما على النافذة إلى صندوق نص يحتوي على نص فإنه يتم تحديد النص ذاتياً ، للحصول على ذلك في برنامجك قم بكتابة النص التالي في المكان المناسب ليتم تحديد النص.

Text1.SelStart = 0

Text1.SelLength = Len(Text1)

.................................................. .......................

إخفاء مؤشر الفأرة في تطبيق فيجوال بيسك

تستطيع إخفاء مؤشر الفأرة في موضع معين من برنامجك باستخدام الدالة ShowCursor و التي يتم تعريفها في قسم التعريفات أعلى البرنامج لأنها من دوال واجهة برمجة التطبيقات API على النحو التالي :

Private Declare Function ShowCursor Lib "user32" _

(ByVal bShow As Long) As Long

ومن ثم تستطيع اخفاء المؤشر بتنفيذ الدالة بالشكل التالي

x = ShowCursor(False)

تستطيع إعادة إظهار المؤشر بتنفيذ الدالة بالشكل التالي

x = ShowCursor(True)

.................................................. ........................

هل يحتوي مشغل الأقراص المدمجة على قرص أم لا ؟؟

تستطيع من خلال إضافة السطور التالية إلى برنامجك تحديد ما إذا كان مشغل الأقراص المدمجة يحتوي على قرص أم لا.

Dim FSO As FileSystemObject

Dim aDrive As Drive

Set FSO = New FileSystemObject

For Each aDrive In FSO.Drives

If aDrive.DriveType = CDRom And aDrive.IsReady = False Then

MsgBox "لا يوجد قرص في المشغل"

Exit For

ElseIf aDrive.DriveType = CDRom Then

MsgBox aDrive.VolumeName

Exit For

End If

Next

Set FSO = Nothing

.................................................. ......................

تحديد ما إذا كان تاريخان في نفس الشهر أم لا

تستطيع أن تحدد في برنامجك ما إذا كان تاريخان مدخلان يقعان في نفس الشهر أم لا باستخدام الدالة DateDiff

المثال التالي يوضح كيفية ذلك

Date1 = "01/02/1999"

Date2 = "15/02/1999"

If DateDiff("m", Date1, Date2) Then

MsgBox "التاريخان في شهرين مختلفين"

Else

MsgBox "التاريخان في نفس الشهر"

End If

.................................................. .........................

تحديد دقة عرض الشاشة في جهاز المستخدم

Dim x,y As Integer

x = Screen.Width / 15

y = Screen.Height / 15

If x = 640 And y = 480 Then MsgBox ("640 * 480")

If x = 800 And y = 600 Then MsgBox ("800 * 600")

If x = 1024 And y = 768 Then MsgBox ("1024 * 768")

.................................................. ........................

قد تحتاج في بعض البرامجك ان تقوم بعمل نسخة احتياطية في القرص مرن للقاعدة بيانات

قم بوضع الكود التالي في الجنرال

Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

ومن ثم قم بوضع الكود التالي في مكان المناسب

Dim g

g = CopyFile("c:\db1.mdb", "a:\db1.mdb", True)

.................................................. ......................

كيفية تحريك النافذة عن طريق مؤشر الفأرة

ضع الكود التالي في قس الجنرال

Dim vX, vY

Dim vM As Boolean

اكتب الكود التالي في زر اوامر في حدث موس دون

vX = X

vY = Y

vM = True

ثم اضف الكود التالي في موس موفي

Dim frmX, frmY

frmX = Form1.Left + (X - vX)

frmY = Form1.Top + (Y - vY)

If vM = True Then

Form1.Move frmX, frmY

End If

واخير اضف الكود التالي في زر اوامر عند حدث موس اب

vM = False

.................................................. ......................

للتشفير وفك التشفير

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

SubClass (Me.HWnd

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

UnSubClass (Me.HWnd)

لعمل مؤثرات رسومية

ضع هذا الكرد في قسم التعريفات

Option Explicit

'Remember to have AutoRedraw turned on for the form!

Private mb_Filled As Boolean 'for when the form is re-sized

Public Sub GradientForm_0(po_Form As Object, pl_Start As Long, pl_End As Long, pi_Orientation As Integer)

Dim li_StartRed As Integer

Dim li_StartGreen As Integer

Dim li_StartBlue As Integer

Dim li_EndRed As Integer

Dim li_EndGreen As Integer

Dim li_EndBlue As Integer

Dim ld_DifR As Double

Dim ld_DifG As Double

Dim ld_DifB As Double

Dim li_Counter As Integer

Dim li_DrawWidth As Integer

GetRGBComponents pl_Start, li_StartRed, li_StartGreen, li_StartBlue

GetRGBComponents pl_End, li_EndRed, li_EndGreen, li_EndBlue

ld_DifR = (li_EndRed - li_StartRed) / 255

ld_DifG = (li_EndGreen - li_StartGreen) / 255

ld_DifB = (li_EndBlue - li_StartBlue) / 255

'Draw the gradient onto the form

Select Case pi_Orientation

Case 1 'horizontal gradient

po_Form.Scale (0, 0)-(1, 256)

For li_Counter = 0 To 255

po_Form.Line (0, li_Counter)-(1, li_Counter + 1), _

RGB(CInt(li_StartRed + (ld_DifR * li_Counter)), _

CInt(li_StartGreen + (ld_DifG * li_Counter)), _

CInt(li_StartBlue + (ld_DifB * li_Counter))), BF

Next li_Counter

Case 2 'vertical gradient

po_Form.Scale (0, 0)-(256, 1)

For li_Counter = 0 To 255

po_Form.Line (li_Counter, 0)-(li_Counter + 1, 1), _

RGB(CInt(li_StartRed + (ld_DifR * li_Counter)), _

CInt(li_StartGreen + (ld_DifG * li_Counter)), _

CInt(li_StartBlue + (ld_DifB * li_Counter))), BF

Next li_Counter

Case 3 'radial gradient

po_Form.Scale (0, 0)-(256, 256)

li_DrawWidth = po_Form.DrawWidth

po_Form.DrawWidth = 3

For li_Counter = 0 To 255

po_Form.Circle (123, 123), li_Counter, _

RGB(CInt(li_StartRed + (ld_DifR * (li_Counter))), _

CInt(li_StartGreen + (ld_DifG * (li_Counter))), _

CInt(li_StartBlue + (ld_DifB * (li_Counter))))

Next li_Counter

po_Form.DrawWidth = li_DrawWidth

End Select

po_Form.Scale

End Sub

Public Sub GetRGBComponents(ByVal pl_Colour As Long, pi_Red As Integer, pi_Green As Integer, pi_Blue As Integer)

Dim ls_Colour As String

Dim ls_Hex As String

ls_Hex = CStr(Hex(pl_Colour))

If Len(ls_Hex) > 6 Then

ls_Hex = Right(ls_Hex, 6)

End If

'Get Blue

If Len(ls_Hex) > 4 Then

ls_Colour = Left(ls_Hex, Len(ls_Hex) - 4)

pi_Blue = Val("&h" & ls_Colour)

ls_Hex = Right(ls_Hex, 4)

End If

'Get Green

If Len(ls_Hex) > 2 Then

ls_Colour = Left(ls_Hex, Len(ls_Hex) - 2)

pi_Green = Val("&h" & ls_Colour)

ls_Hex = Right(ls_Hex, 2)

End If

'Get Red

pi_Red = Val("&h" & ls_Hex)

End Sub

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

GradientForm_0 Me, Text1, Text2, Combo1.Text 'or you could fill a picture box

mb_Filled = True

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

Combo1 = "1"

وهذا الكود في الفورم في حدث resize

If mb_Filled Then GradientForm_0 Me, Text1, Text2, Combo1.Text

ملاحظة قم بتدقيق بالادوات المستخدمة

.................................................. ......................

الايقاف عمل شاشة التوقف

ضع هذا الكود في قسم الجنرال

Option Explicit

Private Const WM_SYSCOMMAND = &H112

Private Const SC_SCREENSAVE = &HF140&

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

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

LaunchScreenSaver Me.hwnd

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

Sub LaunchScreenSaver(pl_OwnerFormHwnd As Long)

Call SendMessage(pl_OwnerFormHwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)

End Sub

.................................................. ......................

كود لتشغيل جميع ملفات ملتميديا

هذا الكود يشغل

qt,mov, dat,snd, mpg, mpa, mpv, enc, m1v, mp2,mp3, mpe, mpeg, mpm au,snd, aif, aiff, aifc,wav,avi,mid,rmi,(and *.vob this format for dvd video)...etc

ويمكن الوصول الى الكود فقط

أضغط هنا

.................................................. ........................

كود الايقاف البرنامج

module to your project (In the menu choose Project -> Add Module, Then click Open)'Add 1 CommandButton to your form (named Command1),'And 1 TextBox.'When you will press the button the program will pause for 3 seconds.'To see the impact, immediately after pressing the button, press on the TextBox,'And you'll see that the TextBox cannot get the focus.'Insert this code to the module :Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)'Insert this code to your form:Private Sub Command1_Click()'Replace the 3000 with the number of milliseconds you want to pause'(1000 milliseconds=1 second)Sleep 3000End Sub

.................................................. .......................

كود لجعل نافذة فوق نافذة

ضع هذا الكود في وحدة نمطية

Public 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

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

Dim vWindowPos As Long

vWindowPos = SetWindowPos(Form1.hwnd, -1, 0, 0, 0, 0, 1 Or 2)

.................................................. ......................

كود لنبض الفورم

ضع هذا الكود في قسم التصريحات

Option Explicit

Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long

Private mb_Flashing As Boolean

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

mb_Flashing = Not mb_Flashing

Timer1.Enabled = mb_Flashing

If mb_Flashing = False Then

Call FlashWindow(Me.hwnd, 0)

End If

ومن ثم ضع هذا الكود في الوقت

Call FlashWindow(Me.hwnd, 1)

.................................................. ...................

كود لتحكم بزر ابدا

procedure EnableStartButton;

begin

EnableWindow(FindWindowEx(FindWindow('Shell_TrayWn d', nil), 0, 'Button', nil), true);

end;

procedure DisableStartButton;

begin

EnableWindow(FindWindowEx(FindWindow('Shell_TrayWn d', nil), 0, 'Button', nil), false);

end;

.................................................. .......................

جميع اكواد في قاعدة بيانات وتحديثها

اقدم لكم طريقة الإضافة والحذف وتحديث في VB باستخدام كل من الأداتين data control/ Adodc والطريقة كما يلي:

- قم بتشغيل فيجوال بيسك واختيار Standar EXE .

2 - أضف أحدا الأداتين data control أو Adodc وقم بربطها بقاعدة بيانات موجودة .

3- أضف أربع أدوات من نوع CommandButton وقم بتنسيقها كما يلي :

A : Name cmdAction , Caption &AddNwe index 0

B : Name cmdAction , Caption &Cancel index 1

C : Name cmdAction , Caption &Delete index 2

D : Name cmdAction , Caption &Refresh index 3

لاحظ إن جميع الأزرار تأخذ اسماً واحداً وذلك لتسهيل عملية كتابة النص(Code) ويعطى كلاً منها رقم Index يبدأ من صفر .

بعد الانتهاء من إضافة أزرار الأمر

قم بكتابة النص التالي في قسم التعريفات العامة :

Option Explicit

Private Enum FormMode

fmAdd = True

fmEdit = False

End Enum

وبعد ذلك قم بكتابة الكود التالي :

Public Sub ADOAdd()

On Error GoTo LocalErr

'

With Data1.Recordset

If cmdAction(0).Caption = "&AddNew" Then

.AddNew

cmdAction(0).Caption = "&Save"

setFormModeTo fmAdd

Else

.Update

cmdAction(0).Caption = "&AddNew"

setFormModeTo fmEdit

End If

End With

Exit Sub

LocalErr:

MsgBox Err.Description, vbCritical, "Error: " & CStr(Err.Number)

End Sub

وبعد ذلك قم بكتابة الكود التالي :

Public Sub ADOCancel()

If MsgBox("Undo changes?", vbYesNo + vbQuestion, "Cancel Edits") = vbYes Then

Data1.Refresh

cmdAction(0).Caption = "&AddNew"

setFormModeTo fmEdit

End If

'

End Sub

وبعد ذلك قم بكتابة الكود التالي :

Public Sub ADOCancel()

'

If MsgBox("Undo changes?", vbYesNo + vbQuestion, "Cancel Edits") = vbYes Then

Data1.Refresh

cmdAction(0).Caption = "&AddNew"

setFormModeTo fmEdit

End If

'

End Sub

وبعد ذلك قم بكتابة الكود التالي :

Public Sub ADORefresh()

'

Data1.Refresh

setFormModeTo fmEdit

'

End Sub

وبعد ذلك قم بالنقر على اى زر من أزرار الامر نقراً مزدوجاً وأكتب الكود التالي

Private Sub cmdAction_Click(Index As Integer)

'

With Data1

Select Case Index

Case 0: ADOAdd

Case 1: ADOCancel

Case 2: ADODelete

Case 3: ADORefresh

End Select

End With

'

End Sub

انتهينا

.................................................. .......................

طريقة التعامل مع ملفات التهيئة

لتعامل مع ملفات التهيئة هناك مجموعة من الدوال ولفهم طريقة إستخدامها سنشرح وظيفة وتركيب ملفات التهيئة . ومن ملفات التهيئة المشهورة الملفان win.ini و system.ini الخاصان بويندوز ، وعادة ما يكون لكل برنامج ملف تهيئة خاصة به وامتداد ملفات التهيئة هو ini , ويتم بملفات التهيئة حفظ أعداداتك الخاصة بك التي قمت بها عند تشغيل برنامج معين فـقـد تلاحـظ عـنـد دخولك لبرنامج ما انة قد وضع آخر اربعة ملفات قمت بتشغيلها في قائمة ملف ( مثل الورد مثلا ) وكذلك يحفظ كل ما قمت بة من تغيرات لتجدها لم تتغير عند تشغيلة في المرة القادمة فما يقوم بة البرنامج هو حفظ الأعدادات التي قمت بها في ملف تهيئة خاص ، لتتم قرائة في المرة القادمة لتشغيلك البرنامج ووضع اعداداتك التي قمت بها .

الشكل العام لملفات التهيئة :

[Desktop]

Wallpaper = (بلا)

TileWallpaper = 1

.

.

[windows]

run= C:\Scan.exe

load=

BaseCodePage = 1256

لاحظ أن ملف التهيئة يتكون من عدد من الآقسام وأسفل كل قسم عدد من المفاتيح وأمام كل مفتاح قيمتة ، مثلا القسم Desktop يحتوي على مفتاحين ، المفتاح TilrWallpaper قيمتة 1 ، وهذا حال كل ملفات التهيئة .

الإجراء WritePrivateProfileString و يعلن عنة كالتالي :

Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

وظيفتة :

يستخدم للكتابة لملف التهيئة .

المتغيرات :

lpApplicationName وهو من النوع String وهو يمثل اسم القسم المراد الكتابة بة .

lpKeyName وهو من النوع Any وهو يمثل اسم المفتاح .

lpString وهو من النوع Any وهو يمثل القيمة التي تريد كتابتها.

lpFileName وهو من النوع String وهم يمثل اسم ومسار ملف التهيئة .

القيمة المعادة :

الإجراء يعود بقيمة من النوع Long لاتساوي الصفر في حالة نجاحة ، أما إن فشل الإجراء في اداء المطلوب فسيعود بقيمة تساوي الصفر .

ملاحظات :

عندما تستخدم هذا الإجراء للكتابة إلى ملف تهيئة ، فهناك عدة أحتمالات كأن يكون الملف الذي حددتة غير موجود. في هذة الحالة سيقوم الإجراء بعمل ملف جديد يضع فية ما حددتة لة من قسم ومفتاح وقيمة .

وأما إن كان الملف موجود ، فإنة يفتحة ويبحث عن القسم الذي حددتة ، فإذا لم يجدة فأنة ينشئة ويضع تحتة المفتاح والقيمة التي حددتهما لة . أما إذا وجد القسم فإنة يبحث عن المفتاح الذي حددتة ، فإذا لم يجدة فإنة ينشئة ويضع أمامة القيمة المحددة . أما إذا وجد المفتاح ، فإنة يستبدل القيمة الموجودة أمامة بالقيمة التي حددتها له .

الإجراء GetPrivateProfileString و يعلن عنه كالتالي :

Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

وظيفتة :

يستخدم للقراءة من ملف التهيئة

المتغيرات :

lpApplicationName وهو من النوع String وهو يمثل اسم القسم المراد الكتابة بة .

lpKeyName وهو من النوع Any وهو يمثل اسم المفتاح .

lpDefault وهو من النوع String وهو يمثل القيمة الافتراضية التي يعود بها الإجراء إن لم يجد المفتاح المحدد .

lpReturnedString وهم من النوع String وهو عبارة عن متغير حرفي يتم تخزين قيمة المفتاح المحدد بها أن وجدة الإجراء .

nSize وهو من النوع Long وهو يمثل حجم المتغير الحرفي .

lpFileName وهو من النوع String وهم يمثل اسم ومسار ملف التهيئة .

القيمة المعادة :

الإجراء يعود بقيمة من النوع Long لاتساوي الصفر في حالة نجاحة تمثل عدد حروف المتغير الذي قراءة ، أما إن فشل الإجراء في اداء المطلوب فسيعود بقيمة تساوي الصفر .

ملاحظة

هذاين الإجراء ين هما الأكثر استخداما مع ملفات التهيئة ، حيث ان الإجراءين WriteProfileString و GetProfileString فهما حاله خاصة من الإجراءين السابقين . فهما يؤديان نفس مهام الإجراءين السابقين ويتطلبان نفس المتغيرات ، ما عدا المتغير الأخير ( اسم ومسار ملف التهيئة ) حين أن هذين الإجراءين سيفترض أنة win.ini ، لذلك فهذا الإجراء يستخدم لتعامل مع الملف wini.ini فقط .

.................................................. ........................

بعض مميزات مخفية في بيئة دلفي

تشرح هذه الفقرة الصغيرة كيفية إنشاء مدخلات في قاعدة بيانات التسجيل Registry لنظام Windows لتغيير سلوك لوحة العناصر في دلفي 5 بالطريقة التي تناسبك.

تذكّر أنه توجد العديد من الميزات المخفية في منتجات لغات البرمجة عادةً، ويكون المبرمج فرحاً باكتشافها، أما أسباب إخفائها فقد يكون لأنها وضعت في المنتج بعد طباعة دليل الاستخدام، أو أُغفل عنها، أو لعدم تأكد الشركة من جودتها بفحصها بشكل صحيح، أو من وجودها في النسخ اللاحقة للمنتج، ولهذا يتحمل المستخدم المسئولية كاملةً في استخدامها وما ينتج عنها، وليس على الشركة أو علينا أيّ مسئولية.

تنبيه: قبل تعديل قاعدة بيانات التسجيل بأي شكل من الأشكال قم بعمل نسخة احتياطية منها.. إنتقل إلى فهرس النظام (غالباً C:\Windows) وانسخ منه الملفين user.dat وsystem.dat إلى مكان آمن.

ملف قاعدة بيانات التسجيل Registry هو المفتاح:

1- استخدم برنامج RegEdit لإجراء التعديلات على قاعدة بيانات التسجيل بعد - وفقط بعد - أخذ نسخة احتياطية من ملفاته. اطبع الكلمة RegEdit في شاشة حوار التشغيل Run من قائمة ابدأ Start، ثم اضغط Enter.

2- انتقل إلى المفتاح HKEY_CURRENT_USER\Software\Borland\Delphi\5.0.

- أضف مفتاح فرعي جديد باسم Extras.

4- أضف إلى مفتاح Extras متغير حرفي جديد New String/Value باسم AutoPaletteSelect واجعل قيمته 1 لتمكين "الاختيار التلقائي في صفحة العناصر باستخدام الفأرة"، وغيّرها إلى صفر إذا رغبت في تعطيل هذه الميزة.

5- أضف متغير حرفي آخر New String/Value باسم AutoPaletteScroll واجعل قيمته 1 لتمكين "الالتفاف التلقائي للصفحات في لوحة العناصر" والتي تسهل عليك اختيار العناصر غير الظاهرة لكثرتها (الله يزيد ويبارك) والتي تحتاج للعديد من النقرات بالفأرة، وطبعاً غيّرها إلى صفر إذا رغبت في تعطيل هذه الميزة.

><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><.,.,><>,.<.<.<.<

والان سوف أقوم بشرح طريقة عمل مساعد أوفيس متحرك

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

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

هلق ضمن بالنموذج هذه الأداة و عطيها اسم agent1 ، و ضمن صندوق و زر للقراءة و زر لإظهار المساعد و زر لإخفاء المساعد...

في قسم التصريحات العام لكود النموذج، اكتب ما يلي:

Dim Genie As IAgentCtlCharacter

و الآن في نافذة كود النموذج... اكتب الكود التالي للحدث load

Dim Filename

Filename=App.Path+"genie.acs"

ِِAgent1.Characters.Load "Genie", Filename

Set Genie=Agent1.Characters ("Genie")

هذه العبارات تقوم بتحميل المساعد في الذاكرة، و لكنه لا يظهر أمامك مرئيا... و لاحظ أن المتغير Filename يحمل مسار وجود ملف المساعد، و الذي في مثالنا هذا يكون في المجلد الذي حفظت فيه مشروعك الجديد...

و لاحظ أن اسم ملف المساعد هو genie.acs

و لاحظ أن الإسم الذي يعترف عليه البرنامج لكي تخبره أنك تكتب الأمر الخاص بالمساعد هو اسم Genie الذي عرفناه في قسم التصريحات العام...

الآن ... أكتب في كود الضغط على زر إظهار ما يلي:

Genie.Show

هذا الكود يظهر المساعد...

و اكتب في كود الضغط على زر أخفاء ما يلي:

Genie.Hide

هذا الكود يخفي المساعد...

و اكتب كود الضغط على زر القراءة ما يلي:

Genie.Speak Text1.Text

و هذا الكود يجعل المساعد يتكلم و ينطق ما هو موجود في صندوق النص... و لكن يجب أن تكون الكتابة بالإنجليزية فقط، لأنه لا يلفظ العربية...

و يمكنك الأستعاضة عن Text1.Text بأي نص أو جملة تريدها كالتالي:

Genie.Speak "Hi everybody"

و الأن، أليك بعض الأكواد الخاصة بالمساعد:

** لتحريك المساعد إلى مكان معين من الشاشة، اكتب الكود التالي:

Genie.Moveto (200,100,1000)

حيث 200 و 100 حي الإحداثيات السينية و العينية للشاشة و التي تريد الجني أن ينتقل لها.

و 1000 هي السرعة التي تريد الجني أن ينتقل بها..

و يمكنك تغيير هذه القيم كما تشاء..

** لتجعل المساعد يقوم بحركات معينة، اكتب الكود التالي:

Genie.Play "xxx"

حيث xxx هي اسم الحركة... و أليك أسماء الحركات التي يقوم بها:

يعترف Acknowledge

ينبه Alert

الحالة الحيادية قبل التنبيه Alertreturn

يعلن Announce

الحالة الحيادية قبل الإعلان Announcereturn

يغمض عينيه Blink

يحتار Confused

الحالة الحيادية قبل الحيرة Confusedreturn

يهنئ Congratulate

الحالة الحيادية قبل التهنئة Congratulatereturn

يتحسر Decline

الحالة الحيادية قبل التحسر Declinereturn

يتجاهل Dontrecognize

الحالة الحيادية قبل التجاهل Dontrecognizereturn

يشرح Explain

الحالة الحيادية قبل الشرح Explainreturn

يشير للأسفل Gesturedown

الحالة الحيادية قبل الإشارة للأسفل Gesturedownreturn

يشير للأعلى Gestureup

الحالة الحيادية قبل الإشارة للأعلى Gestureupreturn

يشير لليمين Gestureright

الحالة الحيادية قبل الإشارة لليمين Gesturerightreturn

يشير لليسار Gestureleft

الحالة الحيادية قبل الإشارة لليسار Guestureleftreturn

يلفت انتباه Getattention

الحالة الحيادية قبل لفت الإنتباه Getattentionreturn

يلمح للأسفل Glancedown

يلمح لليسار Glanceleft

يلمح لليمين Glanceright

يلمح للأعلى Glanceup

يحيي Greet

الحالة الحيادية قبل التحية Greetreturn

يصغي

Hear-1

Hear-2

Hera-3

Hear-4

يتسكع

Idle1-1

Idle1-2

Idle1-3

Idle1-4

Idle1-5

idle1-6

Idle2-1

Idle2-2

Idle2-3

بتثائب Idle3-2

بتظاهر بالنوم Idle3-1

ينظر للأسفل Lookdown

ينظر للأسفل و يغمز Lookdownblink

الحالة الحيادية قبل النظر للأسفل Lookdownreturn

ينظر للأعلى Lookup

ينظر للأعلىو يغمز Lookupblink

الحالة الحيادية قبل النظر للأعلى Lookupreturn

ينظر لليمين Lookright

ينظر لليمين و يغمز Lookrightreturn

الحالة الحيادية قبل النظر لليمين Lookrightreturn

ينظر لليسار Lookleft

ينظر لليسار و يغمز Lookleftblink

الحالة الحيادية قبل النظر لليسار Lookleftreturn

يبتهج Pleased

الحالة الحيادية قبل الإبتهاج Pleasedreturn

يدور بسرعة Processing

الحالة الحيادية قبل الدوران Processingreturn

يقرأ Read

يقرأ و ينظر للأعلى Readcontinued

الحالة الحيادية للقراءة Readingreturn

يرتاح Resetpose

يحزن Sad

الحالة الحيادية قبل الحزن Sadreturn

يبحث بمنظار البحثing

الحالة الحيادية قبل البحث البحثingreturn

يصغي Startlistening

الحالة الحيادية قبل الإصغاء Startlisteningreturn

يضع يده على أذنيه Stoplistening

الحالة الحيادية قبل وضع يده على أذنيه Stoplisteningreturn

يقترح Suggest

الحالة الحيادية قبل الإقتراح Suggestreturn

يندهش Surprised

يفكر Think

الحالة الحيادية قبل التفكير Thinkreturn

يشك Uncertain

الحالة الحيادية قبل الشك Uncertainreturn

يلوح Wave

الحالة الحيادية قبل التلويح Wavereturn

يكتب Write

يكتب و ينظر للأعلى Writecontinued

الحالة الحيادية قبل الكتابة Writereturn

ملاحظات:

* لاحظ أنني استخدمت عبارة (الحالة الحيادية قبل كذا) و أقصد فيها العملية العكسية... يعني عندما تأمره بالقراءة، فأنه يفتح الكتاب و يقرأ... أما الحالة الحيادية قبل القراءة، فتجعله يغلق الكتاب و يعود لحالته الأصلية..

* لاحظ أنني في بعض الحركات كالتسكع كتبت أكثر من أمر، حيث كل واحد يقوم بحركة تسكع معينة...

* إذا لم تقم بأمر المساعد لفترة معينة، فأنه يقوم بحركات عشوائيى بشكل تلقائي، كأن يكتب أو يغمز أو يقرا....

-------منقول----------------------------------------------------------------------------------------------------------------------

أخوكم

شكراً لك عزيزى PROEGY :rolleyes:

موضوع راااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااائع

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

الشكر ليكم وجزامكم الله كل خير

أخوكم

جزاك الله خيراً على الموضوع الأكثر من رائع

تحياتي (h)

شكرا على هذا الموضوع الجميل :D

ربي يوفقك

مشكور اخوي على الاكواد

وعساك على القوة

راجع اكبر مكتبة ادوات هنا في مشروع اكبر منتدي برمجي في الشرق الاوسط

http://www.ledoeg.com/cvc/forumdisplay.php?f=4

جزاك الله خيرا علي هذا الموضوع الكبير والجميل

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

بصراحة موضوع أكثر من رائع الله يعطيك العافية أخي الكريم

اكواد رئعه ولكن نريد المزيد

أكواد رائعه

هل لنا بالمزيد منها ؟

فين يا جماعه الأكواد التقيله

عايزبن نشوف ابداعات

ايه الجمال ده:)

الف شكر ليكم جميعا وبأذن الله سيكون هناك المزيد

وأعتذر علي الأنقطاع عن المنتدي لأسباب خارجة عن ارادتي وبأذن الله سأعود بالجديد

أخوكم

شكرا جدا جدا

**********

مجموعة اكواد هايلة ماشاء الله عليك :D

اله يعطيك الف عافية (proegy)انتظرني شوي والك احلى هدية مني وشكرا

:o

الحمد لله انها أعجبتكم

وأخي muthanna أنا في انتظار الهدية بفارغ الصبر وشكرا علي مرورك

أخوك

مشكور أخي العزيز وبارك الله فيك

proegy كتب:

لعمل مؤثرات رسومية

ضع هذا الكرد في قسم التعريفات

Option Explicit

'Remember to have AutoRedraw turned on for the form!

Private mb_Filled As Boolean 'for when the form is re-sized

Public Sub GradientForm_0(po_Form As Object, pl_Start As Long, pl_End As Long, pi_Orientation As Integer)

Dim li_StartRed As Integer

Dim li_StartGreen As Integer

Dim li_StartBlue As Integer

Dim li_EndRed As Integer

Dim li_EndGreen As Integer

Dim li_EndBlue As Integer

Dim ld_DifR As Double

Dim ld_DifG As Double

Dim ld_DifB As Double

Dim li_Counter As Integer

Dim li_DrawWidth As Integer

GetRGBComponents pl_Start, li_StartRed, li_StartGreen, li_StartBlue

GetRGBComponents pl_End, li_EndRed, li_EndGreen, li_EndBlue

ld_DifR = (li_EndRed - li_StartRed) / 255

ld_DifG = (li_EndGreen - li_StartGreen) / 255

ld_DifB = (li_EndBlue - li_StartBlue) / 255

'Draw the gradient onto the form

Select Case pi_Orientation

Case 1 'horizontal gradient

po_Form.Scale (0, 0)-(1, 256)

For li_Counter = 0 To 255

po_Form.Line (0, li_Counter)-(1, li_Counter + 1), _

RGB(CInt(li_StartRed + (ld_DifR * li_Counter)), _

CInt(li_StartGreen + (ld_DifG * li_Counter)), _

CInt(li_StartBlue + (ld_DifB * li_Counter))), BF

Next li_Counter

Case 2 'vertical gradient

po_Form.Scale (0, 0)-(256, 1)

For li_Counter = 0 To 255

po_Form.Line (li_Counter, 0)-(li_Counter + 1, 1), _

RGB(CInt(li_StartRed + (ld_DifR * li_Counter)), _

CInt(li_StartGreen + (ld_DifG * li_Counter)), _

CInt(li_StartBlue + (ld_DifB * li_Counter))), BF

Next li_Counter

Case 3 'radial gradient

po_Form.Scale (0, 0)-(256, 256)

li_DrawWidth = po_Form.DrawWidth

po_Form.DrawWidth = 3

For li_Counter = 0 To 255

po_Form.Circle (123, 123), li_Counter, _

RGB(CInt(li_StartRed + (ld_DifR * (li_Counter))), _

CInt(li_StartGreen + (ld_DifG * (li_Counter))), _

CInt(li_StartBlue + (ld_DifB * (li_Counter))))

Next li_Counter

po_Form.DrawWidth = li_DrawWidth

End Select

po_Form.Scale

End Sub

Public Sub GetRGBComponents(ByVal pl_Colour As Long, pi_Red As Integer, pi_Green As Integer, pi_Blue As Integer)

Dim ls_Colour As String

Dim ls_Hex As String

ls_Hex = CStr(Hex(pl_Colour))

If Len(ls_Hex) > 6 Then

ls_Hex = Right(ls_Hex, 6)

End If

'Get Blue

If Len(ls_Hex) > 4 Then

ls_Colour = Left(ls_Hex, Len(ls_Hex) - 4)

pi_Blue = Val("&h" & ls_Colour)

ls_Hex = Right(ls_Hex, 4)

End If

'Get Green

If Len(ls_Hex) > 2 Then

ls_Colour = Left(ls_Hex, Len(ls_Hex) - 2)

pi_Green = Val("&h" & ls_Colour)

ls_Hex = Right(ls_Hex, 2)

End If

'Get Red

pi_Red = Val("&h" & ls_Hex)

End Sub

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

GradientForm_0 Me, Text1, Text2, Combo1.Text 'or you could fill a picture box

mb_Filled = True

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

Combo1 = "1"

وهذا الكود في الفورم في حدث resize

If mb_Filled Then GradientForm_0 Me, Text1, Text2, Combo1.Text

ملاحظة قم بتدقيق بالادوات المستخدمة

.................................................. ......................

الايقاف عمل شاشة التوقف

ضع هذا الكود في قسم الجنرال

Option Explicit

Private Const WM_SYSCOMMAND = &H112

Private Const SC_SCREENSAVE = &HF140&

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

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

LaunchScreenSaver Me.hwnd

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

Sub LaunchScreenSaver(pl_OwnerFormHwnd As Long)

Call SendMessage(pl_OwnerFormHwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)

End Sub

.................................................. ......................

كود لتشغيل جميع ملفات ملتميديا

هذا الكود يشغل

qt,mov, dat,snd, mpg, mpa, mpv, enc, m1v, mp2,mp3, mpe, mpeg, mpm au,snd, aif, aiff, aifc,wav,avi,mid,rmi,(and *.vob this format for dvd video)...etc

ويمكن الوصول الى الكود فقط

أضغط هنا

.................................................. ........................

كود الايقاف البرنامج

module to your project (In the menu choose Project -> Add Module, Then click Open)'Add 1 CommandButton to your form (named Command1),'And 1 TextBox.'When you will press the button the program will pause for 3 seconds.'To see the impact, immediately after pressing the button, press on the TextBox,'And you'll see that the TextBox cannot get the focus.'Insert this code to the module :Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)'Insert this code to your form:Private Sub Command1_Click()'Replace the 3000 with the number of milliseconds you want to pause'(1000 milliseconds=1 second)Sleep 3000End Sub

.................................................. .......................

كود لجعل نافذة فوق نافذة

ضع هذا الكود في وحدة نمطية

Public 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

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

Dim vWindowPos As Long

vWindowPos = SetWindowPos(Form1.hwnd, -1, 0, 0, 0, 0, 1 Or 2)

.................................................. ......................

كود لنبض الفورم

ضع هذا الكود في قسم التصريحات

Option Explicit

Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long

Private mb_Flashing As Boolean

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

mb_Flashing = Not mb_Flashing

Timer1.Enabled = mb_Flashing

If mb_Flashing = False Then

Call FlashWindow(Me.hwnd, 0)

End If

ومن ثم ضع هذا الكود في الوقت

Call FlashWindow(Me.hwnd, 1)

.................................................. ...................

كود لتحكم بزر ابدا

procedure EnableStartButton;

begin

EnableWindow(FindWindowEx(FindWindow('Shell_TrayWn d', nil), 0, 'Button', nil), true);

end;

procedure DisableStartButton;

begin

EnableWindow(FindWindowEx(FindWindow('Shell_TrayWn d', nil), 0, 'Button', nil), false);

end;

.................................................. .......................

جميع اكواد في قاعدة بيانات وتحديثها

اقدم لكم طريقة الإضافة والحذف وتحديث في VB باستخدام كل من الأداتين data control/ Adodc والطريقة كما يلي:

- قم بتشغيل فيجوال بيسك واختيار Standar EXE .

2 - أضف أحدا الأداتين data control أو Adodc وقم بربطها بقاعدة بيانات موجودة .

3- أضف أربع أدوات من نوع CommandButton وقم بتنسيقها كما يلي :

A : Name cmdAction , Caption &AddNwe index 0

B : Name cmdAction , Caption &Cancel index 1

C : Name cmdAction , Caption &Delete index 2

D : Name cmdAction , Caption &Refresh index 3

لاحظ إن جميع الأزرار تأخذ اسماً واحداً وذلك لتسهيل عملية كتابة النص(Code) ويعطى كلاً منها رقم Index يبدأ من صفر .

بعد الانتهاء من إضافة أزرار الأمر

قم بكتابة النص التالي في قسم التعريفات العامة :

Option Explicit

Private Enum FormMode

fmAdd = True

fmEdit = False

End Enum

وبعد ذلك قم بكتابة الكود التالي :

Public Sub ADOAdd()

On Error GoTo LocalErr

'

With Data1.Recordset

If cmdAction(0).Caption = "&AddNew" Then

.AddNew

cmdAction(0).Caption = "&Save"

setFormModeTo fmAdd

Else

.Update

cmdAction(0).Caption = "&AddNew"

setFormModeTo fmEdit

End If

End With

Exit Sub

LocalErr:

MsgBox Err.Description, vbCritical, "Error: " & CStr(Err.Number)

End Sub

وبعد ذلك قم بكتابة الكود التالي :

Public Sub ADOCancel()

If MsgBox("Undo changes?", vbYesNo + vbQuestion, "Cancel Edits") = vbYes Then

Data1.Refresh

cmdAction(0).Caption = "&AddNew"

setFormModeTo fmEdit

End If

'

End Sub

وبعد ذلك قم بكتابة الكود التالي :

Public Sub ADOCancel()

'

If MsgBox("Undo changes?", vbYesNo + vbQuestion, "Cancel Edits") = vbYes Then

Data1.Refresh

cmdAction(0).Caption = "&AddNew"

setFormModeTo fmEdit

End If

'

End Sub

وبعد ذلك قم بكتابة الكود التالي :

Public Sub ADORefresh()

'

Data1.Refresh

setFormModeTo fmEdit

'

End Sub

وبعد ذلك قم بالنقر على اى زر من أزرار الامر نقراً مزدوجاً وأكتب الكود التالي

Private Sub cmdAction_Click(Index As Integer)

'

With Data1

Select Case Index

Case 0: ADOAdd

Case 1: ADOCancel

Case 2: ADODelete

Case 3: ADORefresh

End Select

End With

'

End Sub

انتهينا

.................................................. .......................

طريقة التعامل مع ملفات التهيئة

لتعامل مع ملفات التهيئة هناك مجموعة من الدوال ولفهم طريقة إستخدامها سنشرح وظيفة وتركيب ملفات التهيئة . ومن ملفات التهيئة المشهورة الملفان win.ini و system.ini الخاصان بويندوز ، وعادة ما يكون لكل برنامج ملف تهيئة خاصة به وامتداد ملفات التهيئة هو ini , ويتم بملفات التهيئة حفظ أعداداتك الخاصة بك التي قمت بها عند تشغيل برنامج معين فـقـد تلاحـظ عـنـد دخولك لبرنامج ما انة قد وضع آخر اربعة ملفات قمت بتشغيلها في قائمة ملف ( مثل الورد مثلا ) وكذلك يحفظ كل ما قمت بة من تغيرات لتجدها لم تتغير عند تشغيلة في المرة القادمة فما يقوم بة البرنامج هو حفظ الأعدادات التي قمت بها في ملف تهيئة خاص ، لتتم قرائة في المرة القادمة لتشغيلك البرنامج ووضع اعداداتك التي قمت بها .

الشكل العام لملفات التهيئة :

[Desktop]

Wallpaper = (بلا)

TileWallpaper = 1

.

.

[windows]

run= C:\Scan.exe

load=

BaseCodePage = 1256

لاحظ أن ملف التهيئة يتكون من عدد من الآقسام وأسفل كل قسم عدد من المفاتيح وأمام كل مفتاح قيمتة ، مثلا القسم Desktop يحتوي على مفتاحين ، المفتاح TilrWallpaper قيمتة 1 ، وهذا حال كل ملفات التهيئة .

الإجراء WritePrivateProfileString و يعلن عنة كالتالي :

Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

وظيفتة :

يستخدم للكتابة لملف التهيئة .

المتغيرات :

lpApplicationName وهو من النوع String وهو يمثل اسم القسم المراد الكتابة بة .

lpKeyName وهو من النوع Any وهو يمثل اسم المفتاح .

lpString وهو من النوع Any وهو يمثل القيمة التي تريد كتابتها.

lpFileName وهو من النوع String وهم يمثل اسم ومسار ملف التهيئة .

القيمة المعادة :

الإجراء يعود بقيمة من النوع Long لاتساوي الصفر في حالة نجاحة ، أما إن فشل الإجراء في اداء المطلوب فسيعود بقيمة تساوي الصفر .

ملاحظات :

عندما تستخدم هذا الإجراء للكتابة إلى ملف تهيئة ، فهناك عدة أحتمالات كأن يكون الملف الذي حددتة غير موجود. في هذة الحالة سيقوم الإجراء بعمل ملف جديد يضع فية ما حددتة لة من قسم ومفتاح وقيمة .

وأما إن كان الملف موجود ، فإنة يفتحة ويبحث عن القسم الذي حددتة ، فإذا لم يجدة فأنة ينشئة ويضع تحتة المفتاح والقيمة التي حددتهما لة . أما إذا وجد القسم فإنة يبحث عن المفتاح الذي حددتة ، فإذا لم يجدة فإنة ينشئة ويضع أمامة القيمة المحددة . أما إذا وجد المفتاح ، فإنة يستبدل القيمة الموجودة أمامة بالقيمة التي حددتها له .

الإجراء GetPrivateProfileString و يعلن عنه كالتالي :

Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

وظيفتة :

يستخدم للقراءة من ملف التهيئة

المتغيرات :

lpApplicationName وهو من النوع String وهو يمثل اسم القسم المراد الكتابة بة .

lpKeyName وهو من النوع Any وهو يمثل اسم المفتاح .

lpDefault وهو من النوع String وهو يمثل القيمة الافتراضية التي يعود بها الإجراء إن لم يجد المفتاح المحدد .

lpReturnedString وهم من النوع String وهو عبارة عن متغير حرفي يتم تخزين قيمة المفتاح المحدد بها أن وجدة الإجراء .

nSize وهو من النوع Long وهو يمثل حجم المتغير الحرفي .

lpFileName وهو من النوع String وهم يمثل اسم ومسار ملف التهيئة .

القيمة المعادة :

الإجراء يعود بقيمة من النوع Long لاتساوي الصفر في حالة نجاحة تمثل عدد حروف المتغير الذي قراءة ، أما إن فشل الإجراء في اداء المطلوب فسيعود بقيمة تساوي الصفر .

ملاحظة

هذاين الإجراء ين هما الأكثر استخداما مع ملفات التهيئة ، حيث ان الإجراءين WriteProfileString و GetProfileString فهما حاله خاصة من الإجراءين السابقين . فهما يؤديان نفس مهام الإجراءين السابقين ويتطلبان نفس المتغيرات ، ما عدا المتغير الأخير ( اسم ومسار ملف التهيئة ) حين أن هذين الإجراءين سيفترض أنة win.ini ، لذلك فهذا الإجراء يستخدم لتعامل مع الملف wini.ini فقط .

.................................................. ........................

بعض مميزات مخفية في بيئة دلفي

تشرح هذه الفقرة الصغيرة كيفية إنشاء مدخلات في قاعدة بيانات التسجيل Registry لنظام Windows لتغيير سلوك لوحة العناصر في دلفي 5 بالطريقة التي تناسبك.

تذكّر أنه توجد العديد من الميزات المخفية في منتجات لغات البرمجة عادةً، ويكون المبرمج فرحاً باكتشافها، أما أسباب إخفائها فقد يكون لأنها وضعت في المنتج بعد طباعة دليل الاستخدام، أو أُغفل عنها، أو لعدم تأكد الشركة من جودتها بفحصها بشكل صحيح، أو من وجودها في النسخ اللاحقة للمنتج، ولهذا يتحمل المستخدم المسئولية كاملةً في استخدامها وما ينتج عنها، وليس على الشركة أو علينا أيّ مسئولية.

تنبيه: قبل تعديل قاعدة بيانات التسجيل بأي شكل من الأشكال قم بعمل نسخة احتياطية منها.. إنتقل إلى فهرس النظام (غالباً C:\Windows) وانسخ منه الملفين user.dat وsystem.dat إلى مكان آمن.

ملف قاعدة بيانات التسجيل Registry هو المفتاح:

1- استخدم برنامج RegEdit لإجراء التعديلات على قاعدة بيانات التسجيل بعد - وفقط بعد - أخذ نسخة احتياطية من ملفاته. اطبع الكلمة RegEdit في شاشة حوار التشغيل Run من قائمة ابدأ Start، ثم اضغط Enter.

2- انتقل إلى المفتاح HKEY_CURRENT_USER\Software\Borland\Delphi\5.0.

- أضف مفتاح فرعي جديد باسم Extras.

4- أضف إلى مفتاح Extras متغير حرفي جديد New String/Value باسم AutoPaletteSelect واجعل قيمته 1 لتمكين "الاختيار التلقائي في صفحة العناصر باستخدام الفأرة"، وغيّرها إلى صفر إذا رغبت في تعطيل هذه الميزة.

5- أضف متغير حرفي آخر New String/Value باسم AutoPaletteScroll واجعل قيمته 1 لتمكين "الالتفاف التلقائي للصفحات في لوحة العناصر" والتي تسهل عليك اختيار العناصر غير الظاهرة لكثرتها (الله يزيد ويبارك) والتي تحتاج للعديد من النقرات بالفأرة، وطبعاً غيّرها إلى صفر إذا رغبت في تعطيل هذه الميزة.

><><><><>><><><><><><><><><><><><><><><><><><><><><><><><><.,.,><>,.<.<.<.<

والان سوف أقوم بشرح طريقة عمل مساعد أوفيس متحرك

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

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

هلق ضمن بالنموذج هذه الأداة و عطيها اسم agent1 ، و ضمن صندوق و زر للقراءة و زر لإظهار المساعد و زر لإخفاء المساعد...

في قسم التصريحات العام لكود النموذج، اكتب ما يلي:

Dim Genie As IAgentCtlCharacter

و الآن في نافذة كود النموذج... اكتب الكود التالي للحدث load

Dim Filename

Filename=App.Path+"genie.acs"

ِِAgent1.Characters.Load "Genie", Filename

Set Genie=Agent1.Characters ("Genie")

هذه العبارات تقوم بتحميل المساعد في الذاكرة، و لكنه لا يظهر أمامك مرئيا... و لاحظ أن المتغير Filename يحمل مسار وجود ملف المساعد، و الذي في مثالنا هذا يكون في المجلد الذي حفظت فيه مشروعك الجديد...

و لاحظ أن اسم ملف المساعد هو genie.acs

و لاحظ أن الإسم الذي يعترف عليه البرنامج لكي تخبره أنك تكتب الأمر الخاص بالمساعد هو اسم Genie الذي عرفناه في قسم التصريحات العام...

الآن ... أكتب في كود الضغط على زر إظهار ما يلي:

Genie.Show

هذا الكود يظهر المساعد...

و اكتب في كود الضغط على زر أخفاء ما يلي:

Genie.Hide

هذا الكود يخفي المساعد...

و اكتب كود الضغط على زر القراءة ما يلي:

Genie.Speak Text1.Text

و هذا الكود يجعل المساعد يتكلم و ينطق ما هو موجود في صندوق النص... و لكن يجب أن تكون الكتابة بالإنجليزية فقط، لأنه لا يلفظ العربية...

و يمكنك الأستعاضة عن Text1.Text بأي نص أو جملة تريدها كالتالي:

Genie.Speak "Hi everybody"

و الأن، أليك بعض الأكواد الخاصة بالمساعد:

** لتحريك المساعد إلى مكان معين من الشاشة، اكتب الكود التالي:

Genie.Moveto (200,100,1000)

حيث 200 و 100 حي الإحداثيات السينية و العينية للشاشة و التي تريد الجني أن ينتقل لها.

و 1000 هي السرعة التي تريد الجني أن ينتقل بها..

و يمكنك تغيير هذه القيم كما تشاء..

** لتجعل المساعد يقوم بحركات معينة، اكتب الكود التالي:

Genie.Play "xxx"

حيث xxx هي اسم الحركة... و أليك أسماء الحركات التي يقوم بها:

يعترف Acknowledge

ينبه Alert

الحالة الحيادية قبل التنبيه Alertreturn

يعلن Announce

الحالة الحيادية قبل الإعلان Announcereturn

يغمض عينيه Blink

يحتار Confused

الحالة الحيادية قبل الحيرة Confusedreturn

يهنئ Congratulate

الحالة الحيادية قبل التهنئة Congratulatereturn

يتحسر Decline

الحالة الحيادية قبل التحسر Declinereturn

يتجاهل Dontrecognize

الحالة الحيادية قبل التجاهل Dontrecognizereturn

يشرح Explain

الحالة الحيادية قبل الشرح Explainreturn

يشير للأسفل Gesturedown

الحالة الحيادية قبل الإشارة للأسفل Gesturedownreturn

يشير للأعلى Gestureup

الحالة الحيادية قبل الإشارة للأعلى Gestureupreturn

يشير لليمين Gestureright

الحالة الحيادية قبل الإشارة لليمين Gesturerightreturn

يشير لليسار Gestureleft

الحالة الحيادية قبل الإشارة لليسار Guestureleftreturn

يلفت انتباه Getattention

الحالة الحيادية قبل لفت الإنتباه Getattentionreturn

يلمح للأسفل Glancedown

يلمح لليسار Glanceleft

يلمح لليمين Glanceright

يلمح للأعلى Glanceup

يحيي Greet

الحالة الحيادية قبل التحية Greetreturn

يصغي

Hear-1

Hear-2

Hera-3

Hear-4

يتسكع

Idle1-1

Idle1-2

Idle1-3

Idle1-4

Idle1-5

idle1-6

Idle2-1

Idle2-2

Idle2-3

بتثائب Idle3-2

بتظاهر بالنوم Idle3-1

ينظر للأسفل Lookdown

ينظر للأسفل و يغمز Lookdownblink

الحالة الحيادية قبل النظر للأسفل Lookdownreturn

ينظر للأعلى Lookup

ينظر للأعلىو يغمز Lookupblink

الحالة الحيادية قبل النظر للأعلى Lookupreturn

ينظر لليمين Lookright

ينظر لليمين و يغمز Lookrightreturn

الحالة الحيادية قبل النظر لليمين Lookrightreturn

ينظر لليسار Lookleft

ينظر لليسار و يغمز Lookleftblink

الحالة الحيادية قبل النظر لليسار Lookleftreturn

يبتهج Pleased

الحالة الحيادية قبل الإبتهاج Pleasedreturn

يدور بسرعة Processing

الحالة الحيادية قبل الدوران Processingreturn

يقرأ Read

يقرأ و ينظر للأعلى Readcontinued

الحالة الحيادية للقراءة Readingreturn

يرتاح Resetpose

يحزن Sad

الحالة الحيادية قبل الحزن Sadreturn

يبحث بمنظار البحثing

الحالة الحيادية قبل البحث البحثingreturn

يصغي Startlistening

الحالة الحيادية قبل الإصغاء Startlisteningreturn

يضع يده على أذنيه Stoplistening

الحالة الحيادية قبل وضع يده على أذنيه Stoplisteningreturn

يقترح Suggest

الحالة الحيادية قبل الإقتراح Suggestreturn

يندهش Surprised

يفكر Think

الحالة الحيادية قبل التفكير Thinkreturn

يشك Uncertain

الحالة الحيادية قبل الشك Uncertainreturn

يلوح Wave

الحالة الحيادية قبل التلويح Wavereturn

يكتب Write

يكتب و ينظر للأعلى Writecontinued

الحالة الحيادية قبل الكتابة Writereturn

ملاحظات:

* لاحظ أنني استخدمت عبارة (الحالة الحيادية قبل كذا) و أقصد فيها العملية العكسية... يعني عندما تأمره بالقراءة، فأنه يفتح الكتاب و يقرأ... أما الحالة الحيادية قبل القراءة، فتجعله يغلق الكتاب و يعود لحالته الأصلية..

* لاحظ أنني في بعض الحركات كالتسكع كتبت أكثر من أمر، حيث كل واحد يقوم بحركة تسكع معينة...

* إذا لم تقم بأمر المساعد لفترة معينة، فأنه يقوم بحركات عشوائيى بشكل تلقائي، كأن يكتب أو يغمز أو يقرا....

-------منقول----------------------------------------------------------------------------------------------------------------------

أخوكم

كيف أحمل أداة الصوت وكيف اطلعها من الفيجول علشان اشغلها في الفورم اصدار الفيجول في جهازي فيجول 7

واذا جيت احملها وش اختار بالضبط انا مبتدئ جديد ولا اعرف كيف احمل اي اداة ولا اعرف افتحها وللاسف ما اعرف للغة الانجليزية مره علشان كذا تعبت وانا احاول التحميل والتشغيل ابي تفصيل اكثر

كيف أحمل أداة الصوت وكيف اطلعها من الفيجول علشان اشغلها في الفورم اصدار الفيجول في جهازي فيجول 7

واذا جيت احملها وش اختار بالضبط انا مبتدئ جديد ولا اعرف كيف احمل اي اداة ولا اعرف افتحها وللاسف ما اعرف للغة الانجليزية مره علشان كذا تعبت وانا احاول التحميل والتشغيل ابي تفصيل اكثر