Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[13.59.220.223] |
|
Сообщ.
#1
,
|
|
|
Цветным? Синий ShowMessage, красный ShowMessage, зеленый ShowMessage?
Ну а вообще, почему бы и нет? 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. Это сообщение было перенесено сюда или объединено из темы "ShowMessage - нельзя ли цветным сделать?" |
Сообщ.
#2
,
|
|
|
Вот такие варианты можно использовать:
1) Стандартный ShowMessage (описан в Dialogs.pas) использует CreateMessageDialog(...): TForm для получения диалога. Так что можно самостоятельно его получить и выполнить "раскраску" его элементов самостоятельно. На нем располагаются: а) для отображения текста: компонент TLabel с именем "Message"; б) для иконки: компонент TImage с именем "Image"; в) кнопки TButton в зависимости от опций с именами "Yes", "No", "OK", "Cancel", "Abort", "Retry", "Ignore", "All", "NoToAll", "YesToAll", "Help". Так что можно использовать конструкции вида: ... 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; 2) создать свою форму для сообщений и использовать дизайнер Delphi, имея полную свободу действий. |
Сообщ.
#3
,
|
|
|
Вариант с перехватом форм ShowMessage\MessageDlg по Screen.OnActiveFormChange
type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } procedure DoCustomizeMessageForm(Sender:TObject); procedure CustomizeMessageFont(_Color,_dSize:integer;_Style:TFontStyles;const _Name:string); end; var Form1: TForm1; implementation {$R *.dfm} type TMsgFontParams = record Color:integer; Style:TFontStyles; dSize:integer; Name:String; _SaveProc:TNotifyEvent; end; var MsgFontParams:TMsgFontParams; procedure TForm1.CustomizeMessageFont(_Color,_dSize:integer;_Style:TFontStyles;const _Name:string); begin with MsgFontParams do begin _SaveProc:=Screen.OnActiveFormChange; Color:=_Color; dSize:=_dSize; Style:=_Style; Name:=_Name; end; Screen.OnActiveFormChange:=DoCustomizeMessageForm; end; procedure TForm1.DoCustomizeMessageForm(Sender:TObject); var F:TForm;L:TLabel; i,dH:integer; begin try F:=Screen.ActiveForm; if (F <> Nil) and F.ClassNameIs('TMessageForm') then begin dH:=0; for i:=0 to F.ControlCount-1 do if F.Controls[i] is TLabel then begin L:=TLabel(F.Controls[i]); dH:=L.Height; with L.Font do begin Color:=MsgFontParams.Color; Style:=MsgFontParams.Style; Size:=Size+MsgFontParams.dSize; if MsgFontParams.Name <> '' then Name:=MsgFontParams.Name; dH:=L.Height-dH; if dH <= 0 then Break; end; end else //смещаем кнопки при изменении высоты TLabel //(!!! в Controls кнопки идут после TLabel) if (dH > 0) and (F.Controls[i] is TButton) then with F.Controls[i] do Top:=Top+dH; if dH > 0 then F.Height:=F.Height+dH; end; if Assigned(MsgFontParams._SaveProc) then MsgFontParams._SaveProc(Sender); finally //!!! воcстанавливаем прежний обработчик или Nil Screen.OnActiveFormChange:=MsgFontParams._SaveProc; end; end; procedure TForm1.Button1Click(Sender: TObject); begin CustomizeMessageFont(clRed,0,[],''); MessageDlg('Hello, World!',mtInformation,[mbYes,mbNo],0); CustomizeMessageFont(clBlue,4,[fsBold,fsItalic],'Times New Roman'); ShowMessage('Hello, World!'); //стандартный стиль ShowMessage('Hello, World!'); end; |