powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как поставить свою иконку в msgbox?
25 сообщений из 67, страница 1 из 3
Как поставить свою иконку в msgbox?
    #36925747
Armani
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
В свойствах вроде ее не установишь. Новую форму рисовать или можно как-то сделать?
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36925790
Armani
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Аналогичный вопрос и по inputbox, а то во всех формах есть иконки , а тут нет.
Нашел вариант, не знаю правда рабочий или нет на дельфи, может кто знает как переделать под бейсик

function MessageBoxIndirect(const MsgBoxParams: TMsgBoxParams): Integer; stdcall; external user32 name 'MessageBoxIndirectA';

function MessageBoxWithIcon(hWnd: HWND; const lpText, lpCaption: string; uType: DWORD; szIcon: PWChar): Integer;
var
mbp: TMsgBoxParams;
begin
ZeroMemory(@mbp, SizeOf(mbp));
with mbp do
begin
cbSize := SizeOf(mbp);
hwndOwner := hWnd;
hInstance := SysInit.HInstance;
lpszText := PChar(lpText);
lpszCaption := PChar(lpCaption);
PWChar(lpszIcon) := szIcon;
dwStyle := uType;
end;
Result := MessageBoxIndirect(mbp);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
MessageBoxWithIcon(Handle, 'Привет', 'Сообщение с иконкой!', MB_USERICON or MB_APPLMODAL, 'MAINICON');
end;
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36925832
Фотография Konst_One
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
работает только в скомпилированном exe. из отладки иконку не увидишь!
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36926130
Armani
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Konst_one, спасибо большое, получилось.
А еще такой вопрос, можно еще сделать такой вариант, чтобы иконка была не на самом msgbox, а такая же например, как у вашей основной Form1, в заголовке?
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36926322
Фотография Konst_One
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
добавьте в ресурсный файл любую нужную вам иконку а потом просто укажите номер вашего ресурса:

Код: plaintext
1.
2.
...
MB.lpszIcon =  101  'номер ресурса иконки
...
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36926420
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Konst_One, я так понял, а в ВБА это всё проделать не возможно????
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36926603
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович Эндрю

В ПРИНЦИПЕ МОЖНО И В vba ВСТАВИТЬ СВОЮ ИКОНКУ

ДОМА ГДЕ ТО ЕСТЬ ПРИМЕРЫ СО ВСТАВКОЙ СВОЕЙ ИКОНКИ В msgbox
И ВРОДЕ РАБОТАЛО В РЕЖИМЕ ОТЛАДКИ
НАДО ПОИСКАТЬ
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36926613
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, подожду
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36926804
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович Эндрю

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

пример работает и в VBA Excel
можно иконки загружать через loadPicture()
немного меняется модуль

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

У меня на русском: Добавления-Менеджер дополнений. Находишь VB6 Resources Editor-Выделяешь-галка Загрузить/Выгрузить. Если надо загружать каждый раз - Загружать при запуске.

Для английской версии на память:
Add-Ins-Add-In Manager-VB6 Resource Editor. Для загрузки - Loaded/Unloaded, для загрузки при запуске - Load on Startup
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928712
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович Эндрю

не заморачивайся с ресурсами
вещь хорошая но в VB жутко ограниченная

в VBA вообще такой вещи нет
я не нашёл
просто интересно было можно ли такую вещь забацать в виде настройки для VBA
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928718
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, я и не заморачиваюсь, Вы сами спрашиваете, сами отвечаете
Вы можете выложить код на ВБА?
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928761
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
эээээ

какой именно код ?
про MSGBOX или с файлом ресурсов

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

вот VBA код

иконки берутся из текущей директории
через loadPicture

в модуле основная обработка

sheet1
sub main ()
сам запуск в коде
несколько примеров
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928786
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
michael R, нет не код про MSGBOX, а код про MsgBox $
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928787
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ваш пост до моего ещё не видел, посмотрю
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928789
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
вус из дус MsgBox$ ?

у меня такого не было
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928791
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Да Вы можете выложить понятно, Эксель вообще не перевариваю
Чтобы в Ворде Ваш скрипт
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
Sub main()

