| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

прошу помогите с фонтами. думаю об этом и статьу можна написать [D7, Win2k]

nika_ufc ©   (2004-08-21 03:49:00) 

Здравствуйте. Подскажите как можно извлечь информацию из фонта ?
очень долго мучился, искал и наконец написал программу которая определяет какие 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

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

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

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

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

---

nika_ufc   (2004-08-21 10:16:00) [1]

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

---

TUser   (2004-08-21 08:22:00) [2]

См. в архиве.

---

Наверх