Стандартный TFontDialog не позволяет выбрать произвольный цвет для шрифта. Только из предложенного списка. Однако, возможность выбора любого цвета есть.
Находка не моя. Источник: stackoverflow.
Использовать это сокровище можно так.
Либо оформить отдельным модулем (например, CustomFontDialog).
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 |
unit CustomFontDialog; interface uses Windows, Messages, Graphics, Dialogs; type TFontDialog = class(Dialogs.TFontDialog) const IDCOLORCMB = $473; protected procedure WndProc(var Message: TMessage); override; procedure DoShow; override; end; implementation { TFontDialog } procedure TFontDialog.DoShow; const SMyColorName: PChar = 'Custom...'; CMyColor: TColor = $0033ccff; begin SendDlgItemMessage(Handle, IDCOLORCMB, CB_INSERTSTRING, 0, Integer(SMyColorName)); SendDlgItemMessage(Handle, IDCOLORCMB, CB_SETITEMDATA, 0, ColorToRGB(CMyColor)); end; procedure TFontDialog.WndProc(var Message: TMessage); begin inherited; with Message do if (Msg = WM_COMMAND) and (WParamHi = CBN_SELENDOK) and (WParamLo = IDCOLORCMB) and (SendDlgItemMessage(Handle,IDCOLORCMB,CB_GETCURSEL,0,0)=0) then with TColorDialog.Create(Self) do try Color := TColor(SendDlgItemMessage(Self.Handle, IDCOLORCMB, CB_GETITEMDATA, 0, 0)); Options := [cdFullOpen]; if Execute(Self.Handle) then SendDlgItemMessage(Self.Handle, IDCOLORCMB, CB_SETITEMDATA, 0, ColorToRGB(Color)); finally Free; end; end; end. |
Тогда он должен идти после модуля Dialogs в предложении Uses секции Interface того модуля, где он будет использоваться.
1 2 3 4 5 6 7 |
interface uses Classes, Controls, Forms, StdCtrls, Dialogs // После Dialogs , CustomFontDialog; |
Либо вставить его перед описанием класса формы (или любого другого класса), в котором используется TFontDialog. Ну и соответственно реализация класса также должна быть в том же модуле.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
type TFontDialog = class(Dialogs.TFontDialog) const IDCOLORCMB = $473; protected procedure WndProc(var Message: TMessage); override; procedure DoShow; override; end; TFmMain = class(TForm) FontDialog1: TFontDialog; private { Private declarations } public { Public declarations } end; |
Скачать
Друзья, спасибо за внимание!
Исходник (zip) 58 Кб. Delphi XE 7, XE 10, XE 11
Исполняемый файл (zip) 857 Кб.