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

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

шрифты

copron ©   (2007-12-07 16:54:00) 

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

---

copron   (2007-12-09 21:21:00) [1]

У меня истерика :(

---

copron   (2007-12-09 21:21:00) [2]

Ты не поверишь, но даже твоя прога у меня не работает!

---

Dib@zol   (2007-12-09 21:17:00) [3]

http://webfile.ru/1634476

---

copron   (2007-12-09 21:10:00) [4]

Все равно не пашет :(
Не мог бы ты исходники залить на вебфайл или айфолдер.

---

Dib@zol   (2007-12-09 21:02:00) [5]

Никаких. Попробуй на пустом проекте. У меня сразу заработало...

---

copron   (2007-12-09 20:49:00) [6]

Не помогает :(
Может надо в image какие-нибудь параметры выставить?

---

Dib@zol   (2007-12-09 20:34:00) [7]

Попробуй закомментировать FillRect и SetBkMode.

---

copron   (2007-12-09 20:33:00) [8]

Вот полный текст

unit main;

interface

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

type
 TForm1 = class(TForm)
   Panel1: TPanel;
   Image1: TImage;
   Button1: TButton;
   Image2: TImage;
   Button2: TButton;
   FontDialog1: TFontDialog;
   procedure FormCreate(Sender: TObject);
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

function GetLtrBMP(F:HFONT; L:Char):HBITMAP;
var
DC : HDC;
TF, TB : HGDIOBJ;
S : SIZE;
P : PChar;
R : TRect;
begin
DC:=CreateCompatibleDC(0);
TF:=SelectObject(DC, F);

P:=PChar(string(L));
GetTextExtentPoint32(DC, P, 1, S);
FillChar(R, SIZEOF(TRect), 0);
R.Right:=S.cx;
R.Bottom:=S.cy;
Result:=CreateBitmap(R.Right, R.Bottom, 1, 32, nil);
TB:=SelectObject(DC, Result);

FillRect(DC, R, GetStockObject(GRAY_BRUSH));
SetBkMode(DC, TRANSPARENT);
DrawText(DC, P, 1, R, DT_SINGLELINE or DT_CENTER or DT_VCENTER);

SelectObject(DC, TB);
SelectObject(DC, TF);
DeleteDC(DC);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
image1.Canvas.FillRect(ClientRect);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
fontdialog1.Execute;
image1.Picture.Bitmap.Handle:=GetLtrBMP(fontdialog1.Font.Handle,'d');
end;

end.

---

copron   (2007-12-09 20:24:00) [9]

Ну допустим Arial...
В функции ничего не менял.

---

Dib@zol   (2007-12-09 20:17:00) [10]

Какой шрифт выбираешь? Только что перебрал десяток шрифтов - всё пашет...

---

copron   (2007-12-09 20:11:00) [11]

то есть ничего не отображается.

---

copron   (2007-12-09 20:09:00) [12]

Спасибо. Но если я пишу следующее

image1.Picture.Bitmap.Handle:=GetLtrBMP(fontdialog1.Font.Handle,'d');

функция не работает.

---

Dib@zol   (2007-12-09 14:47:00) [13]

Во-вторых, GetGlyphOutline он сцко сложный. Не легче ли например так?

function GetLtrBMP(F:HFONT; L:Char):HBITMAP;
var
 DC : HDC;
 TF, TB : HGDIOBJ;
 S : SIZE;
 P : PChar;
 R : TRect;
begin
 DC:=CreateCompatibleDC(0);
 TF:=SelectObject(DC, F);

 P:=PChar(string(L));
 GetTextExtentPoint32(DC, P, 1, S);
 FillChar(R, SIZEOF(TRect), 0);
 R.Right:=S.cx;
 R.Bottom:=S.cy;
 Result:=CreateBitmap(R.Right, R.Bottom, 1, 32, nil);
 TB:=SelectObject(DC, Result);

 FillRect(DC, R, GetStockObject(GRAY_BRUSH));
 SetBkMode(DC, TRANSPARENT);
 DrawText(DC, P, 1, R, DT_SINGLELINE or DT_CENTER or DT_VCENTER);

 SelectObject(DC, TB);
 SelectObject(DC, TF);
 DeleteDC(DC);
end;

ЗЫ PChar(string(L)) - канешна не верх изящества, но просто PChar(L) работать отказывается.

---

Dib@zol   (2007-12-09 13:52:00) [14]

Во-первых: Ты DC сначала должен создать.

---

copron   (2007-12-09 08:58:00) [15]

уточню задание. Мне нужно в image вывести какую-либо букву выбранного шрифта.

procedure TForm1.Button2Click(Sender: TObject);
d: HDC;
GM: TGLYPHMETRICS;
M: TMat2;
begin
fontdialog1.Execute;
SelectObject(d,fontdialog1.Font.Handle);
?:=GetGlyphOutline(d,ord('d'),GGO_BITMAP,GM,?,?,M?);
end;

Какие параметры указывается за место ? и как потом вывести картинку в image?

---

copron   (2007-12-08 19:34:00) [16]

Что-то у меня не получается разобраться с параметрами функции GetGlyphOutline. И как получить дескриптор шрифта?

---

DiamondShark   (2007-12-07 17:27:00) [17]

The AddFontResourcefunction adds the font resource from the specified file to the system font table.

The AddFontResourceExfunction adds the font resource from the specified file to the system. Fonts added with the AddFontResourceEx function can be marked as private and not enumerable.

The GetGlyphOutlinefunction retrieves the outline or bitmap for a character in the TrueType font that is selected into the specified device context.

---

Dimaxx   (2007-12-07 17:24:00) [18]

Какие шрифты? ttf, fon или нарисованные в bmp виде набора изображений?

---

Наверх