powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как поставить свою иконку в msgbox?
17 сообщений из 67, страница 3 из 3
Как поставить свою иконку в msgbox?
    #36930275
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael Rнасчёт InputBox
можно издевать над другими вещами там
например с текстовым полем


Честно говоря не понял, где там и что можно менять:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetDlgItem Lib "user32.dll" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

                                    
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const EM_LIMITTEXT As Long = &HC5
Private Const WH_CBT =  5 
Private Const HCBT_ACTIVATE =  5 
Private Const HC_ACTION =  0 
Private Const GWL_STYLE = (- 16 )


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const ES_NUMBER = &H2000
Private Const ES_CENTER As Long = &H1&
Private Const ES_LEFT As Long = &H0&
Private Const ES_LOWERCASE As Long = &H10&
Private Const ES_RIGHT As Long = &H2&
Private Const ES_UPPERCASE As Long = &H8&
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Const STM_SETICON       As Long = &H170
Private Const WM_SETICON As Long = &H80



Private hHook     As Long
Private lMaxLen   As Long
Private lPassChar As Long
Private bNumbersOnly As Boolean
Private m_hIcon As Long
Private m_Title As String


Public Function NewProc(ByVal lngCode As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long) As Long
    Dim RetVal As Long
    Dim strClassName As String
    Dim lngBuffer As Long
    Dim lWnd As Long
    
    '''''''''''''''''''''''''''''''''''''''''''''''
    Dim hIconWnd As Long
    '''''''''''''''''''''''''''''''''''''''''''''''''
    
    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)

        Exit Function

    End If

    strClassName = String$( 256 , " ")
    lngBuffer =  255 

    If lngCode = HCBT_ACTIVATE Then
    
        RetVal = GetClassName(wParam, strClassName, lngBuffer)

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If m_hIcon <>  0 & Then
         hIconWnd = FindWindow(vbNullString, m_Title)
        Call SendMessage(hIconWnd, WM_SETICON, m_hIcon, ByVal  0 &)
        'Call SendDlgItemMessage(hIconWnd, &H1324, WM_SETICON, m_hIcon, &H0)
        
    End If ''''''''''''''''''''''''''''''''''''''''''''''



        If Left$(strClassName, RetVal) = "#32770" Then
        
        
        
        
            If lPassChar >  0  Then
                SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, lPassChar, &H0
            End If

            If lMaxLen >  0  Then
                SendDlgItemMessage wParam, &H1324, EM_LIMITTEXT, lMaxLen, &H0
            End If

            If bNumbersOnly Then
                lWnd = GetDlgItem(wParam, &H1324)
                If Not lWnd =  0  Then
                    SetWindowLong lWnd, GWL_STYLE, GetWindowLong(lWnd, GWL_STYLE) Or ES_NUMBER  '  Or ES_RIGHT  ' or ES_CENTER ' or ES_LEFT ' or  ES_LOWERCASE  ' or  ES_UPPERCASE
                End If
            End If
            
            
        End If
    End If
    
    CallNextHookEx hHook, lngCode, wParam, lParam
End Function

Public Function InputBoxEx(Prompt As String, _
                           Optional Title As String = "", _
                           Optional Default As String = "", _
                           Optional XPos, _
                           Optional YPos, _
                           Optional HelpFile, _
                           Optional Context, _
                           Optional MaxLen As Long =  0 , _
                           Optional PasswordChar As String = "", _
                           Optional NumbersOnly As Boolean = False, _
                           Optional ByRef CancelledByUser As Boolean = False, _
                           Optional ByVal Icon As Long =  0 &) As String
                            
    Dim lngModHwnd As Long
    Dim lngThreadID As Long

    hHook =  0 
    lMaxLen =  0 
    lPassChar =  0 
    bNumbersOnly = NumbersOnly
    m_hIcon = Icon
    
    If MaxLen >  0  Then
        lMaxLen = MaxLen
    End If

    If Not PasswordChar = "" Then
        lPassChar = Asc(PasswordChar)
    End If

    
    If lPassChar >  0  Or lMaxLen >  0  Or bNumbersOnly = True Then
        lngThreadID = GetCurrentThreadId
        lngModHwnd = GetModuleHandle(vbNullString)
        hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    End If

    m_Title = Title
    InputBoxEx = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)

    If Not hHook =  0  Then
        UnhookWindowsHookEx hHook
    End If
    
    CancelledByUser = (StrPtr(InputBoxEx) =  0 )

