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

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

Как узнать реальную ширину наклонного текста?


Страницы:   1 2

Style ©   (2005-02-10 12:06:00) 

Собственно сабж?

var
 i: integer;
 lpSize: TSize;
begin
Canvas.Font.Size := 20;
Canvas.Font.Style := [fsItalic];
Canvas.TextOut(10,10,'Про');

GetTextExtentPoint32(Canvas.Handle, pchar('Про'), 3, lpSize);
i := lpSize.cx;
Canvas.Font.Style := [];
Canvas.TextOut(10+i,10,'верка');


Style   (2005-02-14 11:26:00) [1]

> while i < lpSize.cx do
здесь вот так.
while i < lpSize.cx*sizeof(TBGR) do

Ну так КТО-нибудь знает как еще можно получить рельную ширину???


Style   (2005-02-11 14:38:00) [2]

Оптимизировал немного, так значительно лучше...

function GetRealCharWidth(Dc: HDC; ch: Char): integer;
type
 TBGR = record
   b: byte;
   g: byte;
   r: byte;
 end;
 PBGR = ^TBGR;
var
 lpSize: TSize;
 lpBgr: PBgr;

 nFont: hFont;
 i: integer;
 bmp: TBitmap;

begin

 bmp := TBitmap.Create;
 try
   GetTextExtentPoint32(DC, @ch, 1, lpSize);
   result := 0;

   bmp.Width := lpSize.cx;
   bmp.Height := 1;
   bmp.PixelFormat := pf24bit;

   bmp.Canvas.Brush.Color := clRed;
   bmp.Canvas.FillRect(bmp.Canvas.ClipRect);

   nFont := GetCurrentObject(dc,OBJ_FONT);

   SelectObject(bmp.Canvas.Handle,nFont);

   SetBkColor(bmp.Canvas.Handle,clWhite);
   SetTextColor(bmp.Canvas.Handle,clBlack);

   bmp.Canvas.TextOut(-lpSize.cx,0,string(ch));

   i := 0;
   while i < lpSize.cx do
   begin
     lpBgr := PBGR(integer(bmp.ScanLine[0])+i);
     if( lpBgr.r = 255) and
       ( lpBgr.g = 0) and
       ( lpBgr.b = 0) then
     begin
       result := (i div SizeOf(TBGR)) + lpSize.cx;
       break;
     end;
     Inc(i,SizeOf(TBGR));
   end;

 finally
  Bmp.Free;
 end;
end;


Style   (2005-02-11 13:52:00) [3]

Не, я балдею над мелкософтом.
Даже такую мелочь нельзя сделать доступной?


Style   (2005-02-11 13:21:00) [4]

Вот так работает ...
Изврат конечно, но зато точно :)


function GetRealCharWidth(Dc: HDC; ch: Char): integer;
type
 TBGR = record
   b: byte;
   g: byte;
   r: byte;
 end;
var
 bmp: TBitmap;
 lpSize: TSize;
 nFont: hFont;
 Line: array of TBGR;
 i: integer;
begin

 GetTextExtentPoint32(DC, @ch, 1, lpSize);
 result := 0;
 
 bmp := Tbitmap.Create;
 try
   bmp.Width := lpSize.cx*2;
   bmp.Height := lpSize.cy;
   bmp.PixelFormat := pf24bit;

   bmp.Canvas.Brush.Color := clRed;
   bmp.Canvas.FillRect(bmp.Canvas.ClipRect);

   nFont := GetCurrentObject(dc,OBJ_FONT);

   SelectObject(bmp.Canvas.Handle,nFont);

   SetBkColor(bmp.Canvas.Handle,clWhite);
   SetTextColor(bmp.Canvas.Handle,clBlack);

   bmp.Canvas.TextOut(0,0,string(ch));

   SetLength(Line,lpSize.cx*2);
   CopyMemory(line, bmp.ScanLine[1], lpSize.cx*2*SizeOf(TBGR));

   for i := lpSize.cx to lpSize.cx*2 do
   begin
     if( line[i].r = 255) and (line[i].g = 0) and (line[i].b = 0) then
     begin
       result := i;
       break;
     end;

   end;

 finally
   bmp.Free;
 end;

end;

function GetRealTextWidth(DC: HDC; Text: string): integer;
var
 r: integer;
 ch: Char;
 lpSize: TSize;
