Hints modificados

[[José Luis Garcí]]

Os Dejo compañeros, el siguiente código, que debéis grabar en un archivo pas con el nombre UHINTPRO.


La verdad es que es bastante simple de usar y creo que queda muy curioso.

El código Original es de los Tips De Torry, lo he adaptado apenas y lo he metido en una unidad independeiente.

Código Delphi [-]

unit UHINTPRO;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TGraphicHintWindow = class(THintWindow)
    constructor Create(AOwner: TComponent); override;
  private
    FActivating: Boolean;
  public
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
  protected
    procedure Paint; override;
  published
    property Caption;
  end;

var ConstColorFONT,ConstCOLOR1,ConstCOLOR2:TColor;
    ConstTextLeft,ConstHintSpacePlus:Integer;
    ConstImagenBoolean:Boolean;
    ConstFicheroBMP:string;

implementation



constructor TGraphicHintWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  {
   Hier können beliebige Schrift Eigenschaften gesetzt
   werden.

   Here you can set custom Font Properties:
   }
    ConstColorFont:=clYellow;
    ConstColor1:=ClBlue;
    ConstColor2:=clYellow;
    ConstTextLeft:=30;
    ConstHintSpacePlus:=200;
    ConstImagenBoolean:=False;
    ConstFicheroBMP:='';

  with Canvas.Font do
  begin
    Name := 'Arial';
    Style := Style + [fsBold];
    Size:=10;
    Color :=ConstColorFONT;
  end;
end;

procedure TGraphicHintWindow.Paint;
var
  R: TRect;
  bmp: TBitmap;
begin
//  R:=Rect(0,0,350,50);
  R := ClientRect;
  Inc(R.Left, 2);
  Inc(R.Top, 2);

  {*******************************************************
   Der folgende Code ist ein Beispiel wie man die Paint
   Prozedur nutzen kann um einen benutzerdefinierten Hint
   zu erzeugen.

   The folowing Code ist an example how to create a custom
   Hint Object. :
   }

  bmp := TBitmap.Create;
  if ConstImagenBoolean=True then  bmp.LoadfromFile(ConstFicheroBMP);
  with Canvas.Font do
  begin
    Name := 'Arial';
    Style := Style + [fsBold];
    Size:=10;
    Color :=ConstColorFONT;
  end;

  with Canvas do      //Dibuja el Rectangulo
  begin
    Brush.Style := bsSolid;
    Brush.Color :=ConstColor2;
    Pen.Color   := clgray;
    Rectangle(0, 0, 30, R.Bottom + 1);
    Draw(2,(R.Bottom div 2) - (bmp.Height div 2), bmp);
  end;

  bmp.Free;
  //Beliebige HintFarbe
  //custom Hint Color
  Color :=ConstColor1;
  Canvas.Brush.Style := bsClear;
  Canvas.TextOut(ConstTextLeft, (R.Bottom div 2) - (Canvas.Textheight(Caption) div 2), Caption);  //Posicion del Texto

  {********************************************************}
end;

procedure TGraphicHintWindow.ActivateHint(Rect: TRect; const AHint: string);
begin
  FActivating := True;
  try
    Caption := AHint;
    //Höhe des Hints setzen setzen
    //Set the "Height" Property of the Hint
    Inc(Rect.Bottom, 14);
    //Breite des Hints setzen
    //Set the "Width" Property of the Hint
    Rect.Right := Rect.Right +ConstHintSpacePlus;
    UpdateBoundsRect(Rect);
    if Rect.Top + Height > Screen.DesktopHeight then
      Rect.Top := Screen.DesktopHeight - Height;
    if Rect.Left + Width > Screen.DesktopWidth then
      Rect.Left := Screen.DesktopWidth - Width;
    if Rect.Left < Screen.DesktopLeft then Rect.Left := Screen.DesktopLeft;
    if Rect.Bottom < Screen.DesktopTop then Rect.Bottom := Screen.DesktopTop;
    SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
      SWP_SHOWWINDOW or SWP_NOACTIVATE);
    Invalidate;
  finally
    FActivating := False;
  end;
end;
end.


{  Usar en la unidad principal de la aplicación

Function CambiarHint(ColorFONT,COLOR1,COLOR2:TColor;TextLeft,HintSpacePlus:Integer;ImagenBoolean:Boolean;Fich  eroBMP:string):boolean;
begin      //HAy que usar la unit  UHINTPRO
    ConstColorFont:=ColorFONT;
    ConstColor1:=COLOR1;
    ConstColor2:=COLOR2;
    ConstTextLeft:=TextLeft;
    ConstHintSpacePlus:=HintSpacePlus;
    ConstImagenBoolean:=ImagenBoolean;
    ConstFicheroBMP:=FicheroBMP;
    Result:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  HintWindowClass := TGraphicHintWindow;
  Application.HintPause:=800;
  Application.HintHidePause:=2000;
  Application.ShowHint := False;
  Application.ShowHint := True;
end;

}