
{******************************************}
{               TAnyHint                   }
{                                          }
{       漫画风格及自绘画功能的Hint组件     }
{                                          }
{              作者：韦修毅                }           
{       联系Email：wxy_xp@163.com          }
{       版权所有 不可随意复制              }
{******************************************}

unit AnyHint;    
{$I AnyHint.Inc}                           
interface                            
uses
  Windows, Messages, SysUtils, Graphics,Classes, Controls, Forms,
  Dialogs, StdCtrls,ExtCtrls;

const
  CM_HINTNOTIFY=WM_USER+101;  
type
  TAnyHint = class;
  THintDirection=(hdUpLeft,hdUpRight,hdDownLeft,hdDownRight);
  TVAlignMent = (vtaTopJustify, vtaBottomJustify, vtaCenter);
  THintStyle = (hsNormal,hsCariHint,hsAuto);
  TBeforeHintEvent=procedure (AnyHint:TAnyHint;Rect:TRect;Text:string) of Object;
  TOwnerDraw=procedure (AnyHint:TAnyHint;Canvas:TCanvas;Rect:TRect;Text:string) of Object;
  TMeasureRect=procedure (AnyHint:TAnyHint;var Rect:TRect;Text:string) of Object;
  TAnyHint = class(TComponent)
  private
    FBackColor: TColor;
    FBorderColor: TColor;
    FFont: TFont;
    FOwnerDraw: TOwnerDraw;
    FMeasureRect: TMeasureRect;
    FDirection: THintDirection;
    FAlignment: TAlignment;
    FGraphic: TBitmap;
    FBeforeHint: TBeforeHintEvent;
    FTitle: string;
    FHintStyle: THintStyle;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure SetFont(const Value: TFont);
    procedure SetGraphic(const Value: TBitmap);
    procedure GraphicChange(Sender:TObject);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure UpdateFont;  
  published
    property Font:TFont read FFont write SetFont;
    property BackColor:TColor read FBackColor write FBackColor default $F0A07D;
    property BorderColor:TColor read FBorderColor write FBorderColor default clWhite;
    property Direction:THintDirection read FDirection write FDirection default hdDownRight;
    property Alignment:TAlignment read FAlignment write FAlignment default taLeftJustify;
    property Title:string read FTitle write FTitle;
    property Graphic:TBitmap read FGraphic write SetGraphic;
    property OnOwnerDraw:TOwnerDraw read FOwnerDraw write FOwnerDraw;
    property OnMeasureRect:TMeasureRect read FMeasureRect write FMeasureRect;
    property OnBeforeHint:TBeforeHintEvent read FBeforeHint write FBeforeHint;
    property HintStyle:THintStyle read FHintStyle write FHintStyle;
  end;
  TCariHint=class(THintWindow)
  private
    TempBmp:TBitmap;
    FLastActive: Cardinal;
    FAnyHint:TAnyHint;
    FDirection: THintDirection;
    FModified:Boolean;
    FGraphic: TBitmap;
    FUpdating:Boolean;
    FAlignment: TAlignment;
    FHintStyle: THintStyle;
    FOnCancelHint: TNotifyEvent;
    procedure GraphicChange(Sender:TObject);
    function FindAnyHint: TAnyHint;
    function GetTextRect(ACanvas: TCanvas; Text: string; R: TRect; HAlign: TAlignment;
      VAlign: TVAlignMent): TRect;
    procedure DrawHintText(Canvas: TCanvas;R:TRect;AText:string;IsCariHint:Boolean);
    function GetHintDirection(WorkRect:TRect;AWidth,AHeight:integer;Pos:TPoint;IsCariHint:Boolean):THintDirection;
    procedure SetDirection(const Value: THintDirection);
    procedure SetGraphic(const Value: TBitmap);
    procedure StopTimer;
    procedure HintNotify(var message:TMessage);message CM_HINTNOTIFY;
  protected
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
    procedure ActivateHintPos(const AHint: string;const HintPos:TPoint;HidePause:integer=0);
    procedure CancelHint;
    property Direction:THintDirection read FDirection write SetDirection;
    property Graphic:TBitmap read FGraphic write SetGraphic;
    property Alignment:TAlignment read FAlignment write FAlignment;
    property HintStyle:THintStyle read FHintStyle write FHintStyle;
    property OnCancelHint:TNotifyEvent read FOnCancelHint write FOnCancelHint;
  end;

procedure Register;

implementation
{$IFDEF Delphi6}
uses Types;
{$ENDIF}
{$R AnyHint.Res}
procedure Register;
begin
  RegisterComponents('AnyLib', [TAnyHint]);
end;

function Min(A1, A2: integer): integer;
begin
  Result := A1;
  if A2 < A1 then
    Result := A2;
end;

function Max(A1, A2: integer): integer;
begin
  Result := A1;
  if A2 > A1 then
    Result := A2;
