Как зделать чтобы было видно иконка работающей программы в правом нижнем углу

За рании блогадарю.
Извинаюсь за плохой русскйи.

0

Hai

Declare Function GetDeviceCaps Lib 'gdi32' (ByVal hDC As Long, ByVal nIndex As Long) As Long
Declare Function GetDesktopWindow Lib 'user32' () As Long
Declare Function GetDC Lib 'user32' (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib 'user32' (ByVal hwnd As Long, ByVal hDC As Long) As Long
Public Const HORZRES = 8
Public Const VERTRES = 10
Public Const BITSPIXEL = 12

Public Sub GetVideoMode(ByRef Width As Long, ByRef Height As Long, ByRef Depth As Long)
Dim hDC As Long
hDC = GetDC(GetDesktopWindow())
Width = GetDeviceCaps(hDC, HORZRES)
Height = GetDeviceCaps(hDC, VERTRES)
Depth = GetDeviceCaps(hDC, BITSPIXEL)
ReleaseDC GetDesktopWindow(), hDC
End Sub

--------------------------------------------------------------------------------

Использование:

Dim Height As Long, Width As Long, Depth As Long
GetVideoMode Width, Height, Depth
Примечание: В переменной Depth возвращается не количество цветов, а количество битов на один пиксель. Т.е. 16 цветам соответствует 4 бита на пиксель, 256 - 8 бит, 65536 - 16 бит и т.д.

2. Как изменить текущее разрешение экрана Top

Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32
Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type

Declare Function ChangeDisplaySettings Lib 'user32.dll' Alias 'ChangeDisplaySettingsA' (lpDevMode As DEVMODE, ByVal dwFalgs As Long) As Long

Public Sub SetVideoMode(Width As Long, height As Long, Depth As Long)
Dim dm As DEVMODE
dm.dmPelsWidth = Width
dm.dmPelsHeight = height
dm.dmBitsPerPel = Depth
dm.dmSize = Len(dm)
dm.dmFields = DM_PELSWIDTH + DM_PELSHEIGHT + DM_BITSPERPEL
ChangeDisplaySettings dm, 0
End Sub

--------------------------------------------------------------------------------

Использование:

SetVideoMode 1024, 768, 8 ' Устанавливает видеорежим 1024x768x256
3. Поместить свою иконку в TrayBar Top

Поместите на форму PictureBox с названием picNotifier.

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

Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206

Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
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 00003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

'Registry access constants
Public Const KEY_QUERY_VALUE = &H1 'Permission to query subkey data.
Public Const KEY_SET_VALUE = &H2 'Permission to set subkey data.
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_READ = KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Public Const KEY_WRITE = KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Public Const KEY_ALL_ACCESS = KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_SUB_KEY Or KEY_CREATE_LINK Or KEY_SET_VALUE

Public Const REG_OPTION_NON_VOLATILE = 0&
Public Const REG_OPTION_VOLATILE = &H1

Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Public Enum RegTypes
RegNonee = 0
RegSZ = 1
RegExpandSz = 2
RegBinary = 3
RegDword = 4
RegDwordLittleEndian = 4
RegDwordBigEndian = 5
RegLink = 6
RegMultiSz = 7
RegResourceList = 8
RegFulResourceDesc = 9
End Enum

Declare Function RegOpenKeyEx Lib 'advapi32' Alias 'RegOpenKeyExA' (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegSetValueEx Lib 'advapi32' Alias 'RegSetValueExA' (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long
Declare Function RegCloseKey Lib 'advapi32' (ByVal hKey As Long) As Long
Declare Function RegQueryValueEx Lib 'advapi32' Alias 'RegQueryValueExA' (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
Declare Function RegCreateKeyEx Lib 'advapi32' Alias 'RegCreateKeyExA' (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long

Public Function RegGetValue(Root As Long, SubKey As String, Key As String) As String
Dim Buffer As String, hKey As Long, nType As Long, nSize As Long
RegGetValue = ''
If Not RegOpenKeyEx(Root, SubKey, 0, KEY_READ, hKey) Then
nSize = 0
RegQueryValueEx hKey, Key, 0, nType, Buffer, nSize
If hKey And nSize > 0 And nType = RegSZ Then
Buffer = Space(nSize + 1)
RegQueryValueEx hKey, Key, 0, nType, Buffer, nSize
RegGetValue = Left(Buffer, nSize - 1)
RegCloseKey hKey
End If
End If
End Function

Public Sub RegSetValue(Root As Long, SubKey As String, Key As String, value As String)
Dim hKey As Long, sa As SECURITY_ATTRIBUTES, nDisp As Long
If Not RegCreateKeyEx(Root, SubKey, 0, vbNull, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, sa, hKey, nDisp) Then
RegSetValueEx hKey, Key, 0, RegSZ, value, Len(value) + 1
RegCloseKey hKey
End If
End Sub

--------------------------------------------------------------------------------

Использование:

sUser = RegGetValue(HKEY_LOCAL_MACHINE, 'SoftwareMicrosoftWindowsCurrentVersion' , 'RegisteredOwner')
RegSetValue HKEY_LOCAL_MACHINE, 'SoftwareMicrosoftWindowsCurrentVersion' , 'RegisteredOwner', 'Darth Vader'
Примечание: Эти функции работают только с текстовыми ключами (те, что в RegEdit'e помечены символом 'ab').

7. Конвертирование текста из DOS-кодировки в Windows Top

Declare Function CharToOemBuff Lib 'user32' Alias 'CharToOemBuffA' (ByVal lpszSrc As String, ByVal lpszDs As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WM_GETMINMAXINFO = &H24
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type

Declare Sub CopyMem Lib 'kernel32' Alias 'RtlMoveMemory' (pDest As Any, pSource As Any, ByVal ByteLen As Long)

--------------------------------------------------------------------------------

Использование: Для работы данного примера вам понадобится специальный контрол, Message Hooker. Взять его можно здесь: msghoo32.zip. Бросьте его на форму и вставьте следующий код:

В Form_Load:

Msghook1.HwndHook = Me.hwnd
Msghook1.Message(WM_GETMINMAXINFO) = True
В Msghook1_Message:

Dim mmi As MINMAXINFO
CopyMem mmi, ByVal lp, Len(mmi)
mmi.ptMinTrackSize.x = 100 ' Минимальный размер по горизонтали, в пикселях
mmi.ptMinTrackSize.y = 100 ' Минимальный размер по вертикали, в пикселях
CopyMem ByVal lp, mmi, Len(mmi)
10. Программная перезагрузка Windows Top

Public Declare Function ExitWindowsEx Lib 'user32' (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Const EWX_FORCE = 4
Public Const EWX_LOGOFF = 0
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1

0

Hai
Izveni sliskom mnogo.
Primer mozes skacat' http://artsoft.agava.ru/

Поместите на форму PictureBox с названием picNotifier.

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

Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206

Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
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 picNotifier_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Обработка событий
Static Rec As Boolean, Msg As Long
Msg = X / Screen.TwipsPerPixelX
If Rec = False Then ' Чтоб не повторять Запуск
Rec = True
Select Case Msg
' Если DoubleClick
Case WM_LBUTTONDBLCLK:
Me.Show
' Если левая Кнопка нажата
Case WM_LBUTTONDOWN:

' Если левая Кнопка Отжата
Case WM_LBUTTONUP:

' Правая кнопка Click
Case WM_RBUTTONDBLCLK:

' Если Правая Кнопка нажата
Case WM_RBUTTONDOWN:

' Если Правая Кнопка Отжата
Case WM_RBUTTONUP:
' Здесь вы можете вызвать PoPup-меню:
' PopupMenu mnuPopMenu
End Select
Rec = False
End If

End Sub


' Добавить иконку формы в traybar
SetTrayIcon NIM_ADD, Me.hWnd, Me.Icon, 'Test'
' Изменить иконку и tooltip
SetTrayIcon NIM_MODIFY, Me.hWnd, Me.Icon, 'It works!'
' Удалить иконку из traybar'a
SetTrayIcon NIM_DELETE, Me.hWnd, 0&, ''

0

Spasibo!

0

Зачем посылаете такие большие примеры, когда они уже есть на сайте? Смотри здесь:
http://www.relib.com/click.asp?id=182
http://www.relib.com/click.asp?id=397

0