Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Переделать MessageDlg

gog © (2016-02-29 16:39:00)
Всем доброе время суток.

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

Eraser (2016-03-11 00:08:00) [1]

> gog © (29.02.16 16:39)

возможно все изобрели до нас? см. TTaskDialog

Kilkennycat (2016-03-09 22:53:00) [2]

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

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

Германн (2016-03-09 00:20:00) [3]

> Когда код:
>
> procedure TForm1.Button5Click(Sender: TObject);
> begin
> Canvas.Brush.Style:= bsSolid;
> Canvas.Brush.Color:= clRed;
> Canvas.FillRect(Rect(0,0,50,50));
> end;
>
> для главной формы приложения работает.

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

Игорь Шевченко (2016-03-07 21:44:00) [4]
gog © (07.03.16 13:11) [13]

> Ну не рисуется белый прямоугольник.

Не в то время рисуешь. Попробуй рисовать в событии OnPaint формы

gog (2016-03-07 13:11:00) [5]
Ну не рисуется белый прямоугольник.
Написал такой код (отдельно):

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;

для главной формы приложения работает.
Чего то не хватает при создании формы динамически?

Игорь Шевченко (2016-03-04 14:51:00) [6]

> За основу я и взал Dialogs.pas

И что тебе тогда непонятно ? Там все написано, внутри

gog (2016-03-04 13:22:00) [7]
RTFS: Dialogs.pas
что это?
За основу я и взал Dialogs.pas

Игорь Шевченко (2016-03-04 12:05:00) [8]

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

RTFS: Dialogs.pas

gog (2016-03-04 10:29:00) [9]
По тому и пишу свой диалог.
Еще TLabel заменил на THTMLabel, чтобы иметь более богатые возможности форматирования текста (цвет, размер фонта для отдельных слов и т.д).
Но вот не смог понять как в стандартном MessageDlg рисуется белый фон под сообшение (Win7).

Германн (2016-03-04 00:58:00) [10]

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

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

sniknik (2016-03-03 08:34:00) [11]
да, и еще галочки типа "не спрашивать в дальнейшем", иногда.

Германн (2016-03-03 01:05:00) [12]

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

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

Rouse_ (2016-03-02 19:34:00) [13]

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

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

Dimka Maslov (2016-03-02 18:39:00) [14]
А если перебить соответствующие ресурсы в файле Consts.pas и добавить его к проекту?

Юрий Зотов (2016-03-01 21:12:00) [15]
А не заменить ли все это одной строчкой?

MessageBox(...)

gog (2016-03-01 08:41:00) [16]
Спасибо.
Понял суть моей ошибки. Одни и те же имена присвоивал разным переменным

NoUser (2016-03-01 02:37:00) [17]
Запиши так:
MessageDlg('Hello', TMsgDlgType.mtInformation, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo], 0);

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

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

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »