امتیاز موضوع:
- 0 رأی - میانگین امتیازات: 0
- 1
- 2
- 3
- 4
- 5
خواهش می کنم کمک کنید!
|
نویسنده |
پیام |
Berke
تازه وارد
ارسالها: 7
موضوعها: 0
تاریخ عضویت: دى ۱۳۸۶
تشکرها : 1
( 0 تشکر در 0 ارسال )
|
RE: خواهش می کنم کمک کنید!
سلام هموطن سلام دوست من سلام ايراني
-----------------
با اين تابع برنامه را مي توان در سيستم تراي (گوشه كنار ساعت) قرار داد
----------
شروع برنامه
خوب اينارو توي يه ماژول بنويس
Public 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
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201 'Button down
Public Const WM_LBUTTONUP = &H202 'Button up
Public Const WM_LBUTTONDBLCLK = &H203 'Double-click
Public Const WM_RBUTTONDOWN = &H204 'Button down
Public Const WM_RBUTTONUP = &H205 'Button up
Public Const WM_RBUTTONDBLCLK = &H206 'Double-click
Public Declare Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32" _
Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Public nid As NOTIFYICONDATA
خوب حالا اينارو تو فرم بزار
Private Sub Form_Load()
'the form must be fully visible before calling Shell_NotifyIcon
Me.Show
Me.Refresh
With nid
.cbSize = Len(nid)
.hwnd = Me.hwnd
.uId = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallBackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon
.szTip = "Your ToolTip" & vbNullChar
End With
Shell_NotifyIcon NIM_ADD, nid
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As _
Single, Y As Single)
'this procedure receives the callbacks from the System Tray icon.
Dim Result As Long
Dim msg As Long
'the value of X will vary depending upon the scalemode setting
If Me.ScaleMode = vbPixels Then
msg = X
Else
msg = X / Screen.TwipsPerPixelX
End If
Select Case msg
Case WM_LBUTTONUP '514 restore form window
Me.WindowState = vbNormal
Result = SetForegroundWindow(Me.hwnd)
Me.Show
Case WM_LBUTTONDBLCLK '515 restore form window
Me.WindowState = vbNormal
Result = SetForegroundWindow(Me.hwnd)
Me.Show
Case WM_RBUTTONUP '517 display popup menu
Result = SetForegroundWindow(Me.hwnd)
Me.PopupMenu Me.mPopupSys
End Select
End Sub
Private Sub Form_Resize()
'this is necessary to assure that the minimized window is hidden
If Me.WindowState = vbMinimized Then Me.Hide
End Sub
Private Sub Form_Unload(Cancel As Integer)
'this removes the icon from the system tray
Shell_NotifyIcon NIM_DELETE, nid
End Sub
Private Sub mPopExit_Click()
'called when user clicks the popup menu Exit command
Unload Me
End Sub
Private Sub mPopRestore_Click()
'called when the user clicks the popup menu Restore command
Me.WindowState = vbNormal
Result = SetForegroundWindow(Me.hwnd)
Me.Show
End Sub
با اين برنامه هر موقع روي كمينه ي فرم كليك كني برنامه به سيستم تراي ميره
----------
براي اطلاعات بيشتر به mehrdadrahi.blogfa.com مراجعه كنيد
|
|
۰۴-دى-۱۳۸۶, ۱۵:۲۷:۱۱ |
|
تشکر شده توسط : |
|
موضوعات مرتبط با این موضوع... |
موضوع |
نویسنده |
پاسخ |
بازدید |
آخرین ارسال |
|
[سوال] دانلود کنید - راهنمایی کنید |
sogolam |
3 |
3,735 |
۱۸-آبان-۱۳۹۱, ۰۳:۱۵:۱۹
آخرین ارسال: Payman62
|
|
[سوال] ذخیره آیکون EXE,اساتید گرامی لطف کنید جوابم رو بدید :-( |
!_!_batman_!_! |
2 |
4,326 |
۰۲-شهریور-۱۳۹۱, ۰۰:۱۵:۱۹
آخرین ارسال: setroyd
|
|
YMSGPro.ocx لطفا کمک کنید |
setroyd |
4 |
5,610 |
۲۲-اردیبهشت-۱۳۹۱, ۰۰:۲۱:۵۹
آخرین ارسال: gorg313
|
|
[سوال] لطفا کمک کنید |
vidaalipour |
1 |
2,331 |
۱۹-مرداد-۱۳۹۰, ۱۲:۲۶:۱۹
آخرین ارسال: Payman62
|
|
مشکلی در رابطه با adodc کمک کنید |
evilbaby |
7 |
5,997 |
۰۲-بهمن-۱۳۸۹, ۲۰:۴۹:۲۱
آخرین ارسال: 1120
|
|
{لطفا کمک کنید} استفاده ار مولتی ترد در سرور و کلاینت ها |
hacker0771 |
1 |
2,846 |
۲۵-تير-۱۳۸۹, ۲۲:۴۷:۳۶
آخرین ارسال: CRazYFULL
|
|
کمک کنید انتقال به ریچ تکست باکس در وی بروس |
idenshz |
0 |
2,318 |
۱۷-تير-۱۳۸۹, ۰۹:۰۲:۳۳
آخرین ارسال: idenshz
|
|
کمک فوری در رابطه با یه اکتیویکس (خواهشا کمک کنید ) |
silverm |
1 |
3,142 |
۰۸-اسفند-۱۳۸۸, ۰۵:۳۹:۱۱
آخرین ارسال: mohamadpk
|
|
چند سوال لطفا وخواهشا کمک کنید؟؟؟؟؟ |
evilbaby |
1 |
1,963 |
۱۴-تير-۱۳۸۸, ۰۸:۴۸:۵۶
آخرین ارسال: MT888
|
|
خواهش می کنم هرکسی می تونه کمک کنه |
evilbaby |
1 |
2,187 |
۱۲-خرداد-۱۳۸۸, ۲۲:۲۶:۱۱
آخرین ارسال: Mr.pRoGraMmer
|
کاربرانِ درحال بازدید از این موضوع: 1 مهمان