گرفتن لیست 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);