End Function

Sub Поле_ввода_InputBox()

Параметр =  11 
InputBoxEx (Параметр)

End Sub
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930278
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
' Or ES_RIGHT ' or ES_CENTER ' or ES_LEFT ' or ES_LOWERCASE ' or ES_UPPERCASE

эти описания

ES_RIGHT текст записывается справо налево (иврит арабский)
ES_CENTER текст по центру
ES_LEFT текст слева
ES_LOWERCASE буквы всегда записываются в нижнем регистре
ES_UPPERCASE буквы всегда записываются в верхнем регистре
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930282
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
исходные примеры

1 писать только цифры
2 знаки ограниченное количество
3 текст записывается как пароль со звёздочками
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930307
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael Rисходные примеры

1 писать только цифры
2 знаки ограниченное количество
3 текст записывается как пароль со звёздочками

Не понял, где они??
Сейчас там стоит Or ES_NUMBER
И почему то я могу в поле вводить и буквы???
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930309
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
и что то нет заголовка у поля Инпутбокс, как оно ставится???
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930356
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
и можно ли убрать и как снопку Саnсel???
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930447
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Эндрю


ну БеХаеха
зачем фамилию позоришь


ЭндрюНе понял, где они??
Сейчас там стоит Or ES_NUMBER
И почему то я могу в поле вводить и буквы???

вместо ES_NUMBER поставь другие сообщения
как пример

в примере с цифрами можно вводить только цифры



Эндрюи что то нет заголовка у поля Инпутбокс, как оно ставится???
в Button_click и меняется заголовок


Эндрюи можно ли убрать и как снопку Саnсel???
вот не знаю зачем тебе такое извращение
даже никогда и не думал об этом
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930455
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R
в примере с цифрами можно вводить только цифры


Так я же говорю, что там стоит Or ES_NUMBER, я иогу ввести например букву "Ж"

michael Rможно ли убрать и как снопку Саnсel???
вот не знаю зачем тебе такое извращение
даже никогда и не думал об этом
Так я ж почти работаю в Микрософте в цехе постановки задач
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36930479
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Так я же говорю, что там стоит Or ES_NUMBER, я иогу ввести например букву "Ж"


нет только цифры
или у тебя винда другая
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36938776
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, ответьте пжл на мой пост от 1 ноя 10, 02:06, спасибо
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36938787
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович Эндрю


отвечаю ещё раз
в том примере что я тебе дал у меня
в inputBox с цифрами можно писать только цифры
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36938793
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, то есть я правильно понял, у Вас в окно ввода Инпут бокса буквы нельзя ввести, и что какая реакция, звук, сообщение?
Но у меня можно ввести и никакой реакции со стороны ВБА!
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36938837
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
проверяй модуль
и значения на API константы
это должно работать
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36938877
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, Вы имеете ввиду строку скрипта: Private Const ES_NUMBER = &H2000
Если к константе ES_NUMBER подвести курсор будет 8192
Правильно или нет ВБА его знает???
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36939065
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Эндрю ещё раз

это вызов
Код: plaintext
1.
2.
3.
4.
5.
Sub main()
Dim s As String
Dim bCanc As Boolean
s = InputBoxEx("Enter a number (10 digits max)", "InputboxEx", , , , , ,  10 , , True, bCanc)
End Sub


это модуль
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
Option Explicit

Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetDlgItem Lib "user32.dll" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

                                    
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const EM_LIMITTEXT As Long = &HC5
Private Const WH_CBT =  5 
Private Const HCBT_ACTIVATE =  5 
Private Const HC_ACTION =  0 
Private Const GWL_STYLE = (- 16 )


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const ES_NUMBER = &H2000
Private Const ES_CENTER As Long = &H1&
Private Const ES_LEFT As Long = &H0&
Private Const ES_LOWERCASE As Long = &H10&
Private Const ES_RIGHT As Long = &H2&
Private Const ES_UPPERCASE As Long = &H8&
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Const STM_SETICON       As Long = &H170
Private Const WM_SETICON As Long = &H80



