Ver Mensaje Individual
  #3  
Antiguo 07-10-2016
Avatar de geolife
[geolife] geolife is offline
Miembro Premium
 
Registrado: nov 2006
Ubicación: Barcelona
Posts: 87
Reputación: 18
geolife Va por buen camino
Hola Dec,

Muchísimas gracias por tu aportación y ayuda!

Al final he conseguido poder extender esta funcionalidad también en el componente TBalloohint; así que lo comparto aquí con vosotros, junto con tu código.

Código Delphi [-]
// Extendemos la clase TCustomHintWindow
type
  TMyHintWindow=class(TCustomHintWindow)
  protected
    procedure Paint; override;
  end;


// Declaración procedimiento
procedure TMyHintWindow.Paint;
begin
  Canvas.Font.Name := 'STXihei';
  inherited;
end;

//Ya dentro del programa hacemos lo siguiente, pintamos el componente TBallooHint con nuestro TMyHintWindows:
BalloonHint1.PaintHint(TMyHintWindow.Create(Form1));



Cita:
Empezado por dec Ver Mensaje
Hola,

Seguramente no te sirva, pero, yo uso la siguiente unidad para manejar el "hint" de mis programas, y, en este caso sí que es posible cambiar el tamaño de la fuente, entre otras cosas.

Código Delphi [-]
unit ProgramHint;

interface

uses
  // Delphi
  Vcl.Controls,
  System.Classes,
  Winapi.Windows;

type
  TProgramHint = class(THintWindow)
  private
    procedure AppHint(var HintStr: string; var CanShow:
     Boolean; var HintInfo: Vcl.Controls.THintInfo);
  protected
    procedure Paint(); override;
  public
    function ShouldHideHint(): Boolean; override;
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

implementation

uses
  // Delphi
  Vcl.Forms,
  System.Types;

{ TProgramHint }

constructor TProgramHint.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Canvas.Font.Size := 9;
  Canvas.Font.Name := 'Tahoma';
  Application.OnShowHint := Self.AppHint;
end;

procedure TProgramHint.Paint();
var
  R: TRect;
begin
  R := Rect(10, 10, ClientRect.Right, ClientRect.Bottom);
  DrawText(Canvas.handle, Caption, Length(Caption), R, DT_WORDBREAK);
end;

function TProgramHint.ShouldHideHint(): Boolean;
begin
  Result := True;
end;

procedure TProgramHint.AppHint(var HintStr: string;
 var CanShow: Boolean; var HintInfo: Vcl.Controls.THintInfo);
begin
  HintInfo.HintMaxWidth := 300;
  HintInfo.HideTimeout := 20 * 1000; // 30 seconds
end;

procedure TProgramHint.ActivateHint(Rect: TRect; const AHint: string);
begin
  if ProgramConfig.GUI.ShowHints then
  begin
    Inc(Rect.Bottom, 20);
    Inc(Rect.Right, 20);
    UpdateBoundsRect(Rect);
    inherited;
  end;
end;

initialization
  Application.ShowHint := False;
  HintWindowClass := TProgramHint;
  Application.ShowHint := True;

end.

Sé que no respondo a tu pregunta, pero, igual puede servir de algo aún así.

Última edición por geolife fecha: 07-10-2016 a las 19:26:28.
Responder Con Cita