Программа не имеет заголовка. при сворачивании программа уходит в левую сторону экрана (в район кнопки пуск)
Вопрос : как сделать чтобы прога сворачивалась в трей (как например KAV)
Private Sub Form_Resize()
If WindowState = 1 Then
HideInTray
End If
End Sub
IvanTheTerrible писал(а):2 Kovu:
"Если всё делать своими ручками, они скоро отвалятся !" - цитата из "Дневника ананиста"?
P.S. Ничего личного!
Private Declare Function DrawAnimatedRects Lib "user32.dll" (ByVal hwnd As Long, _
ByVal idAni As Long, ByRef lprcFrom As Rect, ByRef lprcTo As Rect) As Long
Declare Function Shell_NotifyIconA Lib "SHELL32" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Integer
Public Const NIM_ADD = 0
Public Const NIM_MODIFY = 1
Public Const NIM_DELETE = 2
Public Const NIF_MESSAGE = 1
Public Const NIF_ICON = 2
Public Const NIF_TIP = 4
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 Function SetTrayIcon(Mode As Long, hWnd As Long, Icon As Long, tip As String) As Long
Dim nidTemp As NOTIFYICONDATA
nidTemp.cbSize = Len(nidTemp)
nidTemp.hWnd = hWnd
nidTemp.uID = 0&
nidTemp.uFlags = NIF_ICON Or NIF_TIP
nidTemp.uCallbackMessage = 0&
nidTemp.hIcon = Icon
nidTemp.szTip = tip & Chr$(0)
SetTrayIcon = Shell_NotifyIconA(Mode, nidTemp)
End Function
Private Sub Command1_Click()
SetTrayIcon NIM_ADD, Me.hWnd, Me.Icon, "Test"
End Sub
Private Sub Command2_Click()
SetTrayIcon NIM_MODIFY, Me.hWnd, Me.Icon, "It works!"
End Sub
Private Sub Command3_Click()
SetTrayIcon NIM_DELETE, Me.hWnd, 0&, ""
End Sub
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function DrawAnimatedRects Lib "user32.dll" (ByVal hwnd As Long, ByVal idAni As Long, lprcFrom As RECT, lprcTo As RECT) As Long
Enum AnimateMode
M_CLOSE = 0
M_OPEN = 1
End Enum
Private bRestore As Boolean
Option Explicit
Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then
AnimateWindow (M_CLOSE)
Me.Visible = False
SetTrayIcon NIM_ADD, Me.hwnd, Me.Icon, Me.Caption
bRestore = True
Else
If bRestore Then
DelIcon Me
End If
End If
End Sub
Private Sub AnimateWindow(ByVal aniMode As AnimateMode)
Dim rctFrom As RECT, rctTo As RECT
Dim TrayHwnd As Long, Ret As Long
Dim lMode As Long
Static rctPrev As RECT
If Me.WindowState = vbMinimized Then
lMode = IDANI_CLOSE
Else
lMode = IDANI_OPEN
bRestore = False
End If
lMode = IDANI_CAPTION Or lMode
TrayHwnd = FindWindow("Shell_TrayWnd", vbNullString)
GetWindowRect TrayHwnd, rctTo
rctTo.left = rctTo.right
rctTo.top = rctTo.bottom
With rctFrom
.left = Me.ScaleLeft
.top = Me.ScaleTop
.bottom = Me.Height
.right = Me.Width
End With
rctPrev = rctFrom
If aniMode = M_OPEN Then
rctFrom = rctPrev
Ret = DrawAnimatedRects(Me.hwnd, lMode, rctTo, rctFrom)
Else
Ret = DrawAnimatedRects(Me.hwnd, lMode, rctFrom, rctTo)
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If y = 0 Then
Select Case x / Screen.TwipsPerPixelX
Case 512 'MouseMove
Case 513 'LeftButtonDown
Case 514 'LeftButtonUp
AnimateWindow (M_OPEN)
ShowWindow Me.hwnd, SW_RESTORE
SetForegroundWindow Me.hwnd
SetActiveWindow Me.hwnd
Case 515 'LeftButtonDblClick
Case 516 'RightButtonDown
Case 517 'RightButtonUp
Case 518 'RightButtonDblClick
End Select
End If
End Sub
Public Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Public Declare Function SetActiveWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Public Const IDANI_CLOSE As Long = &H2
Public Const IDANI_CAPTION As Long = &H3
Public Const IDANI_OPEN As Long = &H1
Public Const SW_RESTORE As Long = 9
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Option Explicit
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Long
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 NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONUP = &H205
Public Function SetTrayIcon(Mode As Long, hwnd As Long, Icon As Long, Optional strToolTipText As String = "")
On Error Resume Next
Dim NID As NOTIFYICONDATA
With NID
.cbSize = Len(NID)
.hwnd = hwnd
.uID = &H0
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
.uCallbackMessage = WM_LBUTTONUP
.hIcon = Icon
.szTip = left(strToolTipText, 63) & Chr(0)
SetTrayIcon = Shell_NotifyIcon(Mode, NID)
End With
End Function
Public Sub DelIcon(frForm As Form)
On Error Resume Next
With frForm
SetTrayIcon NIM_DELETE, .hwnd, 0, ""
End With
End Sub
Public Sub ModIcon(frForm As Form, Optional strToolTipText As String = "")
On Error Resume Next
With frForm
SetTrayIcon NIM_MODIFY, .hwnd, .Icon, strToolTipText
End With
End Sub
Сейчас этот форум просматривают: SemrushBot и гости: 112