Проверка шрифта с фиксированной шириной
Посмотрите в библиотеке console.zip от Danny Thorpe -- он проверяет, является ли шрифт шрифтом с фиксированной шириной. Вот код, который делает это:
|
procedure TConsole.FontChanged(Sender: TObject);
var
DC: HDC;
Save: THandle;
Metrics: TTextMetric;
Temp: String;
begin
if Font.Handle <> FOldFont.Handle then begin DC := GetDC(0); Save := SelectObject(DC, Font.Handle); GetTextMetrics(DC, Metrics); SelectObject(DC, Save); ReleaseDC(0, DC); if not (((Metrics.tmPitchAndFamily and ff_Modern) <> 0) and ((Metrics.tmPitchAndFamily and $01) = 0)) then begin Temp := 'TConsole: ' + Font.Name + ' не является шрифтом с фиксированной шириной'; Font.Name := FOldFont.Name; { Возвращаем предыдущие атрибуты шрифта } raise EInvalidFont.Create(Temp); end; SetMetrics(Metrics); end; FOldFont.Assign(Font); if csDesigning in ComponentState then InternalClrScr; end; |
Andy King. [000728]
