Label Hint Font,... ändern

[sstvmaster]

Hi,

ich möchte gern von einem oder mehreren Labels den Font Namen usw ändern.

Im Netz habe ich folgendes gefunden das funktioniert aber nicht, d.h. Code wird ohne Fehler übersetzt der Hint erscheint aber trotzdem in der Standard Formatierung.

Code: Alles auswählen

 
...
type
 
{ TMyHintWindow }
 
  TMyHintWindow = class(THintWindow)
    constructor Create(AOwner: TComponent); override;
  end;
 
...
 
{ TMyHintWindow }
 
constructor TMyHintWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  with Canvas.Font do
  begin
    Name := 'Fixedsys';
    Size := Size + 5;
    Style := [fsBold];
    Pitch := fpFixed; 
  end;
end;
 
...
 
procedure TMainForm.FormCreate(Sender: TObject);
begin
  HintWindowClass := TMyHintWindow;
end;
 

Ist das ein Bug oder was mache ich falsch?

[pluto]

Versuch mal folgendes(ist aus dem Kopf geschrieben):

Code: Alles auswählen

var
  TextStyle:TTextStyle;
begin
  Textstyle.SystemFont:=false;
  Canvas.TextStyle:=TextStyle;  

TTextStyle findest du in der LCLInft unit.

[sstvmaster]

Geht leider auch nicht. Hatte auch das hier gefunden: https://forum.lazarus.freepascal.org/in ... ic=27518.0

Ich denke es funktioniert deshalb nicht weil TLabel kein OnShowHint hat, dort könnte man das machen.
Aber Hint nimmt Font Name und Size nicht an, das habe ich auf dem Form Hint probiert.

Code: Alles auswählen

HintInfo^.

hat als einziges Style Element nur HintColor, kein Size und Font.

[sstvmaster]

Habe mal ein wenig getestet, anbei das was dabei herausgekommen ist.

Das hat nur das Problem das die größe des "Hints" nicht richtig berechnet wird.

Mir wäre so eine Hint wie er im Quelltexteditor ist lieber.

[six1]

Hi,
meiner Meinung nach, wird der PopupNotifier nicht richtig gezeichnet.
Ich habe es auch nicht richtig hin bekommen, lediglich über einen Trick,
indem ich PopupNotifier1.Visible nochmal gewechselt habe.

Meine Umgebung: WIN10, Lazarus 2.0 32 Bit fpc 3.0.4

Code: Alles auswählen

 
procedure TForm1.Label1MouseEnter(Sender: TObject);
var
  aPoint: TPoint;
  aRect: TRect;
begin
  PopupNotifier1.Visible := true;
  GetCursorPos(aPoint);
  PopupNotifier1.ShowAtPos(aPoint.x - 10, aPoint.y + 20);
 
  PopupNotifier1.vNotifierForm.Font.Name := 'Courier New';
  PopupNotifier1.vNotifierForm.Font.Size := 8;
  PopupNotifier1.vNotifierForm.Font.Pitch := fpFixed;
 
  PopupNotifier1.Title := '';
  PopupNotifier1.Text := TLabel(Sender).Hint;
 
  aRect := PopupNotifier1.vNotifierForm.CalcHintRect(400, TLabel(Sender).Hint , nil);
 
  PopupNotifier1.vNotifierForm.Width := aRect.Right - aRect.Left + 10;
  PopupNotifier1.vNotifierForm.Height := aRect.Bottom - aRect.Top + 50;
 
  PopupNotifier1.Visible := false;
  PopupNotifier1.Visible := true;
end;                 
 

[pluto]

PopupNotifier1.invalidate(oder so ähnlich) könnte helfen, statt zwei mal Visible zu verändern, was vielleicht das gleiche auslöst...

[sstvmaster]

@six1, pluto

So geht es besser.

Code: Alles auswählen

procedure TForm1.Label1MouseEnter(Sender: TObject);
var
  aPoint: TPoint;
  aRect: TRect;
begin
  aPoint.x:=-1;
  aPoint.y:=-1;
 
  GetCursorPos(aPoint);
  //PopupNotifier1.ShowAtPos(aPoint.x - 10, aPoint.y + 20);  // <-- weg
  PopupNotifier1.Title := '';
  PopupNotifier1.Text := TLabel(Sender).Hint;
 
  // Rect
  aRect := PopupNotifier1.vNotifierForm.CalcHintRect(400, TLabel(Sender).Hint , nil);
  PopupNotifier1.vNotifierForm.SetInitialBounds(aPoint.x - 10, aPoint.y + 20, aRect.Width, aRect.Height); // <-- hier die größe setzen
  PopupNotifier1.vNotifierForm.HintRect := aRect;
  PopupNotifier1.vNotifierForm.Width := aRect.Right - aRect.Left + 10;
  PopupNotifier1.vNotifierForm.Height := aRect.Bottom - aRect.Top + 50;
 
  // Alpha
  PopupNotifier1.vNotifierForm.AlphaBlend := true;
  PopupNotifier1.vNotifierForm.AlphaBlendValue := 220;
 
  // Style
  PopupNotifier1.vNotifierForm.Font.Name := 'Courier New';
  PopupNotifier1.vNotifierForm.Font.Size := 8;
  PopupNotifier1.vNotifierForm.Font.Pitch := fpFixed;
 
  // Rahmen?
  PopupNotifier1.vNotifierForm.Canvas.Pen.Width:=1;
  PopupNotifier1.vNotifierForm.Canvas.Pen.Color:=clBlack;
  PopupNotifier1.vNotifierForm.Canvas.Rectangle(aPoint.x-11, aPoint.y+21, aRect.Right-aRect.Left+9, aRect.Bottom-aRect.Top+49);
 
  // Anzeigen
  PopupNotifier1.vNotifierForm.Show;
end;

Und dann im OnMouseLeave:

Code: Alles auswählen

procedure TForm1.Label1MouseLeave(Sender: TObject);
begin
  PopupNotifier1.vNotifierForm.Hide;
end; 

Nun wollte ich noch einen Rahmen zeichen, das klappt aber nicht.

Vielen Dank

[pluto]

Nun wollte ich noch einen Rahmen zeichen, das klappt aber nicht.

Was hast du probiert?
Aha:

Code: Alles auswählen

PopupNotifier1.vNotifierForm.Canvas.Rectangle(aPoint.x-11, aPoint.y+21, aRect.Right-aRect.Left+9, aRect.Bottom-aRect.Top+49);

Teste mal

Code: Alles auswählen

Canvas.Frame();

Jedoch scheinen deine -11 +11 außerhalb deines Fensters zu liegen...

Code: Alles auswählen

Canvas.Frame(aPoint.x, aPoint.y, aRect.Right-aRect.Left, aRect.Bottom-aRect.Top);

Warum nutzt du nicht, das aRect? dass sollte doch die Position vom Fenster haben....
aPoint scheint nur die Maus Position zu haben....

[sstvmaster]

Canvas.Frame oder FrameRect geht auch nicht.

Warum nutzt du nicht, das aRect? dass sollte doch die Position vom Fenster haben....
aPoint scheint nur die Maus Position zu haben....

aRect.Top und Left sind 0. Der Rahmen um den Notifier sollte ja auch bei der Position aPoint.x - 10, aPoint.y + 20 beginnen, siehe SetInitialBounds.

Aber das mit dem Rahmen ist nicht wichtig, wäre nur schön gewesen.

[wp_xyz]

Im Netz habe ich folgendes gefunden das funktioniert aber nicht

Code: Alles auswählen

 
...
{ TMyHintWindow }
 
constructor TMyHintWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  with Canvas.Font do    // <--- Warum hier "Canvas"?
  begin
    Name := 'Fixedsys';
    Size := Size + 5;
    Style := [fsBold];
    Pitch := fpFixed; 
  end;
end;
 

Leider steht im Netz mancher Blödsinn... Warum setzt du hier den Font des Canvas, und nicht den des HintWindow? Ich denke mal (zumindest machen es alle visuellen Komponenten so), dass HintWindow seinen eigenen Font auf den des Canvas überträgt, bevor es angezeigt wird - dadurch wird dein im Create zugewiesener Canvas.Font überschrieben. Wenn oben bei "Canvas.Font" das "Canvas." weggelassen wird, funktioniert es.

Alternativ, kannst du auch einfach den Screen.HintFont entsprechend setzen:

Code: Alles auswählen

procedure TForm1.FormCreate(Sender: TObject);
begin
  Screen.HintFont.Name := 'FixedSys';
  Screen.HintFont.Size := Screen.HintFont.Size + 5;
  Screen.HintFont.Style := [fsBold];
  Screen.HintFont.Pitch := [fpFixed];
end;  

[sstvmaster]

@wp

Ah, font darf nicht fixedsys sein dann klappt das auch mit der Fontgröße.

Eigentlich logisch.

Danke für eure Hilfe