end;

function GetHintRect(ACanvas:TCanvas;Text:string;GraphicWidth,GraphicHeight:integer;IsCariHint:Boolean):TRect;
var
  Lines:TStrings;
  i,H,W:integer;
  Len:integer;
  GraphiEmpty:Boolean;
  Added:Boolean;
  First:Boolean;
begin
  Lines:=TStringList.Create;
  try
    Lines.Text:=Text;                       
    H:=0;
    W:=0;
    GraphiEmpty:= GraphicWidth<=0;
    Added:=False;
    First:=True;
    for i:=0 to Lines.Count-1 do
    begin
      Len:=ACanvas.TextWidth(Lines[i]);
      if not GraphiEmpty then
      begin
        if (H<=GraphicHeight) and First then
        begin
          Inc(Len,GraphicWidth+6);
          First:=False;
        end;
        if not Added and (H+10>=GraphicHeight) then
        begin
          Added:=True;
          Inc(H,6);
        end;
      end;
      H:=H+ACanvas.TextHeight(Lines[i]);
      if W<Len then
        W:=Len;
    end;
    if H<GraphicHeight then
      H:=GraphicHeight;
    if IsCariHint then
    begin
      Inc(H,18);
      Inc(W,12);
      if H<35 then
        H:=35;
      if W<50 then
        W:=50;
    end
    else
    begin
      Inc(H,8);
      Inc(W,12);
    end;
    Result:=Classes.Rect(0,0,W,H);
  finally
    Lines.Free;
  end;
end;
{ TCariHint }
function CreateRegion(Mask: TBitmap; TransparentColor: TColor): HRGN;
var
  dc                : HDC;
  rgn               : HRGN;
  x, y              : integer;
  coord             : TPoint;
  line              : boolean;
  color             : TColor;
begin
  dc := Mask.Canvas.Handle;
  BeginPath(dc);
  for x := 0 to Mask.Width - 1 do
  begin
    line := False;
    for y := 0 to Mask.Height - 1 do
    begin
      color := Mask.Canvas.Pixels[x, y];
      if not (color = TransparentColor) then
      begin
        if not line then
        begin
          line := true;
          coord.x := x;
          coord.y := y;
        end;
      end;
      if ((color = TransparentColor))
        or (y = Mask.Height - 1) then
      begin
        if line then
        begin
          line := false;
          MoveToEx(dc, coord.x, coord.y, nil);
          LineTo(dc, coord.x, y);
          LineTo(dc, coord.x + 1, y);
          LineTo(dc, coord.x + 1, coord.y);
          CloseFigure(dc);
        end;
      end;
    end;
  end;
  EndPath(dc);
  rgn := PathToRegion(dc);
  Result := rgn;
end;
procedure TCariHint.ActivateHint(Rect: TRect; const AHint: string);
var
  P:TPoint;
begin
  GetCursorPos(P);
  ActivateHintPos(AHint,P);
end;

function GetCursorHeightMargin: Integer;
var
  IconInfo: TIconInfo;
  BitmapInfoSize, BitmapBitsSize, ImageSize: DWORD;
  Bitmap: PBitmapInfoHeader;
  Bits: Pointer;
  BytesPerScanline: Integer;

    function FindScanline(Source: Pointer; MaxLen: Cardinal;
      Value: Cardinal): Cardinal; assembler;
    asm
            PUSH    ECX
            MOV     ECX,EDX
            MOV     EDX,EDI
            MOV     EDI,EAX
            POP     EAX
            REPE    SCASB
            MOV     EAX,ECX
            MOV     EDI,EDX
    end;

begin
  { Default value is entire icon height }
  Result := GetSystemMetrics(SM_CYCURSOR);
  if GetIconInfo(GetCursor, IconInfo) then
  try
    GetDIBSizes(IconInfo.hbmMask, BitmapInfoSize, BitmapBitsSize);
    Bitmap := AllocMem(DWORD(BitmapInfoSize) + BitmapBitsSize);
    try
    Bits := Pointer(DWORD(Bitmap) + BitmapInfoSize);
    if GetDIB(IconInfo.hbmMask, 0, Bitmap^, Bits^) and
      (Bitmap^.biBitCount = 1) then
    begin
      { Point Bits to the end of this bottom-up bitmap }
      with Bitmap^ do
      begin
        BytesPerScanline := ((biWidth * biBitCount + 31) and not 31) div 8;
        ImageSize := biWidth * BytesPerScanline;
        Bits := Pointer(DWORD(Bits) + BitmapBitsSize - ImageSize);
        { Use the width to determine the height since another mask bitmap
          may immediately follow }
        Result := FindScanline(Bits, ImageSize, $FF);
        { In case the and mask is blank, look for an empty scanline in the
          xor mask. }
        if (Result = 0) and (biHeight >= 2 * biWidth) then
          Result := FindScanline(Pointer(DWORD(Bits) - ImageSize),
          ImageSize, $00);
        Result := Result div BytesPerScanline;
      end;
      Dec(Result, IconInfo.yHotSpot);
    end;
    finally
      FreeMem(Bitmap, BitmapInfoSize + BitmapBitsSize);
    end;
  finally
    if IconInfo.hbmColor <> 0 then DeleteObject(IconInfo.hbmColor);
    if IconInfo.hbmMask <> 0 then DeleteObject(IconInfo.hbmMask);
  end;
