v.b.6 codes(5)

لتبديل اظرار الفارة
Const SPI_SETMOUSEBUTTONSWAP = 33
Const SPIF_UPDATEINIFILE = &H1
Private Declare Function SystemParametersInfo Lib "user32.dll" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uiParam As Long, _
pvParam As Any, ByVal fWinIni As Long) As Long
Private Sub Form_Load()
SystemParametersInfo SPI_SETMOUSEBUTTONSWAP, 1, 0, SPIF_UPDATEINIFILE
End Sub
...........................................................................................
لأعادة الفارة لوضعها الاصلي
Const SPI_SETMOUSEBUTTONSWAP = 33
Const SPIF_UPDATEINIFILE = &H1
Private Declare Function SystemParametersInfo Lib "user32.dll" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uiParam As Long, _
pvParam As Any, ByVal fWinIni As Long) As Long
Private Sub Form_Load()
SystemParametersInfo SPI_SETMOUSEBUTTONSWAP, 0, 1, SPIF_UPDATEINIFILE
End Sub
...........................................................................................
نسخ خلفية سطح المكتب إلى نموذجك
'انسخ هذ الكودالى قسم التصريحات العامة
Private Declare Function PaintDesktop Lib "user32" _
(ByVal hdc As Long) As Long
'انسخ هذ الكودالى حدث النقر في زر الامر
Private Sub Command1_Click()
PaintDesktop Form1.hdc
End Sub
...........................................................................................
كود يعمل في مربع تست يقوم بأن يجعل المستخدم فقط يدخل أرقام من صفر إلى 9 و إذا ضغط على ازرار في الكي بورد لا يطبعها في التست بوكس
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0
End If
End Sub
...........................................................................................
تحويل الحروف الإنجليزية لأحرف كبيرة
Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr$(KeyAscii)))
End Sub
...........................................................................................
ااجعل برنامجك فوق الجميع always on top
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
Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Public Sub SetOnTop(ByVal hwnd As Long, ByVal bSetOnTop As Boolean)
Dim lR As Long
If bSetOnTop Then
lR = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
Else
lR = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End If
End Sub
Private Sub Form_Load()
SetOnTop Form1.hwnd, True
End Sub
...........................................................................................
لمعرفة عدد الاسطر في مربع النص TextBox
Private Declare Function SendMessageLong Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const EM_GETLINECOUNT = &HBA
Private Sub Command1_Click()
Dim lineCount As Long
On Local Error Resume Next
lineCount = SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, 0)
MsgBox Format$(lineCount, "##,###")
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 Command1_Click()
Shell "notepad.exe", vbNormalNoFocus
AppActivate ("Untitled - Notepad")
SendKeys ("أهلا بكم في منتديات المبرمج العربي")
End Sub
...........................................................................................
تجميد الويندوس بحيث لم يستطيع العمل الي بعد اعادة التشغيل
Public Declare Function SetParent Lib "user32" (ByVal _
hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Sub Command1_Click()
SetParent Me, Me
End Sub
...........................................................................................