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

لإخفاء وإظهار شريط المهام Taskbar

Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

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 Sub Command1_Click()
Dim Thwnd As Long
Thwnd = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End Sub
' لإظهار شريط المهام
Private Sub Command2_Click()
Dim Thwnd As Long
Thwnd = FindWindow("Shell_traywnd", "")
Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
لحصر الماوس داخل النموذج (وتستطيع ان تحصرها داخل أي أداة أخرى)

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, _
lpRect As RECT) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, _
lpPoint As Any) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long

Sub RestrictMouseRegion(Optional ByVal hWnd As Long = 0)
Dim recTargetWindow As RECT
If hWnd Then
GetClientRect hWnd, recTargetWindow
ClientToScreen hWnd, recTargetWindow
ClientToScreen hWnd, recTargetWindow.Right
ClipCursor recTargetWindow
Else
ClipCursor ByVal 0&
End If
End Sub

Private Sub Form_Load()
RestrictMouseRegion (Me.hWnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
RestrictMouseRegion
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
لإضافة عروض الفلاش لبرنامجك

Private Sub Command1_Click()
Dim s As String
s = App.Path
If Mid(s, Len(s), 1) <> "\" Then s = s + "\"
ShockwaveFlash1.Movie = s + "a4.swf"

End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
لتحريك النموذج من أي نقطة فيه بدون الاعتماد على شريط العنوان

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
Private Declare Sub ReleaseCapture Lib "User32" ()

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, _
Y As Single)
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
If Button = 1 Then
ReleaseCapture
SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
لتشفير وفك تشفير نص .

Private Sub Command1_Click()
For i = 1 To Len(Text1.Text)
st1 = Mid(Text1.Text, i, 1)
as1 = Asc(st1)
ch1 = Chr(255 - as1)
st = st + ch1
Next
Text1.Text = st
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
لإظهار وإخفاء الأيقونات (الرموز) على سطح المكتب

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long

Private Sub Command1_Click()
'لإخفاء الأيقونات على سطح المكتب
Dim hWnd As Long
hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd, 0
End Sub

Private Sub Command2_Click()
'لإظهار الأيقونات على سطح المكتب
Dim hWnd As Long
hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd, 5
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
يقوم هذا الاجراء بتحويل معظم الأدوات المستخدمة في الفيجوال بيسك من اليسار الى اليمين حتى وان كانت الفيجوال بيسك لا تدعم ذلك

Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const WS_EX_LAYOUTRTL = &H400000
Private Const GWL_EXSTYLE = (-20)

Public Sub SetRtoL(Ctl As Control)
Ctl.Visible = False
SetWindowLong Ctl.hwnd, GWL_EXSTYLE, GetWindowLong(Ctl.hwnd, GWL_EXSTYLE) Or WS_EX_LAYOUTRTL
Ctl.Visible = True
End Sub