|
TFontDialog で標準以外のサイズを選択肢に表示したい
|
> ルビをうつフォントを指定しようと思い、TFontDialogで
> 片付けようと思いましたが、TFontDialogで、MSゴシック
> など8Pt以下のポイントが出てきません。指定できるように
> する方法をどなたかご存知でしょうか。
思いっきり強引ですけど
unit FontDialogEx;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs;
type
TFontDialogEx = class(TFontDialog)
protected
function TaskModalDialog(DialogFunc: Pointer;
var DialogData): Bool; override;
end;
procedure Register;
implementation
uses Dlgs, CommDlg;
const
WM_FONTDIALOGEX = WM_USER + 256;
str1: string = '4';
str2: string = '5';
str3: string = '6';
str4: string = '7';
var
OldHook: function(Wnd: HWnd; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): UINT; stdcall;
function FontDialogHookEx(Wnd: HWnd; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): UINT; stdcall;
begin
if (Msg = WM_COMMAND) and (LOWORD(WParam) = cmb1) then begin
PostMessage(Wnd, WM_FONTDIALOGEX, 0, 0);
end;
if Msg = WM_FONTDIALOGEX then begin
SendDlgItemMessage(Wnd, cmb3, CB_RESETCONTENT, 0, 0);
SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str1)));
SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str2)));
SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str3)));
SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str4)));
Result := 1;
exit;
end;
Result := OldHook(Wnd, Msg, WParam, LParam);
end;
function TFOntDialogEx.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
begin
OldHook := TChooseFont(DialogData).lpfnHook;
TChooseFont(DialogData).lpfnHook := FontDialogHookEx;
inherited TaskModalDialog(DialogFunc, DialogData);
end;
procedure Register;
begin
RegisterComponents('NkCtrls', [TFontDialogEx]);
end;
end.
一応動いてます(^^ フォント名毎に表示するサイズリストを変えたい場合は、cmb1 に選択されているフォント名を確認するコードが必要になるでしょう。
一瞬元のポイントサイズがコンボボックスに表示されてしまいますが今のところ他に良い手を思いつきません(^^; |
|
