Ето как это так? Где показывала? В трее? Ну если я рпавельно понял, то надо взять какаю нибудь иконку и в рантайме рисовать на ней все что надо, и потом пихать её в трей!Akella писал(а):Привет бртья по форуму ну и по разуму значит. А теперь серёзно. КАК запихать свою прогу в трей, НЕ ИКОНКУ ПРОГИ, А чтобы она показывала (Язык, FPS, ...).
'Предполагается, что на диске С: имеются файлы RUSSIAN.ICO и ENGLISH.ICO с русской и английской иконками соответственно.
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 NIF_MESSAGE As Long = &H1
Private Const NIF_ICON As Long = &H2
Private Const NIF_TIP As Long = &H4
Private Const NIM_ADD As Long = &H0
Private Const NIM_MODIFY As Long = &H1
Private Const NIM_DELETE As Long = &H2
Private Const WM_RBUTTONDOWN As Long = &H204
Private Const WM_NULL As Long = &H0
Private Const KL_NAMELENGTH As Long = &H9
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) 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 Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Private NID As NOTIFYICONDATA, m_hWnd&, m_Icon&, m_ToolTipText$, Language As Boolean
Private WithEvents Timer1 As Timer
Private Sub Add(ByVal hWnd&, ByVal Icon&, ByVal Tip$)
Dim ret&
NID.uID = hWnd
NID.hWnd = hWnd
NID.hIcon = Icon
NID.szTip = Left(Tip, 63) & Chr(0)
NID.uFlags = NIF_TIP Or NIF_ICON
NID.cbSize = Len(NID)
ret = Shell_NotifyIcon(NIM_ADD, NID)
End Sub
Private Sub Delete(ByVal hWnd&)
Dim ret&
NID.uID = hWnd
NID.hWnd = hWnd
NID.cbSize = Len(NID)
ret = Shell_NotifyIcon(NIM_DELETE, NID)
End Sub
Private Sub Change(ByVal hWnd&, ByVal Icon&, ByVal Tip$)
Dim ret&
NID.uID = hWnd
NID.hWnd = hWnd
NID.hIcon = Icon
NID.szTip = Left(Tip, 63) & Chr(0)
NID.uFlags = NIF_TIP Or NIF_ICON
NID.cbSize = Len(NID)
ret = Shell_NotifyIcon(NIM_MODIFY, NID)
End Sub
Private Function GetKBLayout() As Boolean
Dim str$
str = String(KL_NAMELENGTH, 0)
GetKeyboardLayoutName str
If Val(str) = 409 Then GetKBLayout = False Else GetKBLayout = True
End Function
Private Sub Form_Load()
Set Timer1 = Me.Controls.Add("VB.Timer", "Timer1")
Timer1.Interval = 1
Timer1.Enabled = True
Add Me.hWnd, LoadPicture(IIf(GetKBLayout, "C:\RUSSIAN.ICO", "C:\ENGLISH.ICO")), IIf(Language, "Russian", "English")
End Sub
Private Sub Form_Unload(Cancel%)
Delete Me.hWnd
End Sub
Private Sub Timer1_Timer()
If Not (GetKBLayout And Language) Then
Language = GetKBLayout
Change Me.hWnd, LoadPicture(IIf(Language, "C:\RUSSIAN.ICO", "C:\ENGLISH.ICO")), IIf(Language, "Russian", "English")
End If
End Sub
A.A.Z. писал(а):Не, это не ко мне, он не хочет форму в трэй запихивать
A.A.Z. писал(а):Не, это не ко мне, он не хочет форму в трэй запихивать
Akella писал(а):Наверно мне надо именно форму в трей, ибо надо поместить туда счетчик 0~200,300.
Amed писал(а):Akella писал(а):Наверно мне надо именно форму в трей, ибо надо поместить туда счетчик 0~200,300.
Не-а... В таком случае надо генерировать иконки. С формой будет море проблем...
picTemp.Print fps
picTemp.picture=picTemp.image
SavePicture picTemp.Picture, "C:\tmp.ico"
'ещё нужно поменять в выходном файле 2 первых байта, кажется (savepicture сохраняет в bmp, а ico от bmp отличается первыми 2 байтами, см. форум)
Amed писал(а):а ico от bmp отличается первыми 2 байтами, см. форум)
Что ещё надо-то? Где проблемы?
tyomitch писал(а):Совершенно точно нет - в ICO есть ещё и маска.
Сейчас этот форум просматривают: AhrefsBot, Google-бот, SemrushBot и гости: 79