[Delphi] font v TEdit

[dyžon]

dobrý den,
můžete mi prosím někdo pomoci s tímto kódem:

Kód: Vybrat vše

function VratDelkuTextu(const zprava: String; aFont: TFont): Integer;
var aBmp: TBitmap;
begin
  aBmp:= TBitmap.Create;
  try
    aBmp.Canvas.Font:= aFont;
    Result:= aBmp.Canvas.TextWidth(zprava);
  finally
    aBmp.Free;
  end;
end;
  ....
  max, min: Integer;
  max:= 10;
  min:= 6;
  ....
procedure TForm1.Edit1Change(Sender: TObject);
var velikost: Integer;
begin
  velikost:= Edit1.Font.Size;
  if VratDelkuTextu(edit1.Text, Edit1.Font) > Edit1.Width then
    begin
      if velikost > min then
        begin
          dec(velikost);
          Edit1.Font.Size:= velikost;
        end;
    end else begin
      if velikost < max then
        begin
          inc(velikost);
          Edit1.Font.Size:= velikost;
        end;
    end;
end;

jde mi o to, že píšu text do Editu, kterej má fixní velikost a já potřebuju, aby když je text delší se jeho velikost v Editu změnila na menší (nejmenší je min + 1) a naopak když je krátkej, tak zase zvětší (největší je max - 1) aby ten text byl vidět vždy celej.
napsal jsem si tenhle kód, ale pořád to nějak hapruje ..
nějakej nápad ??

[JanFiala]

Myslel jsi něco takového? jen musíš použít TTF font, třeba Consolas UI

Kód: Vybrat vše

const
  MaxFontSize = 10;
  MinFontSize = 6;

function VratDelkuTextu(AEdit: TEdit): Integer;
var
  myCanvas: TCanvas;
begin
  Result := -1;
  myCanvas := TControlCanvas.Create;
  try
    myCanvas.Handle := GetDC(AEdit.Handle);
    myCanvas.Font.Assign(AEdit.Font);
    Result := myCanvas.TextWidth(AEdit.Text);
  finally
    myCanvas.Free;
  end;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  Edit1.Font.Size := MaxFontSize + 1;
  while (VratDelkuTextu(Edit1) > (Edit1.ClientRect.Right-Edit1.ClientRect.Left))
      and (Edit1.Font.Size >= MinFontSize) do
    Edit1.Font.Size := Edit1.Font.Size - 1;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Font.Size := MaxFontSize;
end;


[dyžon]

jj, to je přesně ono,
místo TBitMap vytváříš jen TCanvas, to je super ...
možná poprosím jen o vysvětlení, proč jsi použil WHILE místo IF, ale jinak to funguje perfektně ..
díky moc.

[JanFiala]

Proč jsem použil While? Abych měl jistotu, že když tam třeba vložíš text přes paste - několik znaků najednou, že se to zmenší na správnou velikost - provede se potřebný počet kroků zmenšení

[dyžon]

díky ...

[Geniál]

jednoduše nastav FontSize na 0.0000000000000001 (modli se za decimal) a i souvětí vždy normálně narveš do minimálního textboxu. Uživatele jen potom upozorni že minimální požadavky na použití aplikace je 8k monitor, doporučený pak 16k, aby si to mohl pod zvětšovacím sklem přečíst. Není zač.

[dyžon]

teda Geniále, ja jsem v podstatě dobrý člověk, ale s tebou je fakt něco špatně.
proč nechodíš tam, kde tvůj názor někoho zajímá ??

je mi to líto, ale myslím si, že musíš být opravdu zoufalá existence.
a tak trochu mi přijde, že jsi ve svým nicku vypustil písmenko, správně nemá být Geniál, ale Genitál.

měj se krásně ...

PS: pokud tě můžu poprosit, tak nekomentuj moje otázky, jsou tu chytří a kvalitní lidé, tvůj názor opravdu není potřeba.