Как узнать размер текста в произвольном контроле

← →
MsGuns © (2008-09-20 19:53) [0]

Это может быть, например, ячейка сетки и шрифт может быть разным в разных ячейках (код в соотв.обработчике).

Узнать надо не внутри OnDrawxxx, а "извне", скажем по кнопке.

Спасибо за ответы

← →
Д С (2008-09-20 20:08) [1]

type
TFontedControl=class(TControl)
public
property Font;
end;

....

TFontedControl(SomeControl).Font

← →
Юрий Зотов © (2008-09-20 20:55) [2]

> Д С (20.09.08 20:08) [1]

Достаточно даже просто объявить класс, без публикации свойства. И даже без END:
type TFontedControl = class(TControl);

> MsGuns © (20.09.08 19:53)

Если юзер рисует текст сам и размер "локального" фонта не связан ни с какими свойствами контрола, то как его узнаешь? Он известен только там, где рисуется текст.

Но можно придумать косвенный способ. Например, сканируем ячейку грида по горизонтальным линиям пикселей. Там, где первый раз встретился пиксель с цветом, отличным от цвета фона - там начало высоты текста. А там, где такой пиксель встретился последний раз - там конец высоты текста. Добавляем стандартные зазоры - получаем высоту фонта.

← →
guav © (2008-09-20 21:40) [3]

Если можно заставить контрол нарисоваться на своём HDC, нарисовать на метафайле (TMetafileCanvas вроде), из метафайла можно получить всю прорисовку как последовательность GDI комманд.

← →
MsGuns © (2008-09-20 21:43) [4]

>Юрий Зотов © (20.09.08 20:55) [2]

Собственно, вопрос возник из того, что необходимо иметь средство для автоматического изменения размеров клиентской части области "рисования" текста в зависимости от его фактической ширины и высоты в пикселях (в данный момент это ширина колонки грида, но хотелось бы сделать что-то универсальное)

← →
Германн © (2008-09-21 01:32) [5]

> MsGuns © (20.09.08 21:43) [4]
>
> >Юрий Зотов © (20.09.08 20:55) [2]
>
> Собственно, вопрос возник из того, что необходимо иметь
> средство для автоматического изменения размеров клиентской
> части области "рисования" текста в зависимости от его фактической
> ширины и высоты в пикселях (в данный момент это ширина колонки
> грида, но хотелось бы сделать что-то универсальное)
>

А если я там в "клиентской части" захочу нарисовать картинку?

← →
MsGuns © (2008-09-21 02:08) [6]

>Германн © (21.09.08 01:32) [5]
>А если я там в "клиентской части" захочу нарисовать картинку?

Дело в том, что пользователь при всем старании не сможет рисовать картинки - он может лишь вводить текст, изменяя его ширину и/или высоту (при многострочности) - вот их-то мне и надо бы как-то определять.
Конечно, при программном изменении физических параметров текстов (фонта, стиля и т.д.) определить что там реально нарисовано можно, вероятно только так, как описал Юра, но можно же наплевать на "хитрости" и предположить, что фонт един для всего контрола (речь идет о сетках к примеру). В этом случае можно, казалось бы, воспользоваться методами TCanvas так, как это, к примеру, описано у Пачеко, но вся сложность в том, как доступиться до канвы этого самого контрола. Я пробовал делать так, как реализовано в методе TextWidth канвы в самом VCL, используя HDC и WinAPI (саму функцию не помню, помню только что последние 2 символа ее названия "32") - но ширина текста определяется одинаково для разных физических ширин (брал просто два эдита, писал туда один и тот же текст, но в одном делал fsBold, а в другом нет, - код давал одиниковое значение, хотя ширины, естественно, отличались)

← →
Германн © (2008-09-21 02:20) [7]

> MsGuns © (21.09.08 02:08) [6]
>
> >Германн © (21.09.08 01:32) [5]
> >А если я там в "клиентской части" захочу нарисовать картинку?
>
>
> Дело в том, что пользователь при всем старании не сможет
> рисовать картинки - он может лишь вводить текст, изменяя
> его ширину и/или высоту (при многострочности) - вот их-то
> мне и надо бы как-то определять.
> Конечно, при программном изменении физических параметров
> текстов (фонта, стиля и т.д.) определить что там реально
> нарисовано можно, вероятно только так, как описал Юра

