Текущий архив: 2004.09.05;
Скачать: CL | DM;

Вниз

прошу помогите с фонтами. думаю об этом и статьу можна написать   Найти похожие ветки 

← →
nika_ufc ©   (2004-08-21 03:49) [0]

Здравствуйте. Подскажите как можно извлечь информацию из фонта ?
очень долго мучился, искал и наконец написал программу которая определяет какие CharSet поддерживает фонт.

вот этот код:

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;

type
 TForm1 = class(TForm)
   Memo1: TMemo;
   ComboBox1: TComboBox;
   procedure ComboBox1Change(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

 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));

var
 Form1: TForm1;

implementation

{$R *.dfm}

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.ComboBox1Change(Sender: TObject);
begin
 Memo1.Clear;
 GetAvailableCharSets(ComboBox1.Text, Memo1.Lines);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    ComboBox1.Items.Assign(Screen.Fonts);
end;

end.

сейчас я хочу:
1. узнать число символов в фонте.
2. является ли этот фонт Unicode или что то другое (ДОС, Unicode, ANSI ...)
3. и получить все Code Pages которые поддерживает указанный фонт.

Думаю, первую проблему можно легко решить если воспользуюсь GetFontUnicodeRanges это будет в полне

достатачно для определения числа символов в фонте. структура второго параметра GetFontUnicodeRanges:
typedef struct tagGLYPHSET {
DWORD cbThis;
DWORD flAccel;
DWORD cGlyphsSupported;
DWORD cRanges;
WCRANGE ranges[1];
} GLYPHSET, *PGLYPH
Вот об flAccel написано :Flags describing the maximum size of the glyph indices. и по моему это то что мне надо.
но из за того что ранше часто не работал с АПИ и тем более с фонтамы, я никак не могу написать правильный код.

Пишу вот так но не работает:

procedure TForm1.ListBox1Click(Sender: TObject);
var
 idx: integer;
 strFont: string;
 glp: PGLYPHSET;
begin
 idx := ListBox1.ItemIndex;
 if idx < 0 then exit;
 new(glp);
 getmem(glp, sizeof(PGLYPHSET));
 strFont := Listbox1.Canvas.font.Name;
 Listbox1.Canvas.font.Name := listbox1.Items[idx];
 GetFontUnicodeRanges(listbox1.Canvas.Handle, glp);
 Listbox1.Canvas.font.Name := strFont;
 Showmessage(intToStr(glp.cGlyphsSupported)+inttostr(glp.flAccel));
 dispose(glp); //выдает ACCESS VIOLATION
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    ListBox1.Items.Assign(Screen.Fonts);
end;

допустим я исправил ошибку, вернет ли glp.flAccel или glp.cGlyphsSupported (про glp.cGlyphsSupported сказана -

"Total number of Unicode code points supported in the font.") число символов в фонте. не только Unicode но и все

остальные. если я ошибаюсь пожалуйста скажите как сделать.

Вторая прблема. Как решать не знаю и на ум толко GetFontUnicodeRanges приходит. А как использовать его не знаю.

помагите и здесь ПЛЗ.

на третем и закончим. Как узнать (програмно, разумеется) поддерживает *.ttf кириллицу или нет? но не толка

кириллицу но и все остальные Code Pages в зависимости от того этот фоннт являеться Unicode или АНСИ. см. Code

Pages:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/intl/unicode_63ub.asp

Знаю что на эту тему можна написать большую книгу, но будьте милосердны и помогите меня, объясните

пожалуйста досканалньо что делать, как решить каждую из проблем. Буду очень благодарен. а может и получиться

из этого отличная статья.

спасибо за помощ заранее.

---

← →
TUser ©   (2004-08-21 08:22) [1]

См. в архиве.

---

← →
nika_ufc ©   (2004-08-21 10:16) [2]

>>TUser ©
>>>См. в архиве
Уже сматрел, ничего интересного, ответы тем более. Здесь у меня конкретные проблемы и я прошу дать конкретные решения.
Спасибо за отклик.

---

Страницы: 1 вся ветка

Текущий архив: 2004.09.05;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.034 c