Главная страница
    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.042 c
2-1185178959
ambhtr
2007-07-23 12:22
2007.08.19
Как из интернета скопировать таблицу


1-1181625378
Василий
2007-06-12 09:16
2007.08.19
Подобие функции StrToFloat. Помогите!


15-1184906287
vasIZmax
2007-07-20 08:38
2007.08.19
Тестирование приложения


15-1185006460
Bratyk
2007-07-21 12:27
2007.08.19
Как сохранить проект в exe - файл


15-1184710325
Германн
2007-07-18 02:12
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
Английский Французский Немецкий Итальянский Португальский Русский Испанский