Имхо. После того как пользователь ввёл текст в произвольное место контролла, у тебя для пост-анализа есть только картинка.

← →
Дмитрий_С (2008-09-21 12:24) [8]

> MsGuns © (21.09.08 02:08) [6]

ты покажи кодом как ты делал

← →
Бурундук (2008-09-21 12:46) [9]

А если размеры определять именно в OnDrawxxx, где они доступны,
и сохранять их? Для грида идея такая:
В обработчике OnDrawCell заменить DrawText на метод специального
объекта, который, помимо собственно рисования текста, будет
сохранять данные о его размере.

Принцип работы примерно такой:

unit main;

interface

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

type
TForm1 = class(TForm)
SGrid: TStringGrid;
Button1: TButton;
procedure SGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

TTextSizeInfo = class(TComponent)
private
FCellTextSizes: array of array of TSize;
function GetSizes(ACol, ARow: Integer): TSize;
procedure SetSizes(ACol, ARow: Integer; const Value: TSize);
public
function Grid: TStringGrid;

property TextSizes[ACol, ARow: Integer]: TSize read GetSizes write SetSizes;
function DrawText(ACol, ARow: Integer; AText: PChar; ATextLen: Integer; var ARect: TRect; AFormat: Cardinal): Integer;
end;

var
Form1: TForm1;

function TextSizeInfo(Grid: TStringGrid): TTextSizeInfo;

implementation

uses Types;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
SGrid.Cells[0, 0] := "123";
end;

procedure TForm1.SGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var Grd: TStringGrid;
Fmt: Cardinal;
S: string;
begin
Fmt := DT_LEFT or DT_BOTTOM;
Grd := (Sender as TStringGrid);
with Grd.Canvas do
begin
S := Grd.Cells[ACol, ARow];
FillRect(Rect);
TextSizeInfo(Sender as TStringGrid).DrawText(ACol, ARow, PChar(S), Length(S), Rect, Fmt);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var sz: TSize;
begin
// Получение размеров текста в ячейке
sz := TextSizeInfo(SGrid).GetSizes(0, 0);
Caption := IntToStr(sz.cx);
end;

{--------------------------- TTextSizeInfo ------------------------------------}

function TextSizeInfo(Grid: TStringGrid): TTextSizeInfo;
var i: Integer;
begin
for i := 0 to Grid.ComponentCount-1 do
if Grid.Components[i] is TTextSizeInfo then
begin
Result := Grid.Components[i] as TTextSizeInfo;
Exit;
end;
Result := TTextSizeInfo.Create(Grid);
end;

function TTextSizeInfo.DrawText(ACol, ARow: Integer; AText: PChar;
ATextLen: Integer; var ARect: TRect; AFormat: Cardinal): Integer;
var sz: TSize;
begin
Windows.DrawText(Grid.Canvas.Handle, AText, ATextLen, R, AFormat or DT_CALCRECT);

sz.cx := ARect.Right - ARect.Left;
sz.cx := ARect.Bottom - ARect.Top;
TextSizes[ACol, ARow] := sz;

Windows.DrawText(Grid.Canvas.Handle, AText, ATextLen, ARect, AFormat);
end;

function TTextSizeInfo.GetSizes(ACol, ARow: Integer): TSize;
begin
Result.cx := 0;
Result.cy := 0;

if ( FCellTextSizes = nil )or
( Length(FCellTextSizes) < Grid.ColCount )or
( Length(FCellTextSizes[0]) < Grid.RowCount )
then
SetLength(FCellTextSizes, Grid.ColCount, Grid.RowCount);

if (ACol >= 0)and(ACol < Grid.ColCount)and
(ARow >= 0)and(ARow < Grid.RowCount) then
Result := FCellTextSizes[ACol, ARow];
end;