MsgBoxEx "Test1", vbInformation, "Test!", Val( 200 ), Val( 200 ), LoadPicture(ActiveWorkbook.Path & "\critical.ico")
MsgBoxEx "Test2", vbInformation, "Test!", Val( 250 ), Val( 250 ), LoadPicture(ActiveWorkbook.Path & "\exclamation.ico")
MsgBoxEx "Test3", vbInformation, "Test!", Val( 300 ), Val( 300 ), LoadPicture(ActiveWorkbook.Path & "\information.ico")
MsgBoxEx "Test4", vbInformation, "Test!", Val( 350 ), Val( 350 ), LoadPicture(ActiveWorkbook.Path & "\pbxpicon.ico")
MsgBoxEx "Test5", vbInformation, "Test!", Val( 400 ), Val( 400 ), LoadPicture(ActiveWorkbook.Path & "\question.ico")
MsgBoxEx "Right to Left Text", vbMsgBoxRight + vbMsgBoxRtlReading, "Test!", Val( 450 ), Val( 450 ), LoadPicture(ActiveWorkbook.Path & "\swvb.ico")

End Sub
заработал, что надо кроме него???
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928792
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ну может получение пути для картинки поменять надо
там вроде по другому
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928800
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ципихович Эндрю ДЛЯ WORD


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
Sub main()
MsgBoxEx "Test1", vbInformation, "Test!", Val( 200 ), Val( 200 ), LoadPicture(ThisDocument.Path & "\critical.ico")
MsgBoxEx "Test2", vbInformation, "Test!", Val( 250 ), Val( 250 ), LoadPicture(ThisDocument.Path & "\exclamation.ico")
MsgBoxEx "Test3", vbInformation, "Test!", Val( 300 ), Val( 300 ), LoadPicture(ThisDocument.Path & "\information.ico")
MsgBoxEx "Test4", vbInformation, "Test!", Val( 350 ), Val( 350 ), LoadPicture(ThisDocument.Path & "\pbxpicon.ico")
MsgBoxEx "Test5", vbInformation, "Test!", Val( 400 ), Val( 400 ), LoadPicture(ThisDocument.Path & "\question.ico")
MsgBoxEx "Right to Left Text", vbMsgBoxRight + vbMsgBoxRtlReading, "Test!", Val( 450 ), Val( 450 ), LoadPicture(ThisDocument.Path & "\swvb.ico")


End Sub


модуль
единственная заморочка
строчка
Title = "word" 'application.Title
я не знаю как получить Title открытой страницы
это в случае если Title не выставлен по умолчаению

Код: 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.
'Win32 API decs

'Hook functions
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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook 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 GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) 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
Private Declare Function GetParent Lib "user32" (ByVal hWnd 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

'Constants
Private Const WH_CBT            As Long =  5 
Private Const HCBT_ACTIVATE     As Long =  5 
Private Const HWND_TOP          As Long =  0 
Private Const SWP_NOSIZE        As Long = &H1
Private Const SWP_NOZORDER      As Long = &H4
Private Const SWP_NOACTIVATE    As Long = &H10
Private Const STM_SETICON       As Long = &H170

'APP-SPECIFIC
Private Const SWVB_DEFAULT      As Long = &HFFFFFFFF '-1 is reserved for centering
Private Const SWVB_CAPTION_DEFAULT As String = "SWVB_DEFAULT_TO_APP_TITLE"

'Types
Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

'module-level member variables
Private m_Hook As Long
Private m_Left As Long
Private m_Top As Long
Private m_hIcon As Long

Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Dim hInstance As Long


Public Function MsgBoxEx(ByVal Prompt As String, _
                Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
                Optional ByVal Title As String = SWVB_CAPTION_DEFAULT, _
                Optional ByVal Left As Long = SWVB_DEFAULT, _
                Optional ByVal Top As Long = SWVB_DEFAULT, _
                Optional ByVal Icon As Long =  0 &) As VbMsgBoxResult

Dim hInst As Long
Dim threadID As Long
Dim wndRect As RECT

hInstance = GetModuleHandle("WINWORD.EXE")


hInst = hInstance 'Application.hInstance
threadID = GetCurrentThreadId()

'First "subclass" the MsgBox function
m_Hook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHook, hInst, threadID)

'Save the new arguments as member variables to be used from the MsgBoxHook proc
m_Left = Left
m_Top = Top
m_hIcon = Icon
    
