unit Unit2;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

 

type

  TForm2 = class(TForm)

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

  private

    procedure WMUser(var Message: TMessage); message WM_USER;

  end;

 

var

  Form2: TForm2;

 

implementation

 

{$R *.dfm}

 

procedure TForm2.Button1Click(Sender: TObject);

begin

  PostMessage(Handle, WM_USER, 0, 0);

  MessageBox(Handle, 'This Is A colored Message Box', 'Colored MessageBox.',

    MB_OK or MB_ICONWARNING);

end;

 

function NewOpenWndProc(Wnd: HWND; uMsg: DWORD;

  WParam, LParam:integer): Integer; stdcall;

begin

  case uMsg of

    WM_CTLCOLORSTATIC:

    begin

      Result := CallWindowProc(Pointer(GetWindowLong(Wnd, GWL_USERDATA)),

        Wnd, uMsg, WParam, LParam);

      SetTextColor(WParam, $FF0000);

      Exit;

    end;

    WM_COMMAND:

    begin

      EndDialog(Wnd, 0);

      Exit;

    end;

    WM_NCDESTROY:

      Result := 1;

  else

    Result := CallWindowProc(Pointer(GetWindowLong(Wnd, GWL_USERDATA)),

      Wnd, uMsg, WParam, LParam);

  end;

end;

 

procedure TForm2.WMUser(var Message: TMessage);

var

  hMBHandle: HWND;

begin

  hMBHandle := GetActiveWindow;

  if hMBHandle <> 0 then

    SetWindowLong(hMBHandle, GWL_USERDATA,

      SetWindowLong(hMBHandle, DWL_DLGPROC, DWORD(@NewOpenWndProc)));

end;

 

end.

...

 

uses ..., Dialogs;

 

...

function MyShowMessage( const Msg: string; DlgType: TMsgDlgType = mtInformation; Buttons: TMsgDlgButtons = [mbOK]; HelpCtx: Longint = 0; X: integer = -1; Y: Integer= -1; const HelpFileName: string = '' ) : Integer;

var

   AComp: TComponent;

   ADlgForm : TForm;

begin

   ADlgForm := CreateMessageDialog(Msg, DlgType, Buttons);

 

   with ADlgForm do

   try

      // Раскрашиваем что надо...

         // получить нужный компонент на форме

         AComp := ADlgForm.FindComponent( 'Message' ); // здесь пытаемся получить TLabel для сообщения (имя должно быть "Message")

         if AComp is TLabel then

            TLabel(AComp).Color := clRed; // меняем цвет на красный

 

          ... аналогично можно изменять и остальное ...

          ... можно и добавить новое ...

 

      // Далее стандартно (как в Dialogs.pas:: MessageDlgPosHelp)

      HelpContext := HelpCtx;

      HelpFile := HelpFileName;

      if X >= 0 then Left := X; if Y >= 0 then Top := Y;

      if (Y < 0) and (X < 0) then Position := poScreenCenter;

 

      Result := ShowModal;

 

   finally

      Free;

   end;

end;