procedure TTextSizeInfo.SetSizes(ACol, ARow: Integer; const Value: TSize);
begin
if ( FCellTextSizes = nil )or
( Length(FCellTextSizes) < Grid.ColCount )or
( Length(FCellTextSizes[0]) < Grid.RowCount )
then
SetLength(FCellTextSizes, Grid.ColCount, Grid.RowCount);

if (ACol >= 0)and(ACol < Grid.ColCount)and
(ARow >= 0)and(ARow < Grid.RowCount) then
FCellTextSizes[ACol, ARow] := Value;
end;

function TTextSizeInfo.Grid: TStringGrid;
begin
Result := Owner as TStringGrid;
end;

end.

← →
MsGuns © (2008-09-21 15:09) [10]

>Дмитрий_С (21.09.08 12:24) [8]
>ты покажи кодом как ты делал

Код на работе. Но там нечего показывать, т.к. я полностью собезъянничал с VCL (TCanvas.TextWidth), а HDC "взял" с помощью ф-ции GetWindowDC(Edit1.Handle). Повторяю, оно все как бы работает, только дает в результате
какую-то фигню.

>Бурундук (21.09.08 12:46) [9]

Вы, вероятно, не совсем поняли что я хочу.
У меня не возникает никаких проблем в обработчиках перерисовки, но мне надо несколько иное. Поясню на примере
Есть датасет и грид, его отображающий. После открытия датасета я хочу вычислить ширину колонок грида так, чтобы они вмещали полностью тексты всех полей каждой колонки. Т.е. грид еще и не думал рисоваться или отрисовал первые надцать строк, а я уже хочу знать ширины всех его колонок.

Пример с гридом - частный случай, но ИМХО, достаточно избыточно рисует проблему.

← →
{RASkov} © (2008-09-21 16:48) [11]

> [10] MsGuns © (21.09.08 15:09)

Не совсем понятно... Но может какнить так:
// Просто эксперименты :) procedure TForm1.Button1Click(Sender: TObject); var C, R, N: Integer; S: String; begin for C:=1 to StringGrid1.ColCount-1 do for R:=1 to StringGrid1.RowCount-1 do begin S:="Bla-Bla"; for N:=0 to 30 do if Random(5)=2 then S:=S+#32 else S:=S+CHR(Random(30)+48); StringGrid1.Cells[C, R]:=S; end; end; procedure TForm1.Button2Click(Sender: TObject); var C, R, W: Integer; Cnv: TControlCanvas; Rc: TRect; begin Cnv:=TControlCanvas.Create; Cnv.Control:=StringGrid1; Cnv.Font.Assign(StringGrid1.Font); try for C:=1 to StringGrid1.ColCount-1 do begin W:=0; for R:=1 to StringGrid1.RowCount-1 do begin DrawText(Cnv.Handle, PChar(StringGrid1.Cells[C, R]), -1, Rc, DT_CALCRECT); if W<Rc.Right-Rc.Left+4 then W:=Rc.Right-Rc.Left+4; end; StringGrid1.ColWidths[C]:=W; end; finally Cnv.Free; end; end; procedure TForm1.Button3Click(Sender: TObject); var W: Integer; Cnv: TControlCanvas; Rc: TRect; begin Cnv:=TControlCanvas.Create; Cnv.Control:=Edit1; Cnv.Font.Assign(Edit1.Font); DrawText(Cnv.Handle, PChar(Edit1.Text), -1, Rc, DT_CALCRECT); ShowMessage(IntToStr(Rc.Right-Rc.Left)); Cnv.Free; Cnv:=TControlCanvas.Create; Cnv.Control:=Edit2; Cnv.Font.Assign(Edit2.Font); DrawText(Cnv.Handle, PChar(Edit2.Text), -1, Rc, DT_CALCRECT); ShowMessage(IntToStr(Rc.Right-Rc.Left)); Cnv.Free; end;
...попробывать? Конечно, если используется OnDrawCell(или что-то в этом роде), то тут уже нормально никак не получится, наверное только как предложил Юра, но с учетом [7] Германн...

