Форум: "Начинающим";
Текущий архив: 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.045 c