VPF::Своя иконка в MessageBox - Форум программистов

aktuba

Дата 12.10.2006, 21:44 (ссылка)

(нет голосов)

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38

Весь вопрос в названии... smile

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

smartov

Дата 12.10.2006, 23:02 (ссылка)

(нет голосов)

Загрузка ...

свой собственный

Профиль
Группа: Экс. модератор
Сообщений: 4225
Регистрация: 2.2.2006
Где: NJ

Репутация: 1
Всего: 259

Сделай свой MessageBox. Имхо проще будет

Добавлено @ 23:03
Знаю что не то что ты спрашивал, просто я легких способов свою икону впихнуть не знаю, и самым простым выходом вижу создание свое формы. Программа возможно еще и меньше места занимать будет без лишнего модуля.

Yanis

Дата 12.10.2006, 23:14 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Код

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;

Добавлено @ 23:16
Пришлось экспортировать импортировать функцию MessageBoxIndirectA самостоятельно т.к. в модуле Windows она неправильно объявлена.
Если нет желания экспортировать, то можно изменить последнюю строчку функции на такую:

Код

Result := Integer(MessageBoxIndirect(mbp));

Это сообщение отредактировал(а) Yanis - 13.10.2006, 10:13

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

*щёлк*

aktuba

Дата 13.10.2006, 02:14 (ссылка)

(нет голосов)

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38

Yanis - ОГРОМНОЕ СПАСИБО. Как наберу кол-во постов, нажму '+'. Кстати, вопрос к тебе-же: где можно найти такую информацию? И не только такую, но и побольще smile

. Я имею в виду, кроме MSDN.

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

Mr.Floppy

Дата 13.10.2006, 06:41 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 106
Регистрация: 3.7.2006
Где: Москва

Репутация: 1
Всего: 1

Спасибо, Yanis, я тоже раньше задавался этим вопросом. ;)

Добавлено @ 06:55
(а у меня были мысли искать хендл, потом рисовать на канве, оказывается, всё намного проще! smile

)
Надо бы добавить в DRKB...

Mr.Floppy

Дата 13.10.2006, 07:00 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 106
Регистрация: 3.7.2006
Где: Москва

Репутация: 1
Всего: 1

А есть ли возможность добавлять свои элементы в диалог (например, Checkbox), не переделывая его самому "с нуля"?

Yanis

Дата 13.10.2006, 08:15 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Цитата(aktuba @ 13.10.2006, 03:14

)

Я имею в виду, кроме MSDN.

Смотря что тебе нужно... Но MSDN читать нужно полюбому smile

Но не нужно ограничиваться статьями. Купе себе книжку. Это же так интересно - читать!

Цитата(Mr.Floppy @ 13.10.2006, 08:00

)

А есть ли возможность добавлять свои элементы в диалог (например, Checkbox), не переделывая его самому "с нуля"?

http://vingrad.ru/DELPHI-DLP-000833

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

*щёлк*

aktuba

Дата 13.10.2006, 08:59 (ссылка)

(нет голосов)

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38

А какие книги посоветуешь? Я, так понимаю, что-то по устройству Windows? Можешь дать названия?

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

Yanis

Дата 13.10.2006, 09:40 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Цитата(aktuba @ 13.10.2006, 09:59

)

А какие книги посоветуешь? Я, так понимаю, что-то по устройству Windows? Можешь дать названия?

Для начинающих помоему нет разницы что читать (не бейте меня smile

), главное что книга и что бы там объяснялось про устройство виндов, работу VCL. Даже и не знаю какие сейчас книги то хорошие для новичков есть.... Snowy может подскажет smile

Для Mr.Floppy
Вот ещё один способ добавления элемента управления в MessageBox:

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  g_hHook: HHOOK;
  g_oldProc: Pointer = nil;
  g_bChecked: Boolean = False;
  g_cb: TCheckBox;
  g_szCbCaption: string = '';

const
  IDC_CHECKBOX = 1000;

implementation

{$R *.dfm}

// узнаём ширину текста для контекста (HDC) определённого окна (hWnd)
function GetTextWidth(hWnd: HWND; const szCaption: string): Integer;
var
  Res: TSize;
begin
  ZeroMemory(@Res, SizeOf(Res));
  GetTextExtentPoint32(GetWindowDC(hWnd), PChar(szCaption), Length(szCaption), Res);
  Result := Res.cx;
end;

function MyMessageBox(hWnd: HWND; const szText, szCaption, szCheckBoxCaption: string; uType: UINT): Integer;
begin
  g_szCbCaption := szCheckBoxCaption;
  Result := MessageBox(hWnd, PChar(szText), PChar(szCaption), uType);
