автоматическое изменение размер текста в label

[SERG1980]

Извиняюсь. Тогда через канву как вам сказали выше

[xexxex]

Может както подумать в таком направлении:
var
RL, R: TRect;
begin
Label1.AutoSize := False;
Label1.WordWrap := False;
Label1.Width := 10;
Label1.Height := 20;
RL := Label1.ClientRect;
R := RL;
with Label1 do
repeat
Font.Size := FontSize-1;
DrawText(Canvas.hadnle, Caption, Len, R, Flags or DT_CALCRECT)
until ((R.Right-R.Left) <= (RL.Right-RL.Left)) and
((R.Bottom-R.Top) <= (RL.Bottom-R.Top));
end;
написано на коленке ес-но

[ArtGrek]

самому ето нужно
вот что я нашел в модуле Graphics

function TFont.GetSize: Integer;
begin
  Result := -MulDiv(Height, 72, FPixelsPerInch);
end;

procedure TFont.SetSize(Value: Integer);
begin
  Height := -MulDiv(Value, FPixelsPerInch, 72);
end;

если не ошибаюсь, ето получение и установка размера Label
FPixelsPerInch - Количество пикселей на дюйм

думаю из етого можно рассчитать Label.Font.Size зная Label.Hight
правда как еше не разобрался, может кто нибуд съумеет...

[ArtGrek]

вот мои метод растягивания Label (под Label я ставлю Image, что б наводя мышкои на торчашие края Image делат Resize)

// определение с какои из 4 сторон мы делаем Resize
procedure TForm2.Image2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PresF:= True;
  x2 := x;
  y2 := y;
  if x < 6 then
  begin
    PresF1 := True;
  end;
  if x > Image2.Width - 6 then
  begin
    PresF2 := True;
  end;
  if y < 6 then
  begin
    PresF3 := True;
  end;
  if y > Image2.Height - 6 then
  begin
    PresF4 := True;
  end;
end;

procedure TForm2.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if PresF then
  begin
    if PresF1 then
    begin
      TLabel(TekstS).Left := TLabel(TekstS).Left - (x2 - x);
      TLabel(TekstS).Width := TLabel(TekstS).Width + (x2 - x);
      TLabel(TekstS).Font.Size := -MulDiv(TLabel(TekstS).Width, 72, PixelsPerInch);
      Frame(TekstS);
    end;
    if PresF2 then
    begin
      TLabel(TekstS).Width := TLabel(TekstS).Width - (x2 - x);
      x2 := x;
      TLabel(TekstS).Font.Size := -MulDiv(TLabel(TekstS).Width, 72, PixelsPerInch);
      Frame(TekstS);
    end;
    if PresF3 then
    begin
      TLabel(TekstS).Top := TLabel(TekstS).Top - (y2 - y);
      TLabel(TekstS).Height := TLabel(TekstS).Height + (y2 - y);
      TLabel(TekstS).Font.Size := -MulDiv(TLabel(TekstS).Height, 72, PixelsPerInch);
      Frame(TekstS);
    end;
    if PresF4 then
    begin
      TLabel(TekstS).Height := TLabel(TekstS).Height - (y2 - y);
      y2 := y;
      TLabel(TekstS).Font.Size := -MulDiv(TLabel(TekstS).Height, 72, PixelsPerInch);
      Frame(TekstS);
    end;
  end;
end;

procedure TForm2.Image2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PresF1 := False;
  PresF2 := False;
  PresF3 := False;
  PresF4 := False;
  PresF := False;
end;

при изменении высоты все хорошо, но вот если начнеш изменят ширину, все куда то улетает, думаю делло во втором параметре '72',

[xexxex]

Рабочая функция.
Устанавливаем текст и размеры лебела и вызываем функцию

function CalkLabelFont(Lb: TLabel): Boolean;
const Flags = DT_LEFT	or DT_NOCLIP or DT_WORDBREAK or DT_CALCRECT;
var R: TRect;
begin
  Result := False;
  Lb.Canvas.Font := Lb.Font;
  while True do begin
    R := Lb.ClientRect;
    with Lb do
      DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R, Flags);
    if IsRectEmpty(R) then Exit;
    with Lb.ClientRect do
      if ((R.Right-R.Left) <= (Right-Left)) and ((R.Bottom-R.Top) <= (Bottom-Top)) then Break;
    Lb.Canvas.Font.Height := Lb.Canvas.Font.Height +1;
//    Lb.Canvas.Font.Size := Lb.Canvas.Font.Size -1;
  end;
  Result := True;
  Lb.Font := Lb.Canvas.Font;
end;

правда в какойто критический момент зависает цикл. надо сделать проверку.

[ArtGrek]

пост 14 поправка
исползуеца высота текста, а не Label
TLabel(TekstS).Font.Size := -MulDiv(TLabel(TekstS).Font.Height, 72, PixelsPerInch);