1 respuesta en este tema

[Desart]

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.

delphi

[pre]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;
 
}[/pre]

[Desart]

Hola Compañeros os dejo una nueva versión mejorada y cpmentada, ya comentareis.

delphi

//Idea original bajada de: [url=http://www.swissdelphicenter.ch/torry/showcode.php?id=1390]http://www.swissdelphicenter.ch/torry/showcode.php?id=1390[/url]
unit UHINTPRO2;
 
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,ConstHintRPenColor:TColor;
    ConstTextLeft,ConstHintSpacePlus,ConstHintFontSize,ConstHintRPenWith,ConstHintRAcncho:Integer;
    ConstHintFontStyle,ConstHintRStyle:Integer;
    ConstImagenBoolean:Boolean;
    ConstFicheroBMP,ConstHintFontNAme: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:
   }
    //--General
    ConstColor1:=ClBlue;                      //Color del fondo del Texto
    ConstTextLeft:=32;                        //Espacio a mover el texto desde la Izquierda
    ConstHintSpacePlus:=200;                  //Espacio a dejar de más a la derecha
    ConstImagenBoolean:=False;                //Usar una imagen a la izq
    ConstFicheroBMP:='';                      //Ruta y nombre del archivo BMP a usar ejp. 'C:\Flecha.bmp'
 
    //--Para El Font
    ConstHintFontNAme:='Arial';               //Fuenta a usar en el Hint
    ConstHintFontSize:=10;                    //Tamaño de la fuente a usar
    ConstHintFontStyle:=1;                    //Estilo a usar en la fuente 1 Negrita, 2 Cursiva,
                                              //3 Negrita y cursiva, 0 sin formato
    ConstColorFont:=clYellow;                 //Color de la fuente a usar
 
    //Para el Recuadro  a la izq.
    ConstHintRPenWith:=1;                     //Tamaño del Lapiz a usar para pintar el borde del recuadro izq.
    ConstHintRAcncho:=30;                     //Ancho del recuadro izq.
    ConstHintRPenColor:=clGray;               //Color del Lapiz a usar
    ConstHintRStyle:=0;                       //Estilo para el relleno del Recuadro Izq. 0 BsSolid, 1 Bsclear,
                                              //2 BsHorizontal, 3 BsVertical, 4 BsFDiagonal, 5 BsBDiagonal
                                              //6 BsCross y 7 BsDiagCross
    ConstColor2:=clYellow;                    //Color del Relleno del Recuadro Izq.
 
  with Canvas.Font do
  begin
    Name := ConstHintFontNAme;
    if (ConstHintFontStyle>3) or (ConstHintFontStyle<0) then ConstHintFontStyle:=0;
    case ConstHintFontStyle of
      0:Style:=Style +[];
      1:Style:=Style +[fsBold];
      2:Style:=Style +[fsItalic];
      3:Style:=Style +[fsBold,fsItalic];
    end;
    Size:=ConstHintFontSize;
    Color :=ConstColorFONT;
  end;
end;
 
procedure TGraphicHintWindow.Paint;
var
  R: TRect;
  bmp: TBitmap;
begin
  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 := ConstHintFontNAme;
    if (ConstHintFontStyle>3) or (ConstHintFontStyle<0) then ConstHintFontStyle:=0;
    case ConstHintFontStyle of
      0:Style:=Style +[];
      1:Style:=Style +[fsBold];
      2:Style:=Style +[fsItalic];
      3:Style:=Style +[fsBold,fsItalic];
    end;
    Size  :=ConstHintFontSize;
    Color :=ConstColorFONT;
  end;
 
  with Canvas do      //Dibuja el Rectangulo
  begin
    if (ConstHintRStyle>7) or (ConstHintRStyle<0) then ConstHintRStyle:=0;
    case ConstHintRStyle of
      0:Brush.Style := bsSolid;
      1:Brush.Style := bsClear;
      2:Brush.Style := bsHorizontal;
      3:Brush.Style := bsVertical;
      4:Brush.Style := bsFDiagonal;
      5:Brush.Style := bsBDiagonal;
      6:Brush.Style := bsCross;
      7:Brush.Style := bsDiagCross;
    end;
    Brush.Color :=ConstColor2;
    Pen.Color   :=ConstHintRPenColor;
    Pen.Width   :=ConstHintRPenWith;
    Rectangle(0, 0, ConstHintRAcncho, 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
 
Function CambiarFontHint(FontName:string;FontStyle,FontSize:integer;FontColor:Tcolor):Boolean;
begin     //HAy que usar la unit  UHINTPRO2
    ConstHintFontNAme:=FontName;              //Fuenta a usar en el Hint
    ConstHintFontSize:=FontSize;              //Tamaño de la fuente a usar
    ConstHintFontStyle:=FontStyle;            //Estilo a usar en la fuente 1 Negrita, 2 Cursiva,
                                              //3 Negrita y cursiva, 0 sin formato
    ConstColorFont:=FontColor;                //Color de la fuente a usar
    Result:=True;
end;  //EJEMPLOS CambiarFontHint('magneto',0,12,clWhite); o   CambiarFontHint('Courier',2,10,clYellow);
      //EJEMPLOS 2   CambiarFontHint('Times New Roman',1,12,clWhite); o  CambiarFontHint('Arial',3,11,clNavy);
 
 
Function CambiarCuadHint(CuadStyle,CuadPenWidt,CuadWidth:integer;CuadPenColor,CuadColor:Tcolor):Boolean;
begin    //HAy que usar la unit  UHINTPRO2
    ConstHintRPenWith:=CuadPenWidt;           //Tamaño del Lapiz a usar para pintar el borde del recuadro izq.
    ConstHintRAcncho:=CuadWidth;              //Ancho del recuadro izq.
    ConstHintRPenColor:=CuadPenColor;         //Color del Lapiz a usar
    ConstHintRStyle:=CuadStyle;               //Estilo para el relleno del Recuadro Izq. 0 BsSolid, 1 Bsclear,
                                              //2 BsHorizontal, 3 BsVertical, 4 BsFDiagonal, 5 BsBDiagonal
                                              //6 BsCross y 7 BsDiagCross
    ConstColor2:=CuadColor;                   //Color del Relleno del Recuadro Izq.
    Result:=True;
end;  //EJEMPLOS  CambiarCuadHint(7,2,35,clBlue,clWhite);  o  CambiarCuadHint(7,1,35,clnavy,$000066FF);
 
 
Function CambiarHint(ColorFONT,COLOR1,COLOR2:TColor;TextLeft,HintSpacePlus:Integer;ImagenBoolean:Boolean;FicheroBMP:string):boolean;
//Es comveniente usar esta función antes de usar CambiarFontHint o CambiarCuadHint ya que tine opciones de ambas incluidas
begin      //HAy que usar la unit  UHINTPRO2
    ConstColorFont:=ColorFONT;            //Color de la fuente a usar
                                          //Tambien se encuentra en  CambiarFontHint
    ConstColor1:=COLOR1;                  //Color del Fondo para el texto
    ConstColor2:=COLOR2;                  //Color del Relleno del Recuadro Izq.
                                          //Tambien se encuentra en  CambiarCuadHint
    ConstTextLeft:=TextLeft;              //Espacio a mover el texto desde la Izquierda
    ConstHintSpacePlus:=HintSpacePlus;    //Espacio a dejar de más a la derecha
    ConstImagenBoolean:=ImagenBoolean;    //Usar una imagen a la izq
    ConstFicheroBMP:=FicheroBMP;          //Ruta y nombre del archivo BMP a usar ejp. 'C:\Flecha.bmp'
    Result:=True;
end;  //  EJEMPLO:  CambiarHint(clNavy,clCream,clSilver,35,50,False,'');
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  HintWindowClass := TGraphicHintWindow;
  Application.HintPause:=800;
  Application.HintHidePause:=2000;
  Application.ShowHint := False;
  Application.ShowHint := True;
end;
 
}