Вывод текста на канву с масштабированием

← →
wsih © (2006-05-24 11:55) [0]

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

← →
MBo © (2006-05-24 11:58) [1]

API-функция DrawText
при необходимости расчета - с флагом DT_CALCRECT

← →
wsih © (2006-05-24 12:01) [2]

DrawText неподходит... Нужно какое то комплексное решение. На это есть 2 причины: прямоугольные области _строго_ фиксированы; текста может быть много, возможно до минимального размера шрифта, что бы поместился весь.

← →
MBo © (2006-05-24 12:09) [3]

В GDI нет функций для подгонки размеров шрифта под нужную область. Единственный способ - самому менять размер шрифта, и измерять.

← →
wsih © (2006-05-24 12:16) [4]

Вот я и ищу умных мыслей по этому поводу... свои все - закончились (. (да их и не много было)...
+ не получается менять размер шрифта с помошью:
logfont.lfHeight
canvas.Font.Handle:=CreateFontIndirect(Logfont)
DrawText - это успешно игнорирует, равно как и просто Canvas.Font.Size;
Конструкция с CreateFontIndirect меняет размер шрифта только при Canvas.TextOut

← →
MBo © (2006-05-24 12:40) [5]

Уж не знаю, кто там у тебя чего игнорирует, но вот примитивная подгонка:
function CalcFontSize(ACanvas: TCanvas; Text: string; ARect: TRect; AFont: TFont; DTFlags: Integer): Integer; var i: Integer; R: TRect; W, H: Integer; Temp: TFont; begin i := 37; W := ARect.Right - ARect.Left; H := ARect.Bottom - ARect.Top; Temp := ACanvas.Font; ACanvas.Font := AFont; repeat Dec(i); ACanvas.Font.Size := i; R := ARect; DrawText(ACanvas.Handle, PChar(Text), Length(Text), R, DT_CALCRECT or DTFLags); until (i = 8) or ((R.Right - R.Left <= W) and (R.Bottom - R.Top <= H)); ACanvas.Font := Temp; Result := i; end; procedure TForm1.Button2Click(Sender: TObject); var RR: TRect; s: string; sz: Integer; begin RR := Rect(10, 10, 300, 80); s := "Однажды в студеную зимнюю пору я из лесу вышел, был сильный мороз"; sz := CalcFontSize(Canvas, s, RR, Canvas.Font, DT_CENTER or DT_VCENTER or DT_WORDBREAK); Canvas.Font.Size := sz; Canvas.Rectangle(RR); Canvas.Brush.Style := bsClear; DrawText(Canvas.Handle, PChar(s), Length(s), RR, DT_CENTER or DT_VCENTER or DT_WORDBREAK); end;

> DrawText - это успешно игнорирует, равно как и просто Canvas.
> Font.Size;

Для этого стоит использовать шрифт, для которого определен размер 1, Arial, например. А вот MS Serif, действительно, "игнорирует". Для этого необязательно терзать Canvas, попробуй просто в редакторе объектов поставить Font.Size = 1

← →
webpauk (2006-05-24 14:16) [7]

а как насчет загнать весть текст в Tbitmap, а Bitmap уже масштабировать (например загнать в Timage у которого есть свойство Stretch)

MBo - одна голова - хорошо, а форум - лучше.
Спасибо за процедуру.

Вывод текста на канву с масштабированием Найти похожие ветки