end;

procedure TCariHint.ActivateHintPos(const AHint: string;
  const HintPos: TPoint;HidePause:integer=0);
type
  TAnimationStyle = (atSlideNeg, atSlidePos, atBlend);
const
  AnimationStyle: array[TAnimationStyle] of Integer = (AW_VER_NEGATIVE,
    AW_VER_POSITIVE, AW_BLEND);
var
  PS:array[0..2] of TPoint;
  H:HRGN;
  Pos:TPoint;
  R,SaveRect:TRect;
  Dir:THintDirection;
  intW,intH:integer;
  AWidth,AHeight:integer;
  Rgn:HRGN;
  cR,cG,cB:Byte;
  Rect:TRect;
  IsCariHint: Boolean;
  AHintStyle: THintStyle;
  message           : MSG;
  OldTick:Cardinal;
  Proc: TMessageEvent;
  WorkArea:TRect;
  PT:PPoint;
procedure GetHintRgn;
var
  TempR:TRect;
  OffY:integer;
begin
  R.Right:=R.Right-R.Left;
  R.Left:=0;
  R.Bottom:=R.Bottom-R.Top;
  R.Top:=0;
  intW:=R.Right;
  intH:=R.Bottom;
  Pos:=HintPos;
  SystemParametersInfo(SPI_GETWORKAREA, 0, @TempR, 0);
  Dir:=GetHintDirection(TempR,intW,intH,Pos,IsCariHint);
  if IsCariHint then
  begin
    case Dir of
      hdUpLeft:
      begin
        OffY:=GetCursorHeightMargin;
        Pos.Y:=Pos.Y-6;
        R.Left:=Pos.X-(R.Right-5{16});
        R.Top:=Pos.Y-R.Bottom-OffY{16};
        R.Right:=R.Right+R.Left;
        R.Bottom:=R.Top+R.Bottom;
        SaveRect:=R;
        PS[0]:=Point(R.Right-16,R.Bottom-1);
        PS[1]:=Point(R.Right-16,R.Bottom+15);
        PS[2]:=Point(R.Right-16-17,R.Bottom-2);
        Rect:=Classes.Rect(R.Left,R.Top,R.Right,R.Bottom+16);
      end;
      hdUpRight:
      begin
        OffY:=GetCursorHeightMargin;
        Pos.Y:=Pos.Y-6;
        R.Left:=Pos.X-25{16};
        R.Top:=Pos.Y-R.Bottom-OffY{16};
        R.Right:=R.Right+R.Left;
        R.Bottom:=R.Top+R.Bottom;
        SaveRect:=R;
        PS[0]:=Point(R.Left+16,R.Bottom-1);
        PS[1]:=Point(R.Left+16,R.Bottom+16);
        PS[2]:=Point(R.Left+16+17,R.Bottom-1);
        Rect:=Classes.Rect(R.Left,R.Top,R.Right,R.Bottom+16);
      end;
      hdDownLeft:
      begin
        OffY:=GetCursorHeightMargin+10;
        //Pos.Y:=Pos.Y+15;
        R.Left:=Pos.X-(R.Right-16);
        R.Top:=Pos.Y+OffY{16};
        R.Right:=R.Right+R.Left;
        R.Bottom:=R.Top+R.Bottom;
        SaveRect:=R;
        PS[0]:=Point(R.Right-16,R.Top);
        PS[1]:=Point(R.Right-16,R.Top-16);
        PS[2]:=Point(R.Right-16-17,R.Top+1);
        Rect:=Classes.Rect(R.Left,R.Top-16,R.Right,R.Bottom);
      end;
      hdDownRight:
      begin
        OffY:=GetCursorHeightMargin+10;
        //Pos.Y:=Pos.Y+15;
        R.Left:=Pos.X-16;
        R.Top:=Pos.Y+OffY{16};
        R.Right:=R.Right+R.Left;
        R.Bottom:=R.Top+R.Bottom;
        SaveRect:=R;
        PS[0]:=Point(R.Left+16,R.Top);
        PS[1]:=Point(R.Left+16,R.Top-16);
        PS[2]:=Point(R.Left+16+17,R.Top+1);
        Rect:=Classes.Rect(R.Left,R.Top-16,R.Right,R.Bottom);
      end;
    end;
  end
  else
  begin
    case Dir of
      hdUpLeft:
      begin
        //OffY:=GetCursorHeightMargin;
        Pos.Y:=Pos.Y-15;
        R.Left:=Pos.X-(R.Right+10);
        R.Top:=Pos.Y-R.Bottom-0;
        R.Right:=R.Right+R.Left;
        R.Bottom:=R.Top+R.Bottom;
        SaveRect:=R;
        Rect:=Classes.Rect(R.Left,R.Top,R.Right,R.Bottom);
      end;
      hdUpRight:
      begin
        //OffY:=GetCursorHeightMargin;
        Pos.Y:=Pos.Y-15;
        R.Left:=Pos.X-10;
        R.Top:=Pos.Y-R.Bottom-0;
        R.Right:=R.Right+R.Left;
        R.Bottom:=R.Top+R.Bottom;
        SaveRect:=R;
        Rect:=Classes.Rect(R.Left,R.Top,R.Right,R.Bottom);
      end;
      hdDownLeft:
      begin
        OffY:=GetCursorHeightMargin;
        Pos.Y:=Pos.Y+OffY;
        R.Left:=Pos.X-(R.Right-0);
        R.Top:=Pos.Y+0;
        R.Right:=R.Right+R.Left;
        R.Bottom:=R.Top+R.Bottom;
        SaveRect:=R;
        Rect:=Classes.Rect(R.Left,R.Top,R.Right,R.Bottom);
      end;
      hdDownRight:
      begin
        OffY:=GetCursorHeightMargin;
        Pos.Y:=Pos.Y+OffY;
        R.Left:=Pos.X-0;
        R.Top:=Pos.Y+0;
        R.Right:=R.Right+R.Left;
        R.Bottom:=R.Top+R.Bottom;
        SaveRect:=R;
        Rect:=Classes.Rect(R.Left,R.Top-0,R.Right,R.Bottom);
      end;
    end;
  end;
