[Delphi] font v TEdit

C++, C#, Visual Basic, Delphi, Perl a ostatní

Moderátor: Moderátoři Živě.cz

Odeslat příspěvekod dyžon 21. 11. 2018 14:04

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 ??
AMD FX-6300; Gigabyte 970A-DS3P; DDR3 8192MBytes; AMD Radeon HD 6700 Series
dyžon
Junior
Uživatelský avatar

Odeslat příspěvekod JanFiala 21. 11. 2018 15:05

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;
Co můžeš udělat dnes, odlož na včerejšek
JanFiala
Expert
Uživatelský avatar

Odeslat příspěvekod dyžon 23. 11. 2018 12:38

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.
AMD FX-6300; Gigabyte 970A-DS3P; DDR3 8192MBytes; AMD Radeon HD 6700 Series
dyžon
Junior
Uživatelský avatar

Odeslat příspěvekod JanFiala 23. 11. 2018 16:20

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í
Co můžeš udělat dnes, odlož na včerejšek
JanFiala
Expert
Uživatelský avatar

Odeslat příspěvekod dyžon 26. 11. 2018 09:21

díky ... ;-)
AMD FX-6300; Gigabyte 970A-DS3P; DDR3 8192MBytes; AMD Radeon HD 6700 Series
dyžon
Junior
Uživatelský avatar

Odeslat příspěvekod Geniál 10. 12. 2018 17:10

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č.
Geniál
Junior

Odeslat příspěvekod dyžon 13. 12. 2018 11:06

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.
AMD FX-6300; Gigabyte 970A-DS3P; DDR3 8192MBytes; AMD Radeon HD 6700 Series
dyžon
Junior
Uživatelský avatar


Kdo je online

Uživatelé procházející toto fórum: Žádní registrovaní uživatelé a 0 návštevníků