end;

procedure CreateCheckBox(hWndOwner: HWND);
begin
  g_cb := TCheckBox.Create(Application);
  with g_cb do
    begin
      ParentWindow := hWndOwner;
      g_cb.Caption := g_szCbCaption;
      Checked := True;
      g_cb.Width := GetTextWidth(g_cb.Handle, g_szCbCaption);
      SetWindowLong(Handle, GWL_ID, IDC_CHECKBOX);
    end;
end;

procedure UnInstallHook(m_gHook: HHOOK);
begin
    // Uninstall the hook
    UnhookWindowsHookEx(m_gHook);
end;

function SetOut: Boolean;
begin
  g_cb.Checked := not g_cb.Checked;
end;

function HookWndProc(hWnd: HWND; uMsg, wParam, lParam: Integer): Integer; stdcall;
var
  nRc: Integer;
begin
  // дадим ОС обработать основные операции
  nRc := CallWindowProc(g_oldProc, hWnd, uMsg, wParam, lParam);

  // если диалог хочет загрузиться, то...
  if (uMsg = WM_INITDIALOG) then
      begin
      // создаём на нём кнопку
      CreateCheckBox(hWnd);
    end;

  // если кликнули по checkbox-у
  // на это указывает его nID
    if (uMsg = WM_COMMAND) and (wParam = IDC_CHECKBOX) then
    SetOut; // обрабатываем нажатие на checkbox

  // если диалог уничтожается, то...
    if (uMsg = WM_NCDESTROY) then
    begin
        UnInstallHook(g_hHook);
      FreeAndNil(g_cb);
    end;

  Result := nRc;
end;

// функция ловушки нашего приложения
function SetHook(nCode, wParam, lParam: Integer): Integer; stdcall;
var
  M: TCWPStruct;
begin
  if (nCode = HC_ACTION) then
    begin
      M := TCWPStruct(Pointer(lParam)^);

      // если нам пришло сообщение, что сейчас будет создан checkbox, то ....
      if M.message = WM_INITDIALOG then
        g_oldProc := Pointer(SetWindowLong(M.hwnd, GWL_WNDPROC, Integer(@HookWndProc)));
    end;

  Result := CallNextHookEx(g_hHook, nCode, wParam, lParam);
end;

// устанавливаем ловушку на все сообщения, которые
// предназначаются оконной процедуре
// мы будем их обрабатывать перед оконной процедурой
function InstallHook: HHOOK;
begin
    g_hHook := SetWindowsHookEx(WH_CALLWNDPROC,
                              @SetHook, // процедура обработки ловушки
                              0,
                              GetCurrentThreadId()); // ассоциируем ловушку с текущим (потоком нешего окна) потоком
  Result := g_hHook;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  InstallHook;
  MyMessageBox(Handle, 'Исходные данные будут перезаписаны!', 'Продолжить?', 'Больше не предупреждать меня', MB_ICONQUESTION or MB_YESNO)
end;

end.

Изменение расположения CheckBox оставляю на тебя. Заодно и по коду пробежишься. Комменты имеются.

Это сообщение отредактировал(а) Yanis - 13.10.2006, 09:41

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

*щёлк*

aktuba

Дата 13.10.2006, 10:35 (ссылка)

(нет голосов)

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38

Спасибо...

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

AndreyVoronov

Дата 21.12.2019, 20:17 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 21.12.2019

Репутация: нет
Всего: нет

Yanis, Здравствуйте, подскажите пожалуйста, я вот использовал ваш код из этой темы из поста "Вот ещё один способ добавления элемента управления в MessageBox" так как не смог найти какой-то другой код который бы вставлял CheckBox именно в MessageBox, в интернете куча примеров где вставляют CheckBox в MessageDialog но он мне не подходит мне нужен именно MessageBox. Так вот, ваш код работает нормально но я в программе использую тему оформления, после того как выбираю любую тему оформления из стандартных Delphi (моя версия кстати Delphi 10.2) то происходит странное, когда при запуске программы в первый раз нажимаю кнопку с вашим кодом он отрабатывает нормально но когда второй раз нажимаю эту кнопку то программа зависает и закрывается, без темы оформления все работает нормально! Не могу понять как тема оформления может на это влиять? Дело точно в ней так как проверял все на чистом проекте. Помогите разобраться, как сделать чтобы код работал с темой оформления нормально? И еще как поменять цвет текста и цвет фона у CheckBox в MessageBox'е? Заранее очень благодарен за помощь.

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »