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

لإخفاء برنامجك من قائمة Ctrl+Alt+Del

Private Const RSP_SIMPLE_SERVICE = 1
Private Const RSP_UNREGISTER_SERVICE = 0
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function RegisterServiceProcess Lib "kernel32" _
(ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Sub HideApp(Hide As Boolean)
Dim ProcessID As Long
ProcessID = GetCurrentProcessId()
If Hide Then
retval = RegisterServiceProcess(ProcessID, RSP_SIMPLE_SERVICE)
Else
retval = RegisterServiceProcess(ProcessID, RSP_UNREGISTER_SERVICE)
End If
End Sub
Private Sub Form_Load()
HideApp (True)
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
لإضافة ميزة (تراجع) لصندوق النص استخدم الكود التالي

Private Declare Function SendMessageBynum& Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg _
As Long, ByVal wParam As Long, ByVal lparam As Long)
Private Const EM_UNDO = &HC7&
Private Sub TextUndo(T As TextBox)
SendMessageBynum T.hwnd, EM_UNDO, 0, 0
End Sub
Private Sub Command1_Click()
Call TextUndo(Text1)
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
هل تريد أن تجعل الخلفية مومضة لأداء العنوان

Private Sub Timer1_Timer()
Static A
A = A + 10: If A > 510 Then A = 0
Label1.BackColor = RGB(Abs(A - 256), 0, 0)
'Label1.BackColor = RGB(0, Abs(A - 256), 0)
'Label1.BackColor = RGB(0, 0, Abs(A - 256))
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
تغيير صفحة البدء في الانترنت اكسبلورر

Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" _
Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey _
As String, phkResult 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 REG_SZ = 1
Private Const HKEY_CURRENT_USER = &H80000001
Public Sub SaveString(hKey As Long, Path As String, _
Name As String, Data As String)
Dim KeyHandle As Long
Dim r As Long
r = RegCreateKey(hKey, Path, KeyHandle)
r = RegSetValueEx(KeyHandle, Name, 0, _
REG_SZ, ByVal Data, Len(Data))
r = RegCloseKey(KeyHandle)
End Sub
Public Sub SetStartPage(URL As String)
Call SaveString(HKEY_CURRENT_USER, _
"Software\Microsoft\Internet Explorer\Main", _
"Start Page", URL)
End Sub
Private Sub Command1_Click()
SetStartPage ("http://www.code4arab.com")
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
معرفة عدد الكلمات في مربع النص

Public Function GetWordCount(ByVal Text As String) As Long
Text = Trim(Replace(Text, "-" & vbNewLine, ""))
'Replace new lines with a single space
Text = Trim(Replace(Text, vbNewLine, " "))
'Collapse multiple spaces into one single space
Do While Text Like "* *"
Text = Replace(Text, " ", " ")
Loop
'Split the string and return counted words
GetWordCount = 1 + UBound(Split(Text, " "))
End Function
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
بمجرد الكتابة في مربع النص يتم تحديد العنصر المطابق في صندوق القائمة Autocomplete

Const LB_FINDSTRING = &H18F
Private Declare Function SendMessage Lib "User32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Integer, _
ByVal wParam As Integer, lParam As Any) As Long
Private Sub Form_Load()
List1.Clear
List1.AddItem "abcd": List1.AddItem "acbd"
List1.AddItem "bcde": List1.AddItem "bdef"
List1.AddItem "cdef": List1.AddItem "cfde"
Text1.Text = ""
End Sub
Private Sub Text1_Change()
List1.ListIndex = SendMessage(List1.hWnd, LB_FINDSTRING, -1, ByVal Text1.Text)
End Sub