Конференция "Начинающим" » Переделать MessageDlg
 
  • gog © (29.02.16 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 © (01.03.16 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 © (01.03.16 08:41) [2]
    Спасибо.
    Понял суть моей ошибки. Одни и те же имена присвоивал разным переменным
  • Юрий Зотов © (01.03.16 21:12) [3]
    А не заменить ли все это одной строчкой?

    MessageBox(...)
  • Dimka Maslov © (02.03.16 18:39) [4]
    А если перебить соответствующие ресурсы в файле Consts.pas и добавить его к проекту?
  • Rouse_ © (02.03.16 19:34) [5]

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

    Там только 3 кнопки можно показать :)
  • Германн © (03.03.16 01:05) [6]

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

    А кому-то нужно больше, чем три кнопки? :)
  • sniknik © (03.03.16 08:34) [7]
    да, и еще галочки типа "не спрашивать в дальнейшем", иногда.
  • Германн © (04.03.16 00:58) [8]

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

    Тогда гораздо проще написать свой диалог. :)
  • gog © (04.03.16 10:29) [9]
    По тому и пишу свой диалог.
    Еще TLabel заменил на THTMLabel, чтобы иметь более богатые возможности форматирования текста (цвет, размер фонта для отдельных слов и т.д).
    Но вот не смог понять как в стандартном MessageDlg рисуется белый фон под сообшение (Win7).
  • Игорь Шевченко © (04.03.16 12:05) [10]

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


    RTFS: Dialogs.pas
  • gog © (04.03.16 13:22) [11]
    RTFS: Dialogs.pas
    что это?
    За основу я и взал Dialogs.pas
  • Игорь Шевченко © (04.03.16 14:51) [12]

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


    И что тебе тогда непонятно ? Там все написано, внутри
  • gog © (07.03.16 13:11) [13]
    Ну не рисуется белый прямоугольник.
    Написал такой код (отдельно):

    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;

    для главной формы приложения работает.
    Чего то не хватает при создании формы динамически?
  • Игорь Шевченко © (07.03.16 21:44) [14]
    gog ©   (07.03.16 13:11) [13]


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


    Не в то время рисуешь. Попробуй рисовать в событии OnPaint формы
  • Германн © (09.03.16 00:20) [15]

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

    Не работает этот код  нормально никогда. Да и не может никогда нормально работать.
    Ты уж разберись сам с собой что ты хочешь создать? Свой класс или свою форму.
  • Kilkennycat © (09.03.16 22:53) [16]

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

    Почему это? до первой перерисовки формы он вполне работает :)
  • Eraser © (11.03.16 00:08) [17]

    > gog ©   (29.02.16 16:39) 

    возможно все изобрели до нас? см. TTaskDialog
 
Конференция "Начинающим" » Переделать MessageDlg
Есть новые Нет новых   [134428   +41][b:0][p:0.001]