Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как поставить свою иконку в msgbox? / 25 сообщений из 67, страница 1 из 3
28.10.2010, 14:59
    #36925747
Armani
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как поставить свою иконку в msgbox?
В свойствах вроде ее не установишь. Новую форму рисовать или можно как-то сделать?
...
Рейтинг: 0 / 0
28.10.2010, 15:08
    #36925790
Armani
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как поставить свою иконку в msgbox?
Аналогичный вопрос и по 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
28.10.2010, 15:20
    #36925832
Konst_One
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как поставить свою иконку в msgbox?
работает только в скомпилированном exe. из отладки иконку не увидишь!
...
Рейтинг: 0 / 0
28.10.2010, 16:35
    #36926130
Armani
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как поставить свою иконку в msgbox?
Konst_one, спасибо большое, получилось.
А еще такой вопрос, можно еще сделать такой вариант, чтобы иконка была не на самом msgbox, а такая же например, как у вашей основной Form1, в заголовке?
...
Рейтинг: 0 / 0
28.10.2010, 17:45
    #36926322
Konst_One
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как поставить свою иконку в msgbox?
добавьте в ресурсный файл любую нужную вам иконку а потом просто укажите номер вашего ресурса:

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

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

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

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

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

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

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

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

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

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

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

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

вот VBA код

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

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

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

у меня такого не было
...
Рейтинг: 0 / 0
29.10.2010, 22:19
    #36928791
Ципихович Эндрю
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как поставить свою иконку в msgbox?
Да Вы можете выложить понятно, Эксель вообще не перевариваю
Чтобы в Ворде Ваш скрипт
Код: 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
29.10.2010, 22:23
    #36928792
michael R
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как поставить свою иконку в msgbox?
ну может получение пути для картинки поменять надо
там вроде по другому
...
Рейтинг: 0 / 0
29.10.2010, 22:38
    #36928800
michael R
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как поставить свою иконку в msgbox?
Ципихович Эндрю ДЛЯ 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
29.10.2010, 22:58
    #36928818
Ципихович Эндрю
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как поставить свою иконку в msgbox?
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
29.10.2010, 23:04
    #36928827
Ципихович Эндрю
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как поставить свою иконку в msgbox?
в этой строке
Код: plaintext
1.
MsgBoxEx "Test1", vbInformation, "Test!", Val( 200 ), Val( 200 ).....
Val(200) это вероятно отступы??
Первый от чего???
Второй от чего???
...
Рейтинг: 0 / 0
29.10.2010, 23:07
    #36928831
michael R
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как поставить свою иконку в msgbox?
Val(200), Val(200)

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


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