'default the msgBox caption to app.title
If Title = SWVB_CAPTION_DEFAULT Then
    Title = "word" 'application.Title
End If

'if user wants custom icon make sure dialog has an icon to replace
If m_hIcon <>  0 & Then
    Buttons = Buttons Or vbInformation
End If
'show the MsgBox and let hook proc take care of the rest...
MsgBoxEx = MsgBox(Prompt, Buttons, Title)

End Function

Private Function MsgBoxHook(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim height As Long
Dim width As Long
Dim nSize As Long
Dim wndRect As RECT
Dim sBuffer As String
Dim fWidth As Long
Dim fHeight As Long
Dim x As Long
Dim y As Long
Dim hIconWnd As Long

Debug.Print "hook proc called"
'Call next hook in the chain and return the value
'(this is the polite way to allow other hhoks to function too)
MsgBoxHook = CallNextHookEx(m_Hook, nCode, wParam, lParam)

' hook only the activate msg
If nCode = HCBT_ACTIVATE Then
    'handle only standard MsgBox class windows
    sBuffer = Space$( 32 ) 'this is the most efficient method to allocate strings in VB
                         'according to Brad Martinez's results with tools from NuMega
    nSize = GetClassName(wParam, sBuffer,  32 ) 'GetClassName will truncate the class name if it doesn't fit in the buffer
                                              'we only care about the first 6 chars anyway
    If Left$(sBuffer, nSize) <> "#32770" Then
        Exit Function 'not a standard msgBox
                      'we can just quit because we already called CallNextHookEx
    End If
     
    'store MsgBox window size in case we need it
    Call GetWindowRect(wParam, wndRect)
    'handle divide by zero errors (should never happen)
    On Error GoTo errorTrap
    height = (wndRect.Bottom - wndRect.Top) /  2 
    width = (wndRect.Right - wndRect.Left) /  2 
    
    'store parent window size
    Call GetWindowRect(GetParent(wParam), wndRect)
    'handle divide by zero errors (should never happen)
    On Error GoTo errorTrap
    fHeight = wndRect.Top + (wndRect.Bottom - wndRect.Top) /  2 
    fWidth = wndRect.Left + (wndRect.Right - wndRect.Left) /  2 
    
    'By default center MsgBox on the form
    'if user passed in specific values then use those instead
    If m_Left = SWVB_DEFAULT Then 'default
        x = fWidth - width
    Else
        x = m_Left
    End If
    
    If m_Top = SWVB_DEFAULT Then 'default
        y = fHeight - height
    Else
        y = m_Top
    End If

    'Manually set the MsgBox window position before Windows shows it
    SetWindowPos wParam, HWND_TOP, x, y,  0 ,  0 , SWP_NOSIZE + SWP_NOZORDER + SWP_NOACTIVATE

    'If user passed in custom icon use that instead of the standard Windows icon
    If m_hIcon <>  0 & Then
        hIconWnd = FindWindowEx(wParam,  0 &, "Static", vbNullString)
        Call SendMessage(hIconWnd, STM_SETICON, m_hIcon, ByVal  0 &)
    End If

errorTrap:
    'unhook the dialog and we are out clean!
    UnhookWindowsHookEx m_Hook
    Debug.Print "unhook"
End If

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

спасибо, тогда например так:

Код: plaintext
1.
MsgBoxEx "Test1", vbInformation, "Test!", Val( 200 ), Val( 200 ), LoadPicture("C:\Documents and Settings\user1\Мои документы\Новая папка (2)\MSGBOX_ICON" & "\critical.ico")
Ранее я Вам толковал, что в ВБА лучше писать MsgBox$ чем MsgBox
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928827
Ципихович Эндрю
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
в этой строке
Код: plaintext
1.
MsgBoxEx "Test1", vbInformation, "Test!", Val( 200 ), Val( 200 ).....
Val(200) это вероятно отступы??
Первый от чего???
Второй от чего???
...
Рейтинг: 0 / 0
Как поставить свою иконку в msgbox?
    #36928831
Фотография michael R
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Val(200), Val(200)

---------------------------------------------
позиция на экране координаты X Y
или лучше брать координаты относительно самого экрана только по центру
...
Рейтинг: 0 / 0
25 сообщений из 67, страница 1 из 3
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как поставить свою иконку в msgbox?
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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