Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2007.08.19;
Скачать: [xml.tar.bz2];

Вниз

messagebox   Найти похожие ветки 

 
copron   (2007-07-27 00:03) [0]

Можно ли с помощью этой команды помимо кнопок выводить и checkbox. Просто в английском я не силен и справка далась только на 1/3.
Если нет, то чем можно заменить? Просто не хочется отдельную форму делать


 
ProgRAMmer Dimonych ©   (2007-07-27 00:25) [1]

> copron   (27.07.07 00:03)  
> Можно ли с помощью этой команды помимо кнопок выводить и
> checkbox. Просто в английском я не силен и справка далась
> только на 1/3.
> Если нет, то чем можно заменить? Просто не хочется отдельную
> форму делать

Хочешь что-то типа "Больше не спрашивать" добавить? Боюсь, что MessageBox здесь не поможет. Действительно придётся делать отдельную форму. Ну, или другие более извращённые способы искать.


 
Yanis ©   (2007-07-27 08:22) [2]

Сначала самый изъезженный код (взят из DRKB):
Var
AMsgDialog: TForm;
ACheckBox: TCheckBox;
begin
AMsgDialog := CreateMessageDialog("This is a test message.", mtWarning, [mbYes, mbNo]);

ACheckBox := TCheckBox.Create(AMsgDialog);
with AMsgDialog do
try
  Caption := "Dialog Title" ;
  Height := 169;

  With ACheckBox do
  begin
    Parent := AMsgDialog;
    Caption := "Do not show me again.";
    top := 121;
    Left := 8;
  end;

  Case ShowModal of
    ID_YES: ;//здесь Ваш код после того как диалог будет закрыт
    ID_NO:  ;
  end;
  If ACheckBox.Checked then
  begin
    //...
 end;
finally
  ACheckBox.Free;
  Free;
end;


Более интересный вариант:
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.

(с) Yanis
http://forum.vingrad.ru/index.php?showtopic=116210&view=findpost&p=887225


 
copron   (2007-07-27 11:56) [3]

ProgRAMmer Dimonych
Да именно это я и хотел сделать.

Всем спасибо! Дальше думаю сам разберусь.



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2007.08.19;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.044 c
3-1178297884
Oleg_teacher
2007-05-04 20:58
2007.08.19
BatchMove копирование


1-1181570755
LSD
2007-06-11 18:05
2007.08.19
File not found: fCtrls.dcu


1-1180368669
Dmitry_177
2007-05-28 20:11
2007.08.19
Перехват клавиатуры


3-1178306803
IMHO
2007-05-04 23:26
2007.08.19
Delphi and ESE


15-1185096694
DeadMeat
2007-07-22 13:31
2007.08.19
Грустно, но зачастую правда.





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский