-
Всем доброе время суток.
Решил создать свое окно сообщений (подобный MessageDlg) где для начала заголовок окна и надписи на кнопках будут выдаваться на национальном языке. В дальнейшем предполагается ввод других изменений в действиях стандартного MessageDlg. Но наткнулся на проблему с самого начала. Вот текст программы:
unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, MyMessageDlg;
type TForm1 = class(TForm) Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end;
var Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject); begin MessageDlg('Hello', mtInformation, [mbYes, mbNo], 0); end;
procedure TForm1.Button2Click(Sender: TObject); begin GgMessageDlg('Hello', mtInformation, [mbYes, mbNo], 0); end;
end.
--------------------------------------------------------------------
unit MyMessageDlg;
interface
uses Windows, Classes, Forms, Dialogs;
resourcestring { Georgian message dialog }
SGgMsgDlgWarning = 'გაფრთხილება'; SGgMsgDlgError = 'შეცდომა'; SGgMsgDlgInformation = 'ინფორმაცია'; SGgMsgDlgConfirm = 'დადასტურება'; { SGgMsgDlgSkip = 'ÂÀÌÏÔÏÅÄ'; SGgMsgDlgReplace = 'ÛÄÝÅÀËÄ'; SGgMsgDlgDelete = 'ßÀÛÀËÄ'; SGgMsgDlgYes = 'ÃÉÀá'; SGgMsgDlgNo = 'ÀÒÀ'; SGgMsgDlgOK = 'Ok'; SGgMsgDlgCancel = 'ÃÀáÖÒÄ'; SGgMsgDlgHelp = 'ÃÀáÌÀÒÄÁÀ'; SGgMsgDlgHelpNone = 'ÀÒ ÀÒÓÄÁÏÁÓ ÃÀáÌÀÒÄÁÉÓ ×ÀÉËÉ'; SGgMsgDlgHelpHelp = 'ÀáÌÀÒÄÁÀ'; SGgMsgDlgAbort = 'ÛÄßÚÅÉÔÄ'; SGgMsgDlgRetry = 'ÂÀÉÌÄÏÒÄ'; SGgMsgDlgIgnore = '&Ignore'; SGgMsgDlgAll = 'ÚÅÄËÀ'; SGgMsgDlgNoToAll = 'ÀÒÀ ÚÅÄËÀÓÈÅÉÓ'; SGgMsgDlgYesToAll = 'ÃÉÀá ÚÅÄËÀÓÈÅÉÓ'; SGgMsgDlgShow = 'ÌÀÜÅÄÍÄ'; SGgMsgDlgPrint = 'ÃÀÁÄàÃÄ'; SGgMsgDlgClipboard = 'ÁÖ×ÄÒÛÉ'; }
type
TGgMessageForm = class(TForm) private procedure HelpButtonClick(Sender: TObject); public constructor CreateNew(AOwner: TComponent); end;
TGgMsgDlgType = (mtWarning, mtError, mtInformation, mtConfirmation, mtCustom); TGgMsgDlgBtn = (mbSkip, mbReplace, mbDelete, mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp, mbShow, mbPrint, mbClipboard); TGgMsgDlgButtons = set of TGgMsgDlgBtn;
var Captions: array[TGgMsgDlgType] of Pointer = (@SGgMsgDlgWarning, @SGgMsgDlgError, @SGgMsgDlgInformation, @SGgMsgDlgConfirm, nil);
function GgCreateMessageDialog(const Msg: string; DlgType: TGgMsgDlgType; Buttons: TGgMsgDlgButtons): TForm;
function GgMessageDlg(const Msg: string; DlgType: TGgMsgDlgType; Buttons: TGgMsgDlgButtons; HelpCtx: Longint): Integer; overload;
implementation
{ TGgMessageForm }
procedure TGgMessageForm.HelpButtonClick(Sender: TObject); begin Application.HelpContext(HelpContext); end;
constructor TGgMessageForm.CreateNew(AOwner: TComponent); var NonClientMetrics: TNonClientMetrics; begin inherited CreateNew(AOwner); Position:= poScreenCenter; end;
{ GgMessageDlg }
function GgCreateMessageDialog(const Msg: string; DlgType: TGgMsgDlgType; Buttons: TGgMsgDlgButtons): TForm;
begin Result := TGgMessageForm.CreateNew(Application); with Result do begin
end; end;
function GgMessageDlg(const Msg: string; DlgType: TGgMsgDlgType; Buttons: TGgMsgDlgButtons; HelpCtx: Longint): Integer; overload; begin with GgCreateMessageDialog(Msg, DlgType, Buttons) do begin Result:= ShowModal; end; end;
end.
При компиляции выдается ошибка: There is no overloaded version of "MessageDlg" that can be called with these arguments
Если обработчик Button1Click закомментировать, то все работает. Помогите разобраться где допускаю ошибку? Ведь имена у функций разные.
Версии: Дельфи ХЕ, Win7.
-
Запиши так: MessageDlg('Hello', TMsgDlgType.mtInformation, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo], 0); Или у себя в модуле mtWarning, mtError, ...
mbAbort, mbRetry, ... замени на gmtWarning, gmtError, ...
gmbAbort, gmbRetry, .. . Или не описывай свои TGgMsgDlgType, TGgMsgDlgBtn, TGgMsgDlgButtons а используй 'готовые' TMsgDlgType, TMsgDlgBtn, TMsgDlgButtons
-
Спасибо. Понял суть моей ошибки. Одни и те же имена присвоивал разным переменным
-
А не заменить ли все это одной строчкой?
MessageBox(...)
-
А если перебить соответствующие ресурсы в файле Consts.pas и добавить его к проекту?
-
> Юрий Зотов © (01.03.16 21:12) [3] > А не заменить ли все это одной строчкой? > > MessageBox(...)
Там только 3 кнопки можно показать :)
-
> Rouse_ © (02.03.16 19:34) [5] > > > > Юрий Зотов © (01.03.16 21:12) [3] > > А не заменить ли все это одной строчкой? > > > > MessageBox(...) > > Там только 3 кнопки можно показать :) >
А кому-то нужно больше, чем три кнопки? :)
-
да, и еще галочки типа "не спрашивать в дальнейшем", иногда.
-
> sniknik © (03.03.16 08:34) [7] > > да, и еще галочки типа "не спрашивать в дальнейшем", иногда. > >
Тогда гораздо проще написать свой диалог. :)
-
По тому и пишу свой диалог. Еще TLabel заменил на THTMLabel, чтобы иметь более богатые возможности форматирования текста (цвет, размер фонта для отдельных слов и т.д). Но вот не смог понять как в стандартном MessageDlg рисуется белый фон под сообшение (Win7).
-
> Но вот не смог понять как в стандартном MessageDlg рисуется > белый фон под сообшение
RTFS: Dialogs.pas
-
RTFS: Dialogs.pas что это? За основу я и взал Dialogs.pas
-
> За основу я и взал Dialogs.pas
И что тебе тогда непонятно ? Там все написано, внутри
-
Ну не рисуется белый прямоугольник. Написал такой код (отдельно):
procedure TForm1.Button6Click(Sender: TObject); var F: TForm; R: TRect; begin F:= TForm.CreateNew(Application); F.Canvas.Brush.Style:= bsSolid; F.Canvas.Brush.Color:= clRed; R:= Rect(0,0,50,50); F.Canvas.FillRect(R); F.ShowModal; F.Free; end;
Форма создается и показывается, но красного прямоугольника там нет. Почему не пойму! Когда код:
procedure TForm1.Button5Click(Sender: TObject); begin Canvas.Brush.Style:= bsSolid; Canvas.Brush.Color:= clRed; Canvas.FillRect(Rect(0,0,50,50)); end;
для главной формы приложения работает. Чего то не хватает при создании формы динамически?
-
gog © (07.03.16 13:11) [13]
> Ну не рисуется белый прямоугольник.
Не в то время рисуешь. Попробуй рисовать в событии OnPaint формы
-
> Когда код: > > procedure TForm1.Button5Click(Sender: TObject); > begin > Canvas.Brush.Style:= bsSolid; > Canvas.Brush.Color:= clRed; > Canvas.FillRect(Rect(0,0,50,50)); > end; > > для главной формы приложения работает.
Не работает этот код нормально никогда. Да и не может никогда нормально работать. Ты уж разберись сам с собой что ты хочешь создать? Свой класс или свою форму.
-
> Не работает этот код нормально никогда.
Почему это? до первой перерисовки формы он вполне работает :)
-
> gog © (29.02.16 16:39)
возможно все изобрели до нас? см. TTaskDialog
|