Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.09.05;
Скачать: [xml.tar.bz2];

Вниз

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

 
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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.031 c
3-1092212181
Koala
2004-08-11 12:16
2004.09.05
Помогите с ХП


4-1090406888
Delphi5.01
2004-07-21 14:48
2004.09.05
Ia pitaus ispolzovat "rar.exe" console dla arhivacii dannih, ...


6-1088778533
Прог
2004-07-02 18:28
2004.09.05
Работа с почтой по pop3


8-1083878953
diaz
2004-05-07 01:29
2004.09.05
Вызов панели настройки видео кодеков


1-1093011809
Lord de Mon
2004-08-20 18:23
2004.09.05
Что такое inherited





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский