Получить свойство шрифта по его дескриптору

Советы » Шрифты » Получить свойство шрифта по его дескриптору

uses

TypInfo; function

MakeFontFromHFont(aHandle: HFONT): TFONT; var

LogFont: TLogFont; begin

Result := TFont.Create; FillChar(LogFont, SizeOf(LogFont), 0); GetObject(aHandle, SizeOf(logfont), @LogFont); with

LogFont, Result do

begin

Name := StrPas(lffaceName); Height := -lfHeight; if

lfWeight FW_MEDIUM then

Style := Style + [fsBold]; if

lfItalic 0 then

Style := Style + [fsItalic]; if

lfUnderline 0 then

Style := Style + [fsUnderline]; if

lfStrikeout 0 then

Style := Style + [fsStrikeout]; case

(lfPitchAndFamily and

3) of

VARIABLE_PITCH: Pitch := fpVariable; FIXED_PITCH: Pitch := fpFixed; end

; end

; end

; procedure

TForm1.Button1Click(Sender: TObject); var

f: TFont; s: string

; st: TFontStyle; begin

f := MakeFontfromHFont(getStockObject(ANSI_FIXED_FONT)); try

memo1.Clear; with

memo1.Lines do

begin

Add(Format('Name: %s', [f.Name])); Add(Format('Size: %d', [f.Size])); Add(Format('Height: %d', [f.Height])); Add(Format('Pitch: %s', [GetEnumName(TypeInfo(TFontPitch), Ord(f.Pitch))])); S := 'Style: [ '; for

st := Low(St) to

High(st) do

if

st in

f.Style then

begin

AppendStr(S, GetEnumName(TypeInfo(TFontStyle), Ord(st))); AppendStr(S, ' '); end

; AppendStr(S, ']'); Add(S); end

; finally

f.Handle := 0; f.Free; end

; end

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com