تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
أمثلة و أكواد للتعامل مع دوال Api
#1
كاتب الموضوع : نور نبهان


السلام عليكم ورحمة الله و بركاته

سيتم وضع العديد من الكودات و الامثلة للتعامل مع دوال ا بي اي
لذلك من يجد ان لديه كود معين في هذا المضمار يستطيع إضافته مشكوراً
}}}}
تم الشكر بواسطة:
#2
كاتب المشاركة : نور نبهان


فحص ما إذا كان برنامجك قيد التشغيل

كود :
Private Sub Form_Load()

'// Not the best way to check
'// Better to use the FindWindow API

If App.PrevInstance = True Then
MsgBox ("This program is already running.")
End
End If

End Sub
}}}}
تم الشكر بواسطة:
#3
كاتب المشاركة : نور نبهان


إغلاق تطبيق معين بمعرفة اسمه

كود :
Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Declare Function PostMessage Lib "user32" Alias _
"PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

Public Const WM_CLOSE = &H10

Private Sub cmdClose_Click()

Dim winHwnd As Long
Dim RetVal As Long

winHwnd = FindWindow(vbNullString, Text1.Text)

Debug.Print winHwnd

If winHwnd <> 0 Then
RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&)
If RetVal = 0 Then
MsgBox "Error posting message."
End If
Else
MsgBox Text1.Text + " is not open."
End If

End Sub
}}}}
تم الشكر بواسطة:
#4
كاتب المشاركة : نور نبهان


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

كود :
Declare Function GetTickCount& Lib "kernel32" ()

Private Sub cmdWinRun_Click()
MsgBox GetTickCount
End Sub
}}}}
تم الشكر بواسطة:
#5
كاتب المشاركة : نور نبهان


معرفة إحداثيات الماوس داخل وخارج الفورم

كود :
Private Declare Function GetCursorPos Lib "user32" (lpPoint As _
POINTAPI) As Long

Private Type POINTAPI
x As Long
y As Long
End Type
Dim a As POINTAPI
Dim b As Long
Dim c As Long
' add labels and timer control in the form
Private Sub Form_Load()
Timer1.Interval = 1
End Sub

Private Sub Timer1_Timer()
mousepos
End Sub

Private Sub mousepos()
ret = GetCursorPos(a)
b = a.x
c = a.y
Label1.Caption = b
Label2.Caption = c
End Sub
}}}}
تم الشكر بواسطة:
#6
كاتب المشاركة : نور نبهان


معرفة اسم المستخدم

كود :
Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
As Long

Private Sub Form_Load()
Dim s As String
Dim cnt As Long
Dim dl As Long
Dim CurUser As String
cnt = 199
s = String$(200, 0)
dl = GetUserName(s, cnt)
If dl <> 0 Then CurUser = Left$(s, cnt) Else CurUser = ""
Label1.Caption = CurUser
End Sub
}}}}
تم الشكر بواسطة:
#7
كاتب المشاركة : نور نبهان


فتح لوحة التحكم

كود :
Private Sub Command1_Click()
Shell ("rundll32.exe shell32.dll,Control_RunDLL")
End Sub
}}}}
تم الشكر بواسطة:
#8
كاتب المشاركة : نور نبهان


تصغير وتكبير جميع النوافذ



كود :
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName _
As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long

Private Const WM_COMMAND As Long = &H111
Private Const MIN_ALL As Long = 419
Private Const MIN_ALL_UNDO As Long = 416

Public Sub MinimizeAll()

Dim lngHwnd As Long

lngHwnd = FindWindow("Shell_TrayWnd", vbNullString)
Call PostMessage(lngHwnd, WM_COMMAND, MIN_ALL, 0&)

End Sub

Public Sub RestoreAll()

Dim lngHwnd As Long

lngHwnd = FindWindow("Shell_TrayWnd", vbNullString)
Call PostMessage(lngHwnd, WM_COMMAND, MIN_ALL_UNDO, 0&)

End Sub


Private Sub Command1_Click()
RestoreAll
End Sub

Private Sub Command2_Click()
MinimizeAll
End Sub
}}}}
تم الشكر بواسطة:
#9
كاتب المشاركة : نور نبهان


وضع برنامجك إلى جانب الساعة

كود :
Option Explicit
Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Declare Function Shell_NotifyIcon Lib "shell32" _
Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid _
As NOTIFYICONDATA) As Boolean

Dim t As NOTIFYICONDATA

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

Timer1.Enabled = False

t.cbSize = Len(t)
t.hWnd = Picture1.hWnd
t.uId = 1&

Shell_NotifyIcon NIM_DELETE, t

End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Hex(X) = "1E3C" Then
Me.PopupMenu menu1
End If

End Sub

Private Sub Timer1_Timer()
Static i As Long, img As Long
t.cbSize = Len(t)
t.hWnd = Picture1.hWnd
t.uId = 1&
t.uFlags = NIF_ICON
t.hIcon = Picture1.Picture
Shell_NotifyIcon NIM_MODIFY, t
Timer1.Enabled = True
i = i + 1
If i = 2 Then i = 0
End Sub

Private Sub Form_Load()

t.cbSize = Len(t)
t.hWnd = Picture1.hWnd
t.uId = 1&
t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
t.ucallbackMessage = WM_MOUSEMOVE
t.hIcon = Picture1.Picture
t.szTip = "System Tray" & Chr$(0)

Shell_NotifyIcon NIM_ADD, t

Timer1.Enabled = True

Me.Hide

App.TaskVisible = False

End Sub
}}}}
تم الشكر بواسطة:
#10
كاتب المشاركة : نور نبهان


عرض خلفية سطح المكتب على الفورم

كود :
Private Declare Function PaintDesktop Lib "user32" _
(ByVal hdc As Long) As Long

Private Sub Command1_Click()
PaintDesktop Form1.hdc
End Sub
}}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  أكواد إيقاف التشغيل RaggiTech 0 1,438 17-10-12, 04:41 PM
آخر رد: RaggiTech
  أكواد معاملة النصوص هنا RaggiTech 0 492 17-10-12, 02:45 PM
آخر رد: RaggiTech
  أكواد التعامل مع الملفات RaggiTech 0 643 17-10-12, 02:44 PM
آخر رد: RaggiTech
  أمثلة على عمليات المصفوفات الرياضية ، ضرب طرح جمع RaggiTech 1 1,332 17-10-12, 12:12 AM
آخر رد: RaggiTech

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم