[gelöst] Automatische Breite für TEdit

[lt.col.blair]

Hallo,
ich bin dabei, einen erweiterten Nachkommen von TCustomEdit zu entwickeln. Unter anderem soll dieses Edit-Feld die Möglichkeit bieten, sich während der Eingabe in der Breite anzupassen.
Für die Berechnung der Breite verwende ich ein "TControlCanvas" und die Funktion "TextWidth".

Textwidth gibt immer zu kleine Werte aus. Z.B. bei Schriftgröße 20 wird "aaaaaaaaaa" mit Breite 110 Pixel ausgegeben. Tatsächlich belegen diese 10 a's aber 135Pixel (default Font, ich glaube das ist Arial (?)).

Ist das ein Bug in ... ja, in was denn ?

Hier sind dies Methoden, mit denen die Breitenanpassung erfolgt:

Code: Alles auswählen

 
procedure TTSCustomEdit.TextChanged;
var
  P, S: TPoint;
begin
	if fAutoSizeWidth then
  begin
	  P := CaretPos;
		inherited TextChanged;
	  AutoSetWidth;
	  S.X := 0; S.Y := 0;
		CaretPos := S;
		CaretPos := P;
	end
  else
		inherited TextChanged;
end;
 
procedure TTSCustomEdit.AutoSetWidth;
begin
  InvalidatePreferredSize;
  AdjustSize;
end;
 
procedure TTSCustomEdit.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
begin
	inherited CalculatePreferredSize(PreferredWidth, PreferredHeight, WithThemeSpace);
	PreferredWidth := CalcAutoWidth; //wird von TCustomEdit =0 gesetzt
end;
 
function TTSCustomEdit.CalcAutoWidth: Integer;
begin
  HelperCanvas.Control := Self;
	HelperCanvas.Font := Self.Font;
  Result := HelperCanvas.TextWidth(Self.Text);
  if BorderStyle = bsSingle then
  	inc(Result, 6)
end;
 

Nachtrag:
oops: ich vergaß: HelperCanvas muss natürlich erzeugt werden. Das passiert bei mir im initialization-Teil der Unit:

Code: Alles auswählen

 
initialization
	HelperCanvas := TControlCanvas.Create;
finalization
	FreeAndNil(HelperCanvas);
 

[lt.col.blair]

... habe inzwischen weiterprobiert und festgestellt, dass TFont von TFPCustomFont abgeleitet ist, das wiederum eine Methode GetTextWidth enthält.
Wenn ich diese Methode verwende bessert sich leider auch nichts, denn - diese gibtt immer 16 zurück ... ?!??

[m.fuchs]

... habe inzwischen weiterprobiert und festgestellt, dass TFont von TFPCustomFont abgeleitet ist, das wiederum eine Methode GetTextWidth enthält.
Wenn ich diese Methode verwende bessert sich leider auch nichts, denn - diese gibtt immer 16 zurück ... ?!??

Ja, deren Implementation ist etwas seltsam:

Code: Alles auswählen

function TFPCustomFont.GetTextHeight (text:string) : integer;
begin
  if inheritsFrom (TFPCustomDrawFont) then
    result := TFPCustomDrawFont(self).DoGetTextHeight (text)
  else
   if assigned(FCanvas) then
     result := FCanvas.GetTextHeight (text)
   else 
     result :=16; // *some* default better than none.
end;

[m.fuchs]

Textwidth gibt immer zu kleine Werte aus. Z.B. bei Schriftgröße 20 wird "aaaaaaaaaa" mit Breite 110 Pixel ausgegeben. Tatsächlich belegen diese 10 a's aber 135Pixel (default Font, ich glaube das ist Arial (?)).

Was heißt denn bei dir, dass der Wert zu klein ist? Wird der Text abgeschnitten, wenn du ihn in ein 110 Pixel breites Label packst oder nur in deinem Editfeld? Im letzteren Fall ist alles okay, das Edit verbrät ja auch noch rechts und links ein bisschen Platz. Den müsstest du addieren.

[lt.col.blair]

das Edit verbrät ja auch noch rechts und links ein bisschen Platz.

Das könnten dann ja nur ein paar Pixel sein - in meinem Beispiel sind es bereits 25 Pixel. Vor allem müsste aber der Überstand konstant bleiben. Es ist aber so, dass die Differenz zwischen dem Ergebnis von "TextWidth" und der tatsächlichen Textbreite mit der Länge des Textes wächst.
Übrigens habe ich inzwischen auch für BorderStyle = bsNone einen zusätzlichen Rand eingebaut:

Code: Alles auswählen

 
  if BorderStyle = bsSingle then
  	inc(Result, 8)
  else
  	inc(Result, 4);
 

... das ändert aber leider nur, dass der Text nicht bereits von Anfang an "übersteht", sondern erst ab dem dritten eingegebenen Zeichen.

[lt.col.blair]

Habe mal einen Vergleich der Funktion TextWidth (bzw. TextExtent) in Delphi XE3 und Lazarus gemacht:
In einem Beispiel habe ich als Font "Stencil" 18pt eingestellt und die Breite eines "B" berechnen lassen.

In DXE wird die Berechnung in der Win-API aufgerufen durch

Code: Alles auswählen

Winapi.Windows.GetTextExtentPoint32(FHandle, Text, Length(Text), Result);

Für das Besipiel wird eine Breite von 18 Pixel zurückgegeben.

In Lazarus wird (natürlich) der Umweg über das WidgetSet gemacht:

Code: Alles auswählen

Result := WidgetSet.GetTextExtentPoint(DC, Str, Count, Size);

was dann im Windows WidgetSet (TWin32WidgetSet) zu folgendem Aufruf führt:

Code: Alles auswählen

Result := Windows.GetTextExtentPoint32W(DC, PWideChar(W), Length(W), @Size);

Für das Besipiel wird eine Breite von 13 Pixel zurückgegeben.

... Ich hab' mal versucht, die WinAPI-Funktion direkt aufzurufen:

Code: Alles auswählen

Windows.GetTextExtentPoint32(HelperCanvas.Handle, pchar(s), length(s), Sz);

Bringt dasselbe Ergebnis wie vorher (13 Pixel Breite).


Mir fällt nur noch ein, dass evtl. das Font nicht das ist, welches ich erwarte. Weiß jemand, wie ich herausbekommen kann, welches Font dem Canvas mit dem Handle zugeordnet ist?
Ich verstehe auch noch immer nicht, woher Lazarus die "echten" Fonts bekommt (bzw. wie man die "echten" Daten auslesen kann), wenn ein Font auf "default" steht.

[theo]

Mir fällt nur noch ein, dass evtl. das Font nicht das ist, welches ich erwarte. Weiß jemand, wie ich herausbekommen kann, welches Font dem Canvas mit dem Handle zugeordnet ist?
Ich verstehe auch noch immer nicht, woher Lazarus die "echten" Fonts bekommt (bzw. wie man die "echten" Daten auslesen kann), wenn ein Font auf "default" steht.

Das Problem entsteht wahrsch. dadurch, dass der HelperCanvas nur "Default" als Font Information bekommt, jedoch offenbar einen anderen "Default" Wert hat, als das TEdit.
Sobald du dem TEdit Font eine bestimmte Grösse gibst, funktioniert's ja.
Ich weiss grad auch nicht wie man das bei "Default" rauskriegt.

Das schon gelesen?
http://forum.lazarus.freepascal.org/ind ... ic=22212.0
http://lists.lazarus.freepascal.org/pip ... 43941.html

[Michl]

Ich habe das mal nur auf die Schnelle probiert. Bei mir wird zumindest die TextWidth ordentlich zurückgegeben (unter Win7). Evtl. hilft Dir die Überlegung das Canvas vom Edit zu verwenden (weiss auch nicht, ob das plattformübergreifend möglich ist)?:

Code: Alles auswählen

uses ... LCLIntf;
 
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  aCanvas: TCanvas;
  twoBorderWidth, aWidth, someWidth: Integer;
begin
  if not (Sender is TEdit) then Exit;
 
  someWidth:=16;
  twoBorderWidth:=TEdit(Sender).Width - TEdit(Sender).ClientWidth;
 
  aCanvas:=TCanvas.Create;
  try
    aCanvas.Handle:=GetDC(TEdit(Sender).Handle);  
    aWidth:=aCanvas.GetTextWidth(TEdit(Sender).Text);
    TEdit(Sender).Width:=aWidth + twoBorderWidth + someWidth;
  finally
    aCanvas.Free;
  end;
end;

[lt.col.blair]

Hallo,
hab' das gerade ausprobiert:

Code: Alles auswählen

 
function TTSCustomEdit.CalcAutoWidth: Integer;
var
  S: string;
  cv: TCanvas;
begin
  S := Self.Text;
  Cv := TCanvas.Create;
  try
    Cv.Font := Self.Font;
    Cv.Handle := GetDC(Self.Handle);
    Result := Cv.GetTextWidth(S);
  finally
    Cv.Free;
  end;
  Result := Result + fGutterRight + fGutterLeft;
end;
 

Wenn ich die Zeile "cv.Font := Self.Font" noch hinzufüge funktioniert's. Ich hab' zwar nicht verstanden, warum, aber trotzdem Vielen Dank!!!

<Edit>...
Hängt offensichtlich damit zusammen, dass ich mein "HelperCanvas" als globale Variable deklariert und verwendet habe.
Habe jetzt das HelperCanvas als Feld der Klasse definiert (braucht ca. 750 Byte pr. TEdit) und alles geht wunderbar.