Получить список CharSets, поддерживаемых шрифтом

Советы » Шрифты » Получить список CharSets, поддерживаемых шрифтом

type

TNewTextMetricEx = packed

record

NewTextMetric: TNewTextMetric; FontSignature: TFontSignature end

; TCharSetRec = packed

record

Name: string

; ID: Integer end

; const

NumCharSets = 19; CharSets: array

[0..NumCharSets - 1] of

TCharSetRec = ((Name: 'ANSI_CHARSET'; ID: 0), (Name: 'DEFAULT_CHARSET'; ID: 1), (Name: 'SYMBOL_CHARSET'; ID: 2), (Name: 'SHIFTJIS_CHARSET'; ID: $80), (Name: 'HANGEUL_CHARSET'; ID: 129), (Name: 'GB2312_CHARSET'; ID: 134), (Name: 'CHINESEBIG5_CHARSET'; ID: 136), (Name: 'OEM_CHARSET'; ID: 255), (Name: 'JOHAB_CHARSET'; ID: 130), (Name: 'HEBREW_CHARSET'; ID: 177), (Name: 'ARABIC_CHARSET'; ID: 178), (Name: 'GREEK_CHARSET'; ID: 161), (Name: 'TURKISH_CHARSET'; ID: 162), (Name: 'VIETNAMESE_CHARSET'; ID: 163), (Name: 'THAI_CHARSET'; ID: 222), (Name: 'EASTEUROPE_CHARSET'; ID: 238), (Name: 'RUSSIAN_CHARSET'; ID: 204), (Name: 'MAC_CHARSET'; ID: 77), (Name: 'BALTIC_CHARSET'; ID: 186)); function

EnumProc(const

EnumLogFontEx: TEnumLogFontEx; const

NewTextMetricEx: TNewTextMetricEx; FontType: Integer; Strings: TStrings): Integer; stdcall

; var

I: Integer; ID: Integer; S: string

; begin

ID := EnumLogFontEx.elfLogFont.lfCharSet; S := Format('Unknown charset %d', [ID]); for

I := 0 to

NumCharSets - 1 do

if

CharSets[I].ID = ID then

begin

S := CharSets[I].Name; Break; end

; Strings.Add(S); Result := 1 end

; procedure

GetAvailableCharSets(const

FaceName: string

; CharSets: TStrings); var

DC: THandle; LogFont: TLogFont; begin

DC := GetDC(GetDesktopWindow); if

DC <> 0 then

try

FillChar(LogFont, SizeOf(LogFont), 0); Move(FaceName[1], LogFont.lfFaceName, Length(FaceName)); LogFont.lfCharSet := DEFAULT_CHARSET; EnumFontFamiliesEx(DC, LogFont, @EnumProc, lParam(CharSets), 0); finally

ReleaseDC(GetDesktopWindow, DC) end

end

; procedure

TForm1.Button1Click(Sender: TObject); begin

Memo1.Clear; GetAvailableCharSets('Arial Narrow Bold', Memo1.Lines); end

;

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

Категории

Статьи

Советы

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