> помню только что последние 2 символа ее названия "32")

GetTextExtentPoint32 ?

← →
{RASkov} © (2008-09-21 16:51) [12]

> procedure TForm1.Button3Click(Sender: TObject);

Там где эксперимент был с эдитами. В эдитах был одинаковый текст с одинаковым шрифтом, но в одном Style:=[] а в другом Style:=[fsItalic, fsBold];

← →
MsGuns © (2008-09-21 17:01) [13]

>Cnv:=TControlCanvas.Create;

Обана ! Это интересно - надо попробовать ;)

>GetTextExtentPoint32 ?

Таки да ;)

Спасибо, завтра поэкспериментирую. Способ, конечно, не учитывает "выпендресы" с перерисовкой "ручками", но мне это пока и не надо.

Но вот, блин, интересно, винда же при перерисовке "помнит" все нюансы рисования каждого фрагмента экрана. Как она, собабака, это делает ?
;))

← →
MsGuns © (2008-09-21 17:05) [14]

Саш, если не затруднит, изобрази код, который подгоняет ширину эдита точно под текст при каждой его правке с клавиатуры, пожалуйста ;)

У меня здесь делфа глючит (есть, но она глючит - комп домашний и давно нуждается в переустановке винды, да все ручки не доходят) - не могу попробовать

← →
{RASkov} © (2008-09-21 17:34) [15]

> [14] MsGuns © (21.09.08 17:05)
> Саш, если не затруднит, изобрази код, который подгоняет
> ширину эдита точно под текст при каждой его правке с клавиатуры

Может как-то так:
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var Rc: TRect; begin with TControlCanvas.Create do try Control:=Edit1; Font.Assign(Edit1.Font); DrawText(Handle, PChar(Edit1.Text+CHR(Key)), -1, Rc, DT_CALCRECT); if Rc.Right-Rc.Left<30 then Edit1.Width:=30 else Edit1.Width:=Rc.Right-Rc.Left+4; finally Free; end; end;

← →
guav © (2008-09-21 18:56) [16]

> [3] guav © (20.09.08 21:40)

function DrawToMf(control: TWinControl): TMetafile; var canvas: TMetafileCanvas; begin control.DoubleBuffered := False; Result := TMetafile.Create(); try canvas := TMetafileCanvas.Create(Result, 0); try control.PaintTo(canvas, 0, 0); finally canvas.Free(); end; except Result.Free(); raise; end; end; function EnhMetaFileProc( hDC: HDC; lpHTable: PHANDLETABLE; lpEMFR: PENHMETARECORD; nObj: Integer; lpData: TStrings): Integer; stdcall; var c: TCanvas; s: WideString; p: PEMRText; lpETOW: PEMRExtTextOut absolute lpEMFR; ex: TSize; begin PlayEnhMetaFileRecord(hDC, lpHTable^, lpEMFR^, nObj); if (lpEMFR^.iType = EMR_EXTTEXTOUTW) then try c := TCanvas.Create(); c.Handle := hDC; if (PEMRExtTextOut(lpEMFR)^.emrtext.nChars > 0) then begin p := @(PEMRExtTextOut(lpEMFR)^.emrtext); SetString( s, PWideChar(PChar(lpEMFR) + p^.offString), p^.nChars); ex := c.TextExtent(s); lpData.Add(Format("Текст %s выведен шрифтом размера %d x %d", [AnsiString(s), ex.cx, ex.cy])); end; except; Result := 0; Exit; end; Result := 1; end; procedure EnumControlFonts(control: TWinControl); var mf: TMetafile; b: TBitmap; r: TRect; sl: TStringList; begin mf := DrawToMf(control); try b := TBitmap.Create(); try b.Width := 1000; b.Height := 1000; SetRect(r, 0, 0, 1000, 1000); sl := TStringList.Create(); try EnumEnhMetaFile(b.Canvas.Handle, mf.Handle, @EnhMetaFileProc, sl, r); ShowMessage(sl.Text); finally sl.Free(); end; finally b.Free(); end; finally mf.Free(); end; end; procedure TForm1.Button1Click(Sender: TObject); begin EnumControlFonts(StringGrid1); end;

