TextBox и SysTray, текстовое поле вместо иконки - VB

Узнай цену своей работы

Формулировка задачи:

Подскажите пожалуйста, можно-ли затолкать вместо иконки, текстовое поле, для того, чтобы оперативно изменять в нем информацию! Заранее благодарен за помощь.

Решение задачи: «TextBox и SysTray, текстовое поле вместо иконки»

textual
Листинг программы
Option Explicit
Dim pblWD#
Dim pblWD_OLD#
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Declare Function FindWindow Lib 'user32' Alias 'FindWindowA' (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib 'user32' Alias 'FindWindowExA' (ByVal hwnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowRect Lib 'user32' (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function SetParent Lib 'user32' (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function SetWindowPos Lib 'user32' (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
 
Const SWP_NOSIZE = &H1
Const SWP_DRAWFRAME = &H20
Const HWND_TOPMOST = -1
Const SWP_NOMOVE = &H2
Const HWND_TOP = 0
Const SWP_NOREDRAW = &H8
 
Private Sub Form_Load()
    Call Set_TXT_pos
    Me.Timer1.Enabled = True
End Sub
 
Sub Set_TXT_pos()
    Dim flags As Long
    Dim retval As Long
    Dim hwnd As Long
    Dim hwnd1 As Long
    Dim rctemp As RECT
    Dim wdW#
    Dim hgW#
    Dim txtW#
    
    hwnd = FindWindow('Shell_TrayWnd', vbNullString)
    hwnd = FindWindowEx(hwnd, 0, 'TrayNotifyWnd', vbNullString)
    GetWindowRect hwnd, rctemp
    
    wdW = rctemp.Right - rctemp.Left
    hgW = rctemp.Bottom - rctemp.Top
    txtW = Me.txtICO.Width / Screen.TwipsPerPixelX
    
    pblWD = wdW
    If pblWD = pblWD_OLD Then Exit Sub
    pblWD_OLD = pblWD + txtW
    flags = SWP_DRAWFRAME
    retval = SetWindowPos(hwnd, HWND_TOP, rctemp.Left - txtW, 0, wdW + txtW, hgW, flags)
    
    With Me
        .Top = 0
        .Left = wdW * Screen.TwipsPerPixelX
        .Height = Me.txtICO.Height
        .Width = Me.txtICO.Width
    End With
    SetParent Me.hwnd, hwnd
    flags = SWP_NOSIZE + SWP_DRAWFRAME
    retval = SetWindowPos(Me.hwnd, HWND_TOP, wdW, 0, txtW, hgW, flags)
End Sub
 
Private Sub Timer1_Timer()
    Call Set_TXT_pos
End Sub
 
Private Sub txtICO_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        Dim soob&
        soob = MsgBox('Âûéòè ГЁГ§ ÏðîãðГ*ììû?', vbYesNo)
        If soob = vbNo Then Exit Sub
        Unload Me
    End If
End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

14   голосов , оценка 4 из 5
Похожие ответы