|
|
|
|
Delphi 1
Проверка шрифта с фиксированной шириной
Посмотрите в библиотеке 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]
|
|
|
|
|