← →
{RASkov} © (2008-09-21 19:43) [17]

> [16] guav © (21.09.08 18:56)

Мне кажется, что это немножко усложненный пример получения ширины текста...
Ведь "ядро" данного метода это всего лишь вот эта строка: ex := c.TextExtent(s);
ИМХО конечно...

← →
guav © (2008-09-21 19:47) [18]

> [17] {RASkov} © (21.09.08 19:43)

Это просто пример что делать если каждая ячейка своим шрифтом

Вот еще пример(на основе [15]):
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; const SET_WIDTH = WM_USER + 401; type TForm1 = class(TForm) Panel1: TPanel; Edit1: TEdit; Button1: TButton; procedure Edit1Change(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } procedure SetWidth(var Mes: TMessage); message SET_WIDTH; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} { TForm1 } type TMyCtrl = class(TControl); procedure TForm1.SetWidth(var Mes: TMessage); var {Rc: TRect;} WX: Integer; begin if Mes.LParam<0 then Mes.LParam:=0; with TControlCanvas.Create do try Control:=TControl(Mes.WParam); Font.Assign(TMyCtrl(Control).Font); //DrawText(Handle, PChar(Edit1.Text+CHR(Key)), -1, Rc, DT_CALCRECT); //if Rc.Right-Rc.Left<Mes.LParam then Edit1.Width:=Mes.LParam //else Edit1.Width:=Rc.Right-Rc.Left+GetSystemMetrics(SM_CXEDGE)*2+2; WX:=TextExtent(TMyCtrl(Control).Text).cx; if WX<Mes.LParam then Control.ClientWidth:=Mes.LParam else Control.ClientWidth:=WX+GetSystemMetrics(SM_CXEDGE)*2+2; finally Free; end; end; procedure TForm1.Edit1Change(Sender: TObject); begin PostMessage(Handle, SET_WIDTH, Integer(Sender), -1); end; procedure TForm1.Button1Click(Sender: TObject); begin Panel1.Caption:=Edit1.Text; PostMessage(Handle, SET_WIDTH, Integer(Panel1), 50); PostMessage(Handle, SET_WIDTH, Integer(Sender), 100); end; end.

> [18] guav © (21.09.08 19:47)
> если каждая ячейка своим шрифтом

Хм... точно) Я что-то не подумал об этом...
Я пример[16] попробывал с одним шрифтом, поэтому и....
Хех... эти метафайлы, а ведь интересная реализация... т.е. PaintTo в метафайл запишет всю информацию и шрифт включительно... Нужно будет "поюзать" примерчик с метафайлами :)

← →
Бурундук (2008-09-22 13:21) [21]

Можно попробовать соединить мой метод с методом guav"a

procedure TForm1.Button1Click(Sender: TObject);
var sz: TSize;
mf: TMetafile;
i, j: Integer;
oldHeight, testHeight: Integer;
r: TRect;
begin
oldHeight := SGrid.Height;

testHeight := 0;
for i := 0 to SGrid.RowCount-1 do
testHeight := testHeight + SGrid.RowHeights[j] + 1;

// Грид должен нарисоваться в метафайл полностью, без скроллинга.
// Тогда для всех ячеек будет вызван OnDrawCell
// а в нём - вычислен размер текста

SGrid.Height := testHeight;
try
mf := DrawToMf(SGrid);
mf.Free;

for i := 0 to SGrid.ColCount-1 do
SGrid.ColWidths[i] := TextSizeInfo(SGrid).GetMaxTextWidth(i) + 2;
finally
SGrid.Height := oldHeight;
end;
end;

С простыми контролами все работает превосходно, с сеткой тоже вроде нормально, только вот тормозит :(
Большое спасибо всем !

Блин, Саша, если б у меня только эта проблема была :(

Ну если что, чем смогу - помогу

← →
имя (2008-12-08 23:15) [26]

Удалено модератором

Как узнать размер текста в произвольном контроле Найти похожие ветки