end;
begin
  if TempBmp<>nil then
  begin
    TempBmp.Width:=0;
    TempBmp.Height:=0;
  end
  else
    TempBmp:=TBitmap.Create;
  try
    FAnyHint:=FindAnyHint;
    if FAnyHint=nil then
    begin
      AHintStyle:=FHintStyle;
      Canvas.Font.Color:=clBlack;
    end
    else
    begin
      AHintStyle:=FAnyHint.HintStyle;
      FGraphic.Assign(FAnyHint.FGraphic);
      Canvas.Font.Assign(FAnyHint.Font);
    end;
    IsCariHint:= (AHintStyle=hsCariHint) or ((AHintStyle=hsAuto) and
      (System.Pos(#13#10,AHint)>0));
    AWidth:=0;
    AHeight:=0;
    Caption:=AHint;
    if (FAnyHint<>nil) then
      if FAnyHint.Title<>'' then
        Caption:=FAnyHint.Title+#13#10+Caption;
    if (FGraphic<>nil) and
      (FGraphic.Width>0) and
      (FGraphic.Height>0) then
    begin
      AWidth:=FGraphic.Width;
      AHeight:=FGraphic.Height;
    end;
    R:=GetHintRect(Canvas,Caption,AWidth,AHeight,IsCariHint);
    GetHintRgn;
    case Dir of
      hdUpLeft:
      begin
        if (FAnyHint<>nil) and (Assigned(FAnyHint.FMeasureRect)) then
        begin
          FAnyHint.FMeasureRect(FAnyHint,R,Caption);
          OffSetRect(R,SaveRect.Right-R.Right,SaveRect.Bottom-R.Bottom);
          GetHintRgn;
        end;
      end;
      hdUpRight:
      begin                       
        if (FAnyHint<>nil) and (Assigned(FAnyHint.FMeasureRect)) then
        begin
          FAnyHint.FMeasureRect(FAnyHint,R,Caption);
          OffSetRect(R,0,SaveRect.Bottom-R.Bottom);
          GetHintRgn;
        end;
      end;
      hdDownLeft:
      begin
        if (FAnyHint<>nil) and (Assigned(FAnyHint.FMeasureRect)) then
        begin
          FAnyHint.FMeasureRect(FAnyHint,R,Caption);
          OffSetRect(R,SaveRect.Right-R.Right,SaveRect.Top-R.Top);
          GetHintRgn;
        end;
      end;
      hdDownRight:                
      begin
        if (FAnyHint<>nil) and (Assigned(FAnyHint.FMeasureRect)) then
        begin
          FAnyHint.FMeasureRect(FAnyHint,R,Caption);
          OffSetRect(R,0,SaveRect.Top-R.Top);
          GetHintRgn;
        end;
      end;
    end;
    if IsCariHint then
    begin
      PS[0].X:=PS[0].X-Rect.Left;
      PS[0].Y:=PS[0].Y-Rect.Top;
      PS[1].X:=PS[1].X-Rect.Left;
      PS[1].Y:=PS[1].Y-Rect.Top;
      PS[2].X:=PS[2].X-Rect.Left;
      PS[2].Y:=PS[2].Y-Rect.Top;
    end;
    R.Left:=R.Left-Rect.Left;
    R.Top:=R.Top-Rect.Top;             
    R.Right:=R.Right-Rect.Left;
    R.Bottom:=R.Bottom-Rect.Top;
    TempBmp.Width:=Rect.Right-Rect.Left;
    TempBmp.Height:=Rect.Bottom-Rect.Top+1;
    if FAnyHint=nil then
    begin
      cR:=GetRValue(ColorToRGB(clBlack))+1;
      cG:=GetGValue(ColorToRGB(clBlack))+2;
      cB:=GetBValue(ColorToRGB(clBlack))+3;
      TempBmp.Canvas.Brush.Color:=cB Shl 16 Or cG Shl 8  Or cR;
      TempBmp.Canvas.FillRect(Classes.Rect(0,0,TempBmp.Width,TempBmp.Height));
      TempBmp.Canvas.Brush.Color:=clInfoBk;//$F0A07D;
      TempBmp.Canvas.Pen.Color:=clBlack;//clWhite;
    end
    else
    begin
      cR:=GetRValue(ColorToRGB(FAnyHint.BorderColor))+1;
      cG:=GetGValue(ColorToRGB(FAnyHint.BorderColor))+2;
      cB:=GetBValue(ColorToRGB(FAnyHint.BorderColor))+3;
      TempBmp.Canvas.Brush.Color:=cB Shl 16 Or cG Shl 8  Or cR;
      TempBmp.Canvas.FillRect(Classes.Rect(0,0,TempBmp.Width,TempBmp.Height));
      TempBmp.Canvas.Brush.Color:=FAnyHint.BackColor;
      TempBmp.Canvas.Pen.Color:=FAnyHint.BorderColor;
    end;
    if IsCariHint then
    begin
      TempBmp.Canvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,15,20);
      H:=CreatePolygonRgn(PS, 3, WINDING);
      FillRgn(TempBmp.Canvas.Handle,H,TempBmp.Canvas.Brush.Handle);
      DeleteObject(H);
      TempBmp.Canvas.MoveTo(PS[0].X,PS[0].Y);
      TempBmp.Canvas.LineTo(PS[1].X,PS[1].Y);
      TempBmp.Canvas.LineTo(PS[2].X,PS[2].Y);
    end
    else
    begin
      TempBmp.Canvas.Rectangle(R.Left,R.Top,R.Right,R.Bottom);
      TempBmp.Canvas.Pen.Color:=RGB(212,208,200);
      TempBmp.Canvas.MoveTo(R.Left,R.Bottom-1);
      TempBmp.Canvas.LineTo(R.Left,R.Top);
      TempBmp.Canvas.LineTo(R.Right-1,R.Top);
    end;
    TempBmp.Canvas.Brush.Style:=bsClear;
    TempBmp.Canvas.Font.Assign(Canvas.Font);
    if (FAnyHint<>nil) and Assigned(FAnyHint.FBeforeHint) then
      FAnyHint.FBeforeHint(FAnyHint,R,Caption);
    if (FAnyHint<>nil) and Assigned(FAnyHint.FOwnerDraw) then
      FAnyHint.FOwnerDraw(FAnyHint,TempBmp.Canvas,R,Caption)
    else
      DrawHintText(TempBmp.Canvas,R,Caption,IsCariHint);
    if IsCariHint then
      Rgn:=CreateRegion(TempBmp,TempBmp.Canvas.Pixels[0,0])
    else
      Rgn:=CreateRegion(TempBmp,TempBmp.Canvas.Pixels[0,0]-1);
    SetWindowRgn(Handle,Rgn,True);
    SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0);
    if Rect.Left<WorkArea.Left then
      OffsetRect(Rect,WorkArea.Left-Rect.Left,0);
    if Rect.Top<WorkArea.Top then
      OffsetRect(Rect,0,WorkArea.Top-Rect.Top);

    if Rect.Right>WorkArea.Right then
      OffsetRect(Rect,WorkArea.Right-Rect.Right,0);
    if Rect.Bottom>WorkArea.Bottom then
      OffsetRect(Rect,0,WorkArea.Bottom-Rect.Bottom);

    SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top,
      Rect.Right-Rect.Left,
      Rect.Bottom-Rect.Top,SWP_NOACTIVATE);
    ShowWindow(Handle, SW_SHOWNOACTIVATE);
    Invalidate;
    if HidePause>0 then
    begin
      New(PT);
      PT^:=HintPos;
      PostMessage(Handle,CM_HINTNOTIFY,HidePause,integer(PT));
    end;
  finally
    FLastActive := GetTickCount;
  end;                               
end;                                           

procedure TCariHint.CancelHint;
begin
  StopTimer;
end;

constructor TCariHint.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csOpaque];
  with Canvas do
  begin
    Brush.Style := bsClear;
  end;
  FModified:=False;
  FGraphic:=TBitmap.Create;
  FAlignment:=taLeftJustify;
  FHintStyle:=hsAuto;
  if (csDesigning in ComponentState) and (FindResource(HInstance,'INFO',RT_BITMAP)<>0) then
    FGraphic.LoadFromResourceName(HInstance,'INFO');
  FGraphic.OnChange:=GraphicChange;     
end;

procedure TCariHint.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style - WS_BORDER;
    WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
  end;
end;

destructor TCariHint.Destroy;
begin
  if TempBmp<>nil then
    TempBmp.Free;
  FGraphic.OnChange:=nil;
  FGraphic.Free;
  StopTimer;
  inherited;
end;

procedure TCariHint.DrawHintText(Canvas: TCanvas; R: TRect; AText: string;IsCariHint:Boolean);
var
  i, T,L            : integer;
  ARect,tR          : TRect;
  Lines             : TStringList;
  Align             : TAlignment;
  GraphiEmpty       : Boolean;
  Index             : integer;
  TopText           : string;
  Delta             : integer;
begin
  if FAnyHint<>nil then
    Align:=FAnyHint.Alignment
  else
    Align:=FAlignment;
  ARect := R;
  InflateRect(ARect, -6, 0);
  T := 0;
  Lines := TStringList.Create;
  try
    R := ARect;
    Lines.Text:=AText;
    GraphiEmpty:=(FGraphic=nil) or
        (FGraphic.Width<=0) or (FGraphic.Height<=0);
    if not GraphiEmpty then
    begin
      L:=6+FGraphic.Width;
      Canvas.Draw(R.Left,R.Top+6,FGraphic);
      if not IsCariHint then
        Delta:=5
      else
        Delta:=10;
      T:=Delta;
      Index:=-1;
      TopText:='';
      for i := 0 to Lines.Count - 1 do
      begin
        TopText:=TopText+Lines[i]+#13#10;
        if (T>=FGraphic.Height) then
        begin
          Index:=i-1;
          Delete(TopText,Length(TopText)-1,2);
          Inc(T, Canvas.TextHeight(Lines[i]));
          Break;
        end;
        Inc(T, Canvas.TextHeight(Lines[i]));
      end;
      if Index=-1 then
        Index:=Lines.Count-1;
      tR := GetTextRect(Canvas, TopText,
        Rect(R.Left+L,R.Top+Delta,R.Right,R.Top+T),
        Align, vtaTopJustify);
      T:=0;
      for i:=0 to Index do
      begin
        case Align of
          taLeftJustify:Canvas.TextRect(R, tR.Left, tR.Top + T, Lines[i]);
          taCenter:begin
            Canvas.TextRect(R,tR.Left+
              (tR.Right-tR.Left- Canvas.TextWidth(Lines[i])) div 2,
              tR.Top+T,Lines[i]);
          end;
          taRightJustify:begin
            Canvas.TextRect(R, tR.Right-Canvas.TextWidth(Lines[i]),
            tR.Top + T, Lines[i]);
          end;
        end;
        Inc(T, Canvas.TextHeight(Lines[i]));
      end;
      Inc(T,6);
      L:=0;
      TopText:='';
      for i := Index+1 to Lines.Count - 1 do
        TopText:=TopText+Lines[i]+#13#10;
      Delete(TopText,Length(TopText)-1,2);
      tR:=GetTextRect(Canvas, TopText,
        Rect(R.Left+L,R.Top+T+6,R.Right,R.Bottom),
        Align, vtaTopJustify);
      T:=0;
      for i := Index+1 to Lines.Count - 1 do
      begin
        case Align of
          taLeftJustify:Canvas.TextRect(R, tR.Left, tR.Top + T, Lines[i]);
          taCenter:begin
            Canvas.TextRect(R,tR.Left+
              (tR.Right-tR.Left- Canvas.TextWidth(Lines[i])) div 2,
              tR.Top+T,Lines[i]);
          end;
          taRightJustify:begin
            Canvas.TextRect(R, tR.Right-Canvas.TextWidth(Lines[i]), tR.Top + T, Lines[i]);
          end;
        end;
        Inc(T, Canvas.TextHeight(Lines[i]));
      end;
    end
    else
    begin
      tR := GetTextRect(Canvas, Lines.Text, R, Align, vtaCenter);
      for i := 0 to Lines.Count - 1 do
      begin
        case Align of
          taLeftJustify:Canvas.TextRect(R, tR.Left, tR.Top + T, Lines[i]);
          taCenter:begin
            Canvas.TextRect(R,tR.Left+
              (tR.Right-tR.Left- Canvas.TextWidth(Lines[i])) div 2,
              tR.Top+T,Lines[i]);
          end;
          taRightJustify:begin
            Canvas.TextRect(R, tR.Right-Canvas.TextWidth(Lines[i]), tR.Top + T, Lines[i]);
          end;
        end;
        Inc(T, Canvas.TextHeight(Lines[i]));
      end;
    end;
  finally
    Lines.Free;
  end;