Private hHook     As Long
Private lMaxLen   As Long
Private lPassChar As Long
Private bNumbersOnly As Boolean
Private m_hIcon As Long
Private m_Title As String


Public Function NewProc(ByVal lngCode As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long) As Long
    Dim RetVal As Long
    Dim strClassName As String
    Dim lngBuffer As Long
    Dim lWnd As Long
    
    '''''''''''''''''''''''''''''''''''''''''''''''
    Dim hIconWnd As Long
    '''''''''''''''''''''''''''''''''''''''''''''''''
    
    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)

        Exit Function

    End If

    strClassName = String$( 256 , " ")
    lngBuffer =  255 

    If lngCode = HCBT_ACTIVATE Then
    
        RetVal = GetClassName(wParam, strClassName, lngBuffer)

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If m_hIcon <>  0 & Then
         hIconWnd = FindWindow(vbNullString, m_Title)
        Call SendMessage(hIconWnd, WM_SETICON, m_hIcon, ByVal  0 &)
        'Call SendDlgItemMessage(hIconWnd, &H1324, WM_SETICON, m_hIcon, &H0)
        
    End If ''''''''''''''''''''''''''''''''''''''''''''''



        If Left$(strClassName, RetVal) = "#32770" Then
        
        
        
        
            If lPassChar >  0  Then
                SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, lPassChar, &H0
            End If

            If lMaxLen >  0  Then
                SendDlgItemMessage wParam, &H1324, EM_LIMITTEXT, lMaxLen, &H0
            End If

            If bNumbersOnly Then
                lWnd = GetDlgItem(wParam, &H1324)
                If Not lWnd =  0  Then
                    SetWindowLong lWnd, GWL_STYLE, GetWindowLong(lWnd, GWL_STYLE) Or ES_NUMBER  '  Or ES_RIGHT  ' or ES_CENTER ' or ES_LEFT ' or  ES_LOWERCASE  ' or  ES_UPPERCASE
                End If
            End If
            
            
        End If
    End If
    
    CallNextHookEx hHook, lngCode, wParam, lParam
End Function

Public Function InputBoxEx(Prompt As String, _
                           Optional Title As String = "", _
                           Optional Default As String = "", _
                           Optional XPos, _
                           Optional YPos, _
                           Optional HelpFile, _
                           Optional Context, _
                           Optional MaxLen As Long =  0 , _
                           Optional PasswordChar As String = "", _
                           Optional NumbersOnly As Boolean = False, _
                           Optional ByRef CancelledByUser As Boolean = False, _
                           Optional ByVal Icon As Long =  0 &) As String
                            
    Dim lngModHwnd As Long
    Dim lngThreadID As Long

    hHook =  0 
    lMaxLen =  0 
    lPassChar =  0 
    bNumbersOnly = NumbersOnly
    m_hIcon = Icon
    
    If MaxLen >  0  Then
        lMaxLen = MaxLen
    End If

    If Not PasswordChar = "" Then
        lPassChar = Asc(PasswordChar)
    End If

    
    If lPassChar >  0  Or lMaxLen >  0  Or bNumbersOnly = True Then
        lngThreadID = GetCurrentThreadId
        lngModHwnd = GetModuleHandle(vbNullString)
        hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    End If

    m_Title = Title
    InputBoxEx = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)

    If Not hHook =  0  Then
        UnhookWindowsHookEx hHook
    End If
    
    CancelledByUser = (StrPtr(InputBoxEx) =  0 )

End Function

у меня в VBA WORD работает
только цифры
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36939911
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R,

спасибо!!!!, теперь работает, я сильно не вникал, что ранее было не так
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36940646
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, хотел спросить, когда указано вводить цифры, а я ввожу букву происходит звук, но в коде Beep нет, откуда он берётся? и можно ли и как вместо него например заголовок ИнпутБокса менять?????
...
Рейтинг: 0 / 0
17 сообщений из 67, страница 3 из 3
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как поставить свою иконку в msgbox?
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]