گرفتن لیست charset ها

[Sohrab_Tapar]

وقتی در object inspector ,
font را باز میکنی(expand میکنی),
یک گزینه charset داره
چطور میشه لیست item های این combobox را به دست آورد

[مهدی کرامتی]

برای یک فونت بخصوص یا لیست کل Charset‌ ها را میخواهید؟

[Sohrab_Tapar]

charset های یک فونت خاص
البته اگه ممکنه مورد دوم را هم بگین

[مهدی کرامتی]

این کد را ببینید:

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
Strings.Clear;
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;

نحوه استفاده:

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