end;

function TCariHint.FindAnyHint: TAnyHint;
var
  I                 : Integer;
begin
  Result := nil;
  for I := 0 to Application.MainForm.ComponentCount - 1 do
    if Application.MainForm.Components[I] is TAnyHint then
    begin
      Result := TAnyHint(Application.MainForm.Components[I]);
      Exit;
   end;
end;

function TCariHint.GetHintDirection(WorkRect: TRect; AWidth, AHeight: integer;
  Pos: TPoint;IsCariHint:Boolean): THintDirection;
var
  R:TRect;
  isOk:Boolean;
  Delta:integer;
begin                                    
  R:=WorkRect;
  InflateRect(R,-10,-10);
  isOk:=False;
  if IsCariHint then
    Delta:=16
  else
    Delta:=0;
  if not FModified and (FAnyHint<>nil) then
    Result:=FAnyHint.Direction
  else Result:=FDirection;
  case Result of
    hdUpLeft:isOk:=((AHeight+Delta-(Pos.Y-R.Top))<0) and
      ((AWidth-Delta)<=(Pos.X-R.Left));
    hdUpRight:isOk:=((AHeight+Delta-(Pos.Y-R.Top))<0) and
      ((AWidth-Delta+Pos.X)<R.Right);
    hdDownLeft:isOk:=((AHeight+Delta-(R.Bottom-Pos.Y))<0) and
      ((AWidth-Delta)<=(Pos.X-R.Left));
    hdDownRight:isOk:=((AHeight+Delta-(R.Bottom-Pos.Y))<0) and
      ((AWidth-Delta+Pos.X)<R.Right);
  end;
  if isOk then Exit;
  if (AHeight+Delta-(Pos.Y-R.Top))<0 then
  begin
    if (AWidth-Delta+Pos.X)<R.Right then
      Result:=hdUpRight
    else                       
      Result:=hdUpLeft;
  end
  else
  begin
    if (AWidth-Delta+Pos.X)<R.Right then
      Result:=hdDownRight
    else
      Result:=hdDownLeft;
  end;
end;

function TCariHint.GetTextRect(ACanvas: TCanvas; Text: string; R: TRect;
  HAlign: TAlignment; VAlign: TVAlignMent): TRect;
var
  i, Len            : integer;
  Lines             : TStrings;
  str               : string;
  tR                : TRect;
  intW,intH         : integer;
begin
  Result := Rect(R.Left, R.Top, R.Left, R.Top);
  tR := Result;
  Lines := TStringList.Create;
  try
    Lines.Text := Text;
    for i := 0 to Lines.Count - 1 do
    begin
      str := Lines[i];
      if str <> '' then
      begin
        Len := ACanvas.TextWidth(str);
        if (tR.Right - tR.Left) < Len then
          tR.Right := tR.Left + Len;
        tR.Bottom := tR.Bottom + ACanvas.TextHeight(str);
      end;
    end;
    intW:=tR.Right-tR.Left;
    intH:=tR.Bottom-tR.Top;
    case HAlign of
      taLeftJustify: tR.Left := R.Left;
      taCenter: tR.Left := R.Left + Max((R.Right - R.Left - (tR.Right - tR.Left)) div 2, 0);
      taRightJustify: tR.Left := R.Right - (tR.Right - tR.Left);
    end;
    case VAlign of
      vtaTopJustify:
          tR.Top := R.Top+3;
      vtaBottomJustify:
          tR.Top := R.Bottom - (tR.Bottom - tR.Top)-1;
      vtaCenter:
          tR.Top := R.Top + Max((R.Bottom - R.Top - (tR.Bottom - tR.Top)) div 2, 0);
    end;
    tR.Right:=tR.Left+intW;
    tR.Bottom:=tR.Top+intH;
    Result := tR;
  finally
    Lines.Free;
  end;
end;

procedure TCariHint.GraphicChange(Sender: TObject);
begin
  if FUpdating then Exit;
  FUpdating:=True;
  try
    if (FGraphic<>nil) and not Graphic.Transparent then
    begin
      Graphic.TransparentColor:=Graphic.Canvas.Pixels[0,0];
      Graphic.Transparent:=True;
    end;
  finally
    FUpdating:=False;
  end; 
end;

procedure TCariHint.HintNotify(var message: TMessage);
var
  AMsg: MSG;
  HintControl:TControl;
  PT:PPoint;
  P:TPoint;
  function CursorPos:TPoint;
  begin
    GetCursorPos(P);
    Result:=P;
  end;
begin
  PT:=PPoint(Pointer(message.LParam));
  P:=PT^;
  HintControl:=FindDragTarget(P,True);
  Dispose(PT);
  SetTimer(Handle, 1, message.WParam, nil);
  while (GetMessage(AMsg, 0, 0, 0)) do
  begin
    if (AMsg.message = WM_QUIT) then
    begin
      PostQuitMessage(0);
      break;
    end
    else if (AMsg.message = WM_TIMER) and (AMsg.hwnd = Handle) then
    begin
      break;
    end
    else if ((AMsg.message >= WM_KEYFIRST) and (AMsg.message <= WM_KEYLAST)) or
      ((AMsg.message = CM_ACTIVATE) or (AMsg.message = CM_DEACTIVATE)) or
      (AMsg.message = CM_APPKEYDOWN) or (AMsg.message = CM_APPSYSCOMMAND) or
      (AMsg.message = WM_COMMAND) or ((AMsg.message > WM_MOUSEMOVE) and
      (AMsg.message <= WM_MOUSELAST)) or (AMsg.message = WM_NCMOUSEMOVE) then
    begin
      PostMessage(AMsg.hwnd, AMsg.message, AMsg.wParam, AMsg.lParam);
      break;
    end
    else if (AMsg.message=WM_MOUSEMOVE) and (HintControl<>FindDragTarget(CursorPos,True)) then
    begin
      PostMessage(AMsg.hwnd, AMsg.message, AMsg.wParam, AMsg.lParam);
      break;
    end
    else
    begin
      TranslateMessage(AMsg);
      DispatchMessage(AMsg);
    end;
  end;
  KillTimer(Handle, 1);
  ShowWindow(Handle,SW_HIDE);
  if Assigned(FOnCancelHint) then
    FOnCancelHint(Self);
end;

procedure TCariHint.Paint;
begin
  BitBlt(Canvas.Handle, 0, 0, TempBmp.Width, TempBmp.Height, TempBmp.Canvas.Handle,
    0, 0, SRCCOPY);
end;

procedure TCariHint.SetDirection(const Value: THintDirection);
begin
  if FDirection <> Value then
    FDirection:=Value;
  FModified:=True;  
end;

procedure TCariHint.SetGraphic(const Value: TBitmap);
begin
  FGraphic.Assign(Value);
end;


procedure TCariHint.StopTimer;
begin
  ShowWindow(Handle,SW_HIDE);
end;

{ TAnyHint }

procedure TAnyHint.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Application.ShowHint := not Application.ShowHint;
  Application.ShowHint := not Application.ShowHint;
  UpdateFont;
end;

constructor TAnyHint.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBackColor :=  clInfoBk;//$F0A07D;
  FBorderColor:=clBlack;//clWhite;
  FDirection:=hdDownRight;
  FAlignment:=taLeftJustify;
  FFont := TFont.Create;                
  FFont.Color := clBlack;//clWhite;
  FGraphic:=TBitmap.Create;
  if (csDesigning in ComponentState) and (FindResource(HInstance,'INFO',RT_BITMAP)<>0) then
    FGraphic.LoadFromResourceName(HInstance,'INFO');
  FGraphic.OnChange:=GraphicChange;
  if not (csDesigning in ComponentState) then
  begin
    HintWindowClass := TCariHint;
    Application.ShowHint := not Application.ShowHint;
    Application.ShowHint := not Application.ShowHint;
    UpdateFont;
  end;
end;

destructor TAnyHint.Destroy;
begin
  FFont.Free;
  FGraphic.OnChange:=nil;
  FGraphic.Free;
  inherited;
end;

procedure TAnyHint.GraphicChange(Sender: TObject);
begin
  if FGraphic<>nil then
  begin
    Graphic.TransparentColor:=Graphic.Canvas.Pixels[0,0];
    Graphic.Transparent:=True;
  end;
end;

procedure TAnyHint.Loaded;
begin
  if not (csDesigning in ComponentState) then         
  begin
    inherited Loaded;
    HintWindowClass := TCariHint;
    Application.ShowHint := not Application.ShowHint;
    Application.ShowHint := not Application.ShowHint;
    UpdateFont;
  end;
end;

procedure TAnyHint.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
  Application.ShowHint := not Application.ShowHint;
  Application.ShowHint := not Application.ShowHint;
  UpdateFont;
end;

procedure TAnyHint.SetGraphic(const Value: TBitmap);
begin
  FGraphic.Assign(Value);
end;

procedure TAnyHint.UpdateFont;
var
  I                 : Integer;
begin
  for I := 0 to Application.ComponentCount - 1 do
    if Application.Components[I] is TCariHint then
    begin
      TCariHint(Application.Components[I]).Canvas.Font.Assign(FFont);
      Exit;
    end;
end;

end.
