Переделать MessageDlg

← →
gog © (2016-02-29 16:39) [0]

Всем доброе время суток.

Решил создать свое окно сообщений (подобный 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.

← →
NoUser © (2016-03-01 02:37) [1]

Запиши так:
MessageDlg("Hello", TMsgDlgType.mtInformation, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo], 0);

Или у себя в модуле
mtWarning, mtError, ... mbAbort, mbRetry, ...
замени на
gmtWarning, gmtError, ... gmbAbort, gmbRetry, ...

Или не описывай свои
TGgMsgDlgType, TGgMsgDlgBtn, TGgMsgDlgButtons
а используй "готовые"
TMsgDlgType, TMsgDlgBtn, TMsgDlgButtons

← →
gog © (2016-03-01 08:41) [2]

Спасибо.
Понял суть моей ошибки. Одни и те же имена присвоивал разным переменным

← →
Юрий Зотов © (2016-03-01 21:12) [3]

А не заменить ли все это одной строчкой?

MessageBox(...)

← →
Dimka Maslov © (2016-03-02 18:39) [4]

А если перебить соответствующие ресурсы в файле Consts.pas и добавить его к проекту?

← →
Rouse_ © (2016-03-02 19:34) [5]

> Юрий Зотов © (01.03.16 21:12) [3]
> А не заменить ли все это одной строчкой?
>
> MessageBox(...)

Там только 3 кнопки можно показать :)

← →
Германн © (2016-03-03 01:05) [6]

> Rouse_ © (02.03.16 19:34) [5]
>
>
> > Юрий Зотов © (01.03.16 21:12) [3]
> > А не заменить ли все это одной строчкой?
> >
> > MessageBox(...)
>
> Там только 3 кнопки можно показать :)
>

А кому-то нужно больше, чем три кнопки? :)

← →
sniknik © (2016-03-03 08:34) [7]

да, и еще галочки типа "не спрашивать в дальнейшем", иногда.

← →
Германн © (2016-03-04 00:58) [8]

> sniknik © (03.03.16 08:34) [7]
>
> да, и еще галочки типа "не спрашивать в дальнейшем", иногда.
>
>

Тогда гораздо проще написать свой диалог. :)

← →
gog © (2016-03-04 10:29) [9]

По тому и пишу свой диалог.
Еще TLabel заменил на THTMLabel, чтобы иметь более богатые возможности форматирования текста (цвет, размер фонта для отдельных слов и т.д).
Но вот не смог понять как в стандартном MessageDlg рисуется белый фон под сообшение (Win7).

← →
Игорь Шевченко © (2016-03-04 12:05) [10]

> Но вот не смог понять как в стандартном MessageDlg рисуется
> белый фон под сообшение

RTFS: Dialogs.pas

← →
gog © (2016-03-04 13:22) [11]

RTFS: Dialogs.pas
что это?
За основу я и взал Dialogs.pas

← →
Игорь Шевченко © (2016-03-04 14:51) [12]

> За основу я и взал 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;
>
> для главной формы приложения работает.

Не работает этот код нормально никогда. Да и не может никогда нормально работать.
Ты уж разберись сам с собой что ты хочешь создать? Свой класс или свою форму.

> Не работает этот код нормально никогда.

Почему это? до первой перерисовки формы он вполне работает :)

Переделать MessageDlg Найти похожие ветки