PHP DM Gate v0.9 » TLabel.Canvas.TextWidth в OnShow формы

Denchik (14.06.17 16:15) [0]

Встал вопрос посчитать требуемую длину текста который будет отображён в TLabel. Считаю длину с помощью TLabel.Canvas.TextWidth(), отрезаю по одному слову до тех пор, пока ширина урезанного текста + "..." не влезит в TLabel.Width.

Если проще, если требуемый текст не влазит в ширину, обрезать его, дописать "...".

Сделал функцию, вызываю её в OnShow формы. Проблема в том, что когда форма открывается первый раз, то TLabel.Canvas.TextWidth() возвращает не правильный размер. После второго открытия, без закрытия приложения, всё в порядке.

Отладчиком нашёл что вызов TextWidth состоит из:
TextWidth()->->RequiredState->CreateFont
который создаёт Font для канвы.

При первом проходе, увидел что размер шрифта 11пкс (отсюда и неверное вычисление ширины), вместо моих 14пкс, которые я указал в design time.
Отсюда сделал вывод что на момент первого вызова, значение размера шрифта ещё не загружено из dfm. А загружаются они уже после вызова он OnShow. А мне нужно именно в OnShow формировать текст для TLabel.Caption.

Люди добрый, подскажите пожалуйста что с этим делать.. У меня мысли кончились((

<Цитата>
Denchik (14.06.17 16:21) [1]

procedure TOfferForm.FormShow(Sender: TObject);
begin
......
LBOS.Caption:=AdjustTextToWidthByCanvas(LBOS.Canvas, LBOS.Width, 'VERY LONG TEXT', 100);
end;

Моя функция, которая обрезает текст под заданную длину:

function AdjustTextToWidthByCanvas(ACanvas: TCanvas; AWidth: integer; AText: string; CenPrcnt: integer): string;
function TrimWordRight(St: string): string;
var i: integer;
begin
if LastDelimiter(' ', St)=0 then
Exit;
while St[Length(St)]<>' ' do
Delete(St, Length(St), 1);
Result:=Trim(St);
end;

function TrimWordLeft(St: string): string;
var i: integer;
begin
if Pos(' ', St)=0 then
Exit;
while St[1]<>' ' do
Delete(St, 1, 1);
Result:=Trim(St);
end;

const
SEPAR=' ... ';
MAXCHARS=100000;
var
LeftSt, RightSt: string;
CenPos, i, tw: integer;
begin
tw:=ACanvas.TextWidth(AText);
if (tw>AWidth) then
begin
CenPos:=Round(Length(AText)/100*CenPrcnt);

LeftSt:=Copy(AText, 1, CenPos);
LeftSt:=TrimWordRight(LeftSt);

RightSt:=Copy(AText, CenPos+1, Length(AText)-CenPos);
RightSt:=TrimWordLeft(RightSt);

i:=0;
while True do
begin
tw:=ACanvas.TextWidth(LeftSt+SEPAR+RightSt);
if tw>AWidth then
LeftSt:=TrimWordRight(LeftSt)
else
Break;

tw:=ACanvas.TextWidth(LeftSt+SEPAR+RightSt);
if tw>AWidth then
RightSt:=TrimWordLeft(RightSt)
else
Break;

Inc(i);
if i>MAXCHARS then // Condition, if something went wrong)
begin
Result:=AText;
Exit;
end;

//Delete(LeftSt, Length(LeftSt), 1);
//Delete(RightSt, 1, 1);
end;

Result:=LeftSt+SEPAR+RightSt;
end else
Result:=AText;
end;

У функции, последний параметр, сколько отступить от начала, в процентах, для вставки "...". Для случая если "..." нужно вставить не в конце текста, а например в середине.

<Цитата>
Игорь Шевченко © (14.06.17 17:11) [2]

По теме:

DrawText (...DT_ENDELLIPSIS)

> При первом проходе, увидел что размер шрифта 11пкс (отсюда
> и неверное вычисление ширины), вместо моих 14пкс, которые
> я указал в design time.
> Отсюда сделал вывод что на момент первого вызова, значение
> размера шрифта ещё не загружено из dfm.

Visible := False в Design time поставить.

<Цитата>
Denchik (14.06.17 18:12) [3]

> DrawText (...DT_ENDELLIPSIS)

Мне в эту функцию нужно передать hdc канвы. А проблема в том, что при первом вызове OnShow, свойствам шрифта канвы ещё не присвоены значения из dfm. Т.е. в данном случае как-то нужно принудительно заставить форму применить все данные свойств из dfm.

Да и из середины текста выбрасывать слова и заменять их точками DrawText тоже не умеет(

Может не совсем понятно объяснил.. Попробую с другой стороны описать проблему. Если кинуть на чистую форму, чистого проекта tlabel, у него для шрифта прописываются значения по умолчанию (Tahoma, 11px и т.д.). Потом в design time я меняю размер шрифта на 14.
Далее запускаю проект, и в отладчике вижу, что при первом открытии формы, в событии OnShow, размер шрифта канвы tlabel = 11px. Смотрю дальше, в TLabel.Paint размер шрифта канвы уже нужные мне 14px. Закрываю форму (без закрытия приложения), открываю ещё раз, и отладчик видит уже правильный 14й шрифт у канвы, в OnShow. Вывод: данные из dfm подгружаются после первого вызова OnShow, но до OnPaint.

Нужно как-то сломать систему и заставить его подгрузить эти данные вначале OnShow.)

Насколько помню, отловить момент когда данные загружены, можно перекрыв метод Loaded. Но очень не хочется ради тривиальной задачи писать свой перепиленный TLabel...

> Visible := False в Design time поставить.

А можно поподробнее, в чём смысл менять Visible? Я так понимаю в design нужно Visible:=False, а в runtime потом Visible:=True?

<Цитата>
Игорь Шевченко © (14.06.17 19:02) [4]

> А можно поподробнее, в чём смысл менять Visible?

Событие OnShow вызывается при смене значения свойства Visible.
Свойство Visible меняется при чтении из dfm.
Если там будет указано false, событие OnShow не будет вызываться при чтении.
Или можно заниматься вычислениями текстов в событии OnCreate, оно вызывается после загрузки свойств.

<Цитата>
Denchik (14.06.17 20:20) [5]

> Событие OnShow вызывается при смене значения свойства Visible.

Я так понимаю речь идёт о форме? Форма не главная, у неё в design time по умолчанию Visible = False. Не знаю важно или нет, но моя форма, о которой идёт речь, показывается по ShowModal.

> Или можно заниматься вычислениями текстов в событии OnCreate, оно вызывается после загрузки свойств.

Судя по всему, действительно dfm загружается до OnCreate. Сделал так:

procedure TOfferForm.FormCreate(Sender: TObject);
begin
ShowMessage(IntToStr(LBOS.Canvas.Font.Height)+'##'+IntToStr(LBOS.Font.Height));

Получил 11##14.

Из dfm получается размер шрифта 14px уже загружен, но канва об этом ничего не знает(

Теперь ещё больше вопросов. В какой момент тогда свойства шрифта TLabel переносятся в свойства шрифта канвы этого же TLabel?

Добавил в OnShow тоже самое что и в OnCreate:

procedure TOfferForm.FormShow(Sender: TObject);
var
DrvDiagram: TDrvDiagram;
begin
ShowMessage(IntToStr(LBOS.Canvas.Font.Height)+' - '+IntToStr(LBOS.Font.Height));

При первом показе формы:
11##14

Закрываю форму открываю ещё раз:
14##14

Тут уже свойства шрифта канвы уже соответствуют свойствам шрифта TLabel.

<Цитата>
Denchik (14.06.17 20:29) [6]

> Игорь Шевченко

Человеческое спасибо за комментарии!

В общем выдумал костыль. Сделал обёртку на свою функцию обрезки текста с явным копированием свойств шрифта из TLabel.Font в TLabel.Canvas.Font

//------------------------------------------------------------------------------

function AdjustTextToLabelWidth(ALabel: TLabel; AText: string; CenPrcnt: integer): string;
begin
ALabel.Canvas.Font.Assign(ALabel.Font);
Result:=AdjustTextToWidthByCanvas(ALabel.Canvas, ALabel.Width, AText, 100);
end;

//------------------------------------------------------------------------------

Но вопрос так и остаётся открытым. В какой момент свойства шрифта TLabel переносятся в свойства шрифта канвы этого же TLabel?

<Цитата>
Игорь Шевченко © (14.06.17 21:31) [7]

> В какой момент свойства шрифта TLabel переносятся в свойства
> шрифта канвы этого же TLabel?

Можно считать, что в момент рисования. Но я не до конца понимаю, почему не использовать для расчетов свойство Font самого компонента TLabel ?

> function AdjustTextToWidthByCanvas(ACanvas: TCanvas; AWidth:
> integer; AText: string; CenPrcnt: integer): string;
> function TrimWordRight(St: string): string;

=>

function AdjustTextToWidthByCanvas(AFont: TFont; AWidth: integer; AText: string; CenPrcnt: integer): string;
...
var
WorkerCanvas: TCanvas;
begin
WorkerCanvas := TCanvas.Create;
try
WorkerCanvas.Handle := GetDC(0);
WorkerCanvas.Font := AFont;
.... Расчеты
finally
WorkerCanvas.Free;
end;
end;

<Цитата>
Denchik (14.06.17 23:42) [8]

> Можно считать, что в момент рисования. Но я не до конца понимаю, почему не использовать для расчетов свойство Font самого компонента TLabel ?

Действительно... Затуп мировой.. Сразу не понял о чем вы говорили.. Аж стыдно) Надо больше спать).

Я упёрся что мне зачем-то нужен именно канвас моего лэйбла со ВСЕМИ его свойствами, а мне то для всех моих расчётов достаточно тупо отнести, в отдельный экземпляр канвы, Font самого TLabel...

За пример низкий поклон! Так дальше и тормозил бы)

Спасибо!

<Цитата>