begin

 r := Length(Text)-1;
 GetTextExtentPoint32(DC, pchar(copy(text,1, r)), r, lpSize);

 ch := Text[r+1];

 result := GetRealCharWidth(Dc,ch);

 Inc (result,lpSize.Cx);

end;

procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
Canvas.Font.Size :=25 ;
Canvas.Font.Style := [fsItalic];
Canvas.TextOut(10,10,'Про');

i := GetRealTextWidth(Canvas.Handle,'Про');
Canvas.Font.Style := [];
Canvas.TextOut(10+i,10,'верка');
end;


Style   (2005-02-11 13:02:00) [5]


> Обрезает, но не на много. Просто прибавь еще 10 к ширине,
> и должно быть все ок.


нет, так не пойдетЪ :)


Arm79   (2005-02-11 12:56:00) [6]

Обрезает, но не на много. Просто прибавь еще 10 к ширине, и должно быть все ок.


Style   (2005-02-11 12:34:00) [7]


> Забавно, сейчас еще одна бредовая мысль в голову пришла.
> Создать в ран-тайме лейбл с установленным автозайзом, указать
> ей нужный фонт и его параметры, а потом посмотреть ширину
> этого лейбла...


Лейбл кстати тоже иногда обрезает Italic, а на некоторых шрифтах оставляет слижком большой отступ - tm.tmOverhang походу прибавляют.


Style   (2005-02-11 12:34:00) [8]


> Забавно, сейчас еще одна бредовая мысль в голову пришла.
> Создать в ран-тайме лейбл с установленным автозайзом, указать
> ей нужный фонт и его параметры, а потом посмотреть ширину
> этого лейбла...


Лейбл кстати тоже иногда обрезает Italic, а на некоторых шрифтах оставляет слижком большой отступ - tm.tmOverhang походу прибавляют.


Arm79   (2005-02-11 12:05:00) [9]

Забавно, сейчас еще одна бредовая мысль в голову пришла. Создать в ран-тайме лейбл с установленным автозайзом, указать ей нужный фонт и его параметры, а потом посмотреть ширину этого лейбла...


Arm79   (2005-02-11 11:35:00) [10]

да, старался, рисовал треугольник, а получился капец...


Arm79   (2005-02-11 11:34:00) [11]

Предлагаю ужасный вариант. Если знать угол наклона (думаю, что 70 градусов), то можно просто увеличивать ширину каждой буквы как произведение высоты на то ли тангенс то ли котангенс.

вроде бы tg Y = b/a => b = a * tg Y

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

      b
 ************
 *         *
 *       *
a *     *
 * Y * c
 * *
 *


Style   (2005-02-11 11:02:00) [12]

tm.tmOverhang
Что-то как то не правильно он работает...

Вот перевел на делфи пример из MSDN, и убрал пробелы из строк,
так на тех шрифтах где tmOverhang := 0 иногда рисует нормально. А другие шрифты, затирают или налазиют на предыдущие слова...

const
lpszString1 = 'Thisisa';
lpszString2 = 'sample';
lpszString3 = 'string.';

var
XIncrement: integer;
YStart: integer;
tm: TEXTMETRIC;
sz: TSIZE;

begin

// Select the bold font and draw the first string
// beginning at the specified point (XIncrement, YStart).

XIncrement := 10;
YStart := 50;
Canvas.Font.Style := [fsbold];
Canvas.TextOut(XIncrement, YStart, lpszString1);

GetTextExtentPoint32(Canvas.Handle, lpszString1, length(lpszString1), sz);
XIncrement := XIncrement + sz.cx;

// Retrieve the overhang value from the TEXTMETRIC
// structure and subtract it from the x-increment.
// (This is only necessary for non-TrueType raster
// fonts.)

GetTextMetrics(Canvas.Handle, tm);
XIncrement := XIncrement - tm.tmOverhang;

// Select an italic font and draw the second string
// beginning at the point (XIncrement, YStart).

Canvas.Font.Style := [fsItalic];
GetTextMetrics(Canvas.Handle, tm);

XIncrement := XIncrement - tm.tmOverhang;

Canvas.TextOut(XIncrement, YStart, lpszString2);

// Compute the length of the second string and add
// this value to the x-increment that is used for the
// text-output operation.

GetTextExtentPoint32(Canvas.Handle, lpszString2, Length(lpszString2), sz);
XIncrement := XIncrement + sz.cx;

// Reselect the bold font and draw the third string
// beginning at the point (XIncrement, YStart).

Canvas.Font.Style := [fsBold];

Canvas.TextOut(XIncrement - tm.tmOverhang, YStart, lpszString3);


Блин, я уже не знаю что делать ??? Word и IExplorer как-то же это делают :( ...

Может создать CompatibleDC загрузить туда фонт с текущей канвы, создать в этом контексте Bitmap, и закрасить его каким-нить зеленым фоном, затем нарисовать там последнюю букву в проверяемой строке и получить DibBITS, чтобы в цикле найти где заканчивается фон буквы и начинается зеленый фон картинки. :)))


MBo   (2005-02-10 16:58:00) [13]

>У меня "верка" на "Про" залазиет :)
Ну да, ты же меняешь italic на обычный, а
GetTextExtentPoint32 дает координаты, в которых будет продолжать печататься предыдущим шрифтом.

>он возвращает ширину текста, не учитывая наклон
Увы, так и есть.

попробуй еще с эти поиграть:

tm:TTextMetric;
...
GetTextMetrics(Canvas.Handle,tm);
Canvas.Font.Style := [];
Canvas.TextOut(10+i+tm.tmOverhang,10,'âåðêà');


Style   (2005-02-10 16:55:00) [14]


> Юрий Зотов ©   (10.02.05 12:46) [5]


> Наклон и другие характеристики шрифта содержатся в структуре
> LOGFONT. Получить ее можно, например, через EnumFontFamilies
> (хотя не уверен, что это лучший способ).


Попробовал получить структуру TLOGFONT, только через GetObject
GetObject(Canvas.Font.Handle,sizeof(TLOGFONT), @logfont);
но
logfont.lfEscapement все равно 0..

В общем странно, но должен же быть какой-нить способ.

Интересные вещи написаны про tmOverhang структуры TEXTMETRIC


Specifies the extra width per string that may be added to some synthesized fonts. When synthesizing some attributes, such as bold or italic, graphics device interface (GDI) or a device may have to add width to a string on both a per-character and per-string basis. For example, GDI makes a string bold by expanding the spacing of each character and overstriking by an offset value; it italicizes a font by shearing the string. In either case, there is an overhang past the basic string. For bold strings, the overhang is the distance by which the overstrike is offset. For italic strings, the overhang is the amount the top of the font is sheared past the bottom of the font.

The tmOverhang member enables the application to determine how much of the character width returned by a GetTextExtentPoint32 function call on a single character is the actual character width and how much is the per-string extra width. The actual width is the extent minus the overhang.


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


Style   (2005-02-10 16:48:00) [15]


> Пардон, сейчас запустил твой пример.
> Font Renderer работает так, как ему положено.
> Что именно не устраивает?


Попробуй поменять шрифты.
У меня "верка" на "Про" залазиет :)


> Как раз для italic GetTextExtentPoint32 иногда ошибается


Он не ошибается - он возвращает ширину текста, не учитывая наклон :( Так в MSDN написно.


MBo   (2005-02-10 15:56:00) [16]

Пардон, сейчас запустил твой пример.
Font Renderer работает так, как ему положено.
Что именно не устраивает?


MBo   (2005-02-10 15:47:00) [17]

>ABCWidths в сумме как раз и есть GetTextExtentPoint32
Не всегда...
Как раз для italic GetTextExtentPoint32 иногда ошибается


Style   (2005-02-10 15:29:00) [18]


> Повысить точность можно использованием GetCharABCWidths
> для TTF,
> для растровых можно попробовать GetCharWidth32


Тоже самое возвращают..

ABCWidths в сумме как раз и есть GetTextExtentPoint32..

Даже не знаю что и делать..


MBo   (2005-02-10 13:20:00) [19]

Повысить точность можно использованием GetCharABCWidths для TTF,
для растровых можно попробовать GetCharWidth32


Юрий Зотов   (2005-02-10 12:46:00) [20]

Наклон и другие характеристики шрифта содержатся в структуре LOGFONT. Получить ее можно, например, через EnumFontFamilies (хотя не уверен, что это лучший способ).


Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо