unit Danhint;interfaceusesSysUtils, Windows, Messages, Classes, Graphics, Controls,Forms, Dialogs;typeTHintDirection=(hdUpRight,hdUpLeft,hdDownRight,hdDownLeft);TOnSelectHintDirection=procedure(HintControl:TControl;var HintDirection:THintDirection) of object;TDanHint = class(TComponent)private{ Private declarations }FHintDirection:THintDirection;FHintColor:TColor;FHintShadowColor:TColor;FHintFont:TFont;FHintPauseTime:Integer;FOnSelectHintDirection:TOnSelectHintDirection;procedure SetHintDirection(Value:THintDirection);procedure SetHintColor(Value:TColor);procedure SetHintShadowColor(Value:TColor);procedure SetHintFont(Value:TFont);procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED;procedure SetHintPauseTime(Value:Integer);protected{ Protected declarations }public{ Public declarations }constructor Create(AOwner:TComponent);override;destructor Destroy;override;procedure Loaded;override;procedure SetNewHintFont;published{ Published declarations }property HintDirection:THintDirection read FHintDirection write SetHintDirection default hdUpRight;property HintColor:TColor read FHintColor write SetHintColor default clYellow;property HintShadowColor:TColor read FHintShadowColor write SetHintShadowColor default clPurple;property HintFont:TFont read FHintFont write SetHintFont;property HintPauseTime:Integer read FHintPauseTime write SetHintPauseTime default 600;property OnSelectHintDirection:TOnSelectHintDirection read FOnSelectHintDirection write FOnSelectHintDirection;end;TNewHint = class(THintWindow)private{ Private declarations }FDanHint:TDanHint;FHintDirection:THintDirection;procedure SelectProperHintDirection(ARect:TRect);procedure CheckUpRight(Spot:TPoint);procedure CheckUpLeft(Spot:TPoint);procedure CheckDownRight(Spot:TPoint);procedure CheckDownLeft(Spot:TPoint);function FindDanHint:TDanHint;function FindCursorControl:TControl;protected{ Protected declarations }procedure Paint;override;procedure CreateParams(var Params: TCreateParams);override;public{ Public declarations }constructor Create(AOwner:TComponent);override;destructor Destroy;override;procedure ActivateHint(Rect: TRect; const AHint: string);override;property HintDirection:THintDirection read FHintDirection write FHintDirection default hdUpRight;published{ Published declarations }end;procedure Register;implementationconstSHADOW_WIDTH=6;N_PIXELS=5;varMemBmp:TBitmap;UpRect,DownRect:TRect;SelectHintDirection:THintDirection;ShowPos:TPoint;procedure Register;beginRegisterComponents('ActiveX', [TDanHint]);end;procedure TDanHint.SetNewHintFont;varI:Integer;beginfor I:=0 to Application.ComponentCount-1 doif Application.Components[I] is TNewHint thenbeginTNewHint(Application.Components[I]).Canvas.Font.Assign(FHintFont);Exit;end;end;constructor TDanHint.Create(AOwner:TComponent);begininherited Create(AOwner);FHintDirection:=hdUpRight;FHintColor:=clYellow;{ $0080FFFF is Delphi's original setting }FHintShadowColor:=clPurple;FHintPauseTime:=600;Application.HintPause:=FHintPauseTime;FHintFont:=TFont.Create;FHintFont.Name:='MS Sans Serif';FHintFont.Size:=12;FHintFont.Color:=clBlue;FHintFont.Pitch:=fpDefault;FHintFont.Style:=FHintFont.Style+[fsBold,fsItalic];if not (csDesigning in ComponentState) thenbeginHintWindowClass:=TNewHint;Application.ShowHint:=not Application.ShowHint;Application.ShowHint:=not Application.ShowHint;{ in TApplication's SetShowHint, the privateFHintWindow is allocated according toHintWindowClass, so here do so actions tocall SetShowHint and keep ShowHint propertythe same value }SetNewHintFont;end;end;destructor TDanHint.Destroy;beginFHintFont.Free;inherited Destroy;end;procedure TDanHint.Loaded;beginif not (csDesigning in ComponentState) thenbegininherited Loaded;HintWindowClass:=TNewHint;Application.ShowHint:=not Application.ShowHint;Application.ShowHint:=not Application.ShowHint;{ to activate to allocate a new Hint Window }SetNewHintFont;end;end;procedure TDanHint.SetHintDirection(Value:THintDirection);beginFHintDirection:=Value;end;procedure TDanHint.SetHintColor(Value:TColor);beginFHintColor:=Value;end;procedure TDanHint.SetHintShadowColor(Value:TColor);beginFHintShadowColor:=Value;end;procedure TDanHint.SetHintFont(Value:TFont);beginFHintFont.Assign(Value);Application.ShowHint:=not Application.ShowHint;Application.ShowHint:=not Application.ShowHint;{ to activate to allocate a new Hint Window }SetNewHintFont;end;procedure TDanHint.CMFontChanged(var Message:TMessage);begininherited;Application.ShowHint:=not Application.ShowHint;Application.ShowHint:=not Application.ShowHint;{ to activate to allocate a new Hint Window }SetNewHintFont;end;procedure TDanHint.SetHintPauseTime(Value:Integer);begin
if (Value<>FHintPauseTime) thenbeginFHintPauseTime:=Value;Application.HintPause:=Value;end;end;function TNewHint.FindDanHint:TDanHint;varI:Integer;beginResult:=nil;for I:=0 to Application.MainForm.ComponentCount-1 doif Application.MainForm.Components[I] is TDanHint thenbeginResult:=TDanHint(Application.MainForm.Components[I]);Exit;end;end;constructor TNewHint.Create(AOwner:TComponent);begininherited Create(AOwner);{if (Application<>nil) and (Application.MainForm<>nil) thenFDanHint:=FindDanHint;}ControlStyle:=ControlStyle-[csOpaque];with Canvas dobegin{ Font.Name:='MS Sans Serif';Font.Size:=10;}{if (FDanHint<>nil) then Font.Assign(FDanHint.HintFont);}Brush.Style:=bsClear;Brush.Color:=clBackground;Application.HintColor:=clBackground;end;FHintDirection:=hdUpRight;end;destructor TNewHint.Destroy;begininherited Destroy;end;procedure TNewHint.CreateParams(var Params: TCreateParams);begininherited CreateParams(Params);with Params dobegin{Style := WS_POPUP or WS_BORDER or WS_DISABLED;}Style := Style-WS_BORDER;{ExStyle:=ExStyle or WS_EX_TRANSPARENT;}{Add the above makes the beneath window overlap hint}WindowClass.Style := WindowClass.Style or CS_SAVEBITS;end;end;procedure TNewHint.Paint;varR: TRect;CCaption: array[0..255] of Char;FillRegion,ShadowRgn:HRgn;AP:array[0..2] of TPoint; { Points of the Arrow }SP:array[0..2] of TPoint; { Points of the Shadow }X,Y:Integer;AddNum:Integer; { Added num for hdDownXXX }beginR := ClientRect;{ R is for Text output }Inc(R.Left,5+3);Inc(R.Top,3);AddNum:=0;if FHintDirection>=hdDownRight then AddNum:=15;Inc(R.Top,AddNum);case HintDirection ofhdUpRight:beginAP[0]:=Point(10,Height-15);AP[1]:=Point(20,Height-15);AP[2]:=Point(0,Height);SP[0]:=Point(12,Height-15);SP[1]:=Point(25,Height-15);SP[2]:=Point(12,Height);end;hdUpLeft:beginAP[0]:=Point(Width-SHADOW_WIDTH-20,Height-15);AP[1]:=Point(Width-SHADOW_WIDTH-10,Height-15);AP[2]:=Point(Width-SHADOW_WIDTH,Height);SP[0]:=Point(Width-SHADOW_WIDTH-27,Height-15);SP[1]:=Point(Width-SHADOW_WIDTH-5,Height-15);SP[2]:=Point(Width-SHADOW_WIDTH,Height);end;hdDownRight:beginAP[0]:=Point(10,15);AP[1]:=Point(20,15);AP[2]:=Point(0,0);{ for hdDownXXX, SP not used now }SP[0]:=Point(12,Height-15);SP[1]:=Point(25,Height-15);SP[2]:=Point(12,Height);end;hdDownLeft:beginAP[0]:=Point(Width-SHADOW_WIDTH-20,15);AP[1]:=Point(Width-SHADOW_WIDTH-10,15);AP[2]:=Point(Width-SHADOW_WIDTH,0);{ for hdDownXXX, SP not used now }SP[0]:=Point(12,Height-15);SP[1]:=Point(25,Height-15);SP[2]:=Point(12,Height);end;end;{ Draw Shadow of the Hint Rect}if (FHintDirection<=hdUpLeft) thenbeginShadowRgn:=CreateRoundRectRgn(0+10,0+8,Width,Height-9,8,8);{ 8 is for RoundRect's corner }for X:=Width-SHADOW_WIDTH-8 to Width dofor Y:=8 to Height-14 dobeginif (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) thenMemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;end;for X:=10 to Width dofor Y:=Height-14 to Height-9 dobeginif (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) thenMemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;end;endelse { for hdDownXXX }beginShadowRgn:=CreateRoundRectRgn(0+10,0+8+15,Width,Height-2,8,8);for X:=Width-SHADOW_WIDTH-8 to Width dofor Y:=23 to Height-8 dobeginif (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) thenMemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;end;for X:=10 to Width dofor Y:=Height-8 to Height-2 dobeginif (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) thenMemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;end;end;DeleteObject(ShadowRgn);{ Draw the shadow of the arrow }if (HintDirection<=hdUpLeft) thenbeginShadowRgn:=CreatePolygonRgn(SP,3,WINDING);for X:=SP[0].X to SP[1].X dofor Y:=SP[0].Y to SP[2].Y dobeginif (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) thenMemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;end;DeleteObject(ShadowRgn);end;{ Draw HintRect }MemBmp.Canvas.Pen.Color:=clBlack;MemBmp.Canvas.Pen.Style:=psSolid;MemBmp.Canvas.Brush.Color:=FDanHint.HintColor;MemBmp.Canvas.Brush.Style:=bsSolid;if (FHintDirection<=hdUpLeft) thenMemBmp.Canvas.RoundRect(0,0,Width-SHADOW_WIDTH,Height-14,9,9)elseMemBmp.Canvas.RoundRect(0,0+AddNum,Width-SHADOW_WIDTH,Height-14+6,9,9);{ Draw Hint Arrow }MemBmp.Canvas.Pen.Color:=FDanHint.HintColor;MemBmp.Canvas.MoveTo(AP[0].X,AP[0].Y);MemBmp.Canvas.LineTo(AP[1].X,AP[1].Y);MemBmp.Canvas.Pen.Color:=clBlack;FillRegion:=CreatePolygonRgn(AP,3,WINDING);FillRgn(MemBmp.Canvas.Handle,FillRegion,MemBmp.Canvas.Brush.Handle);DeleteObject(FillRegion);MemBmp.Canvas.LineTo(AP[2].X,AP[2].Y);MemBmp.Canvas.LineTo(AP[0].X,AP[0].Y);{ SetBkMode makes DrawText's text be transparent }SetBkMode(MemBmp.Canvas.Handle,TRANSPARENT);MemBmp.Canvas.Font.Assign(FDanHint.HintFont);DrawText(MemBmp.Canvas.Handle, StrPCopy(CCaption, Caption), -1, R,DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);Canvas.CopyMode:=cmSrcCopy;Canvas.CopyRect(ClientRect,MemBmp.Canvas,ClientRect);MemBmp.Free;end;procedure TNewHint.CheckUpLeft(Spot:TPoint);varWidth,Height:Integer;beginDec(Spot.Y,N_PIXELS);Width:=UpRect.Right-UpRect.Left;Height:=UpRect.Bottom-UpRect.Top;SelectHintDirection:=hdUpLeft;if (Spot.X+SHADOW_WIDTH-Width)<0 thenbeginInc(Spot.Y,N_PIXELS);{back tp original}CheckUpRight(Spot);Exit;end;
if (Spot.Y-Height)<0 thenbeginInc(Spot.Y,N_PIXELS);CheckDownLeft(Spot);Exit;end;ShowPos.X:=Spot.X+SHADOW_WIDTH-Width;ShowPos.Y:=Spot.Y-Height;end;procedure TNewHint.CheckUpRight(Spot:TPoint);varWidth,Height:Integer;beginDec(Spot.Y,N_PIXELS);Width:=UpRect.Right-UpRect.Left;Height:=UpRect.Bottom-UpRect.Top;SelectHintDirection:=hdUpRight;if (Spot.X+Width)>Screen.Width thenbeginInc(Spot.Y,N_PIXELS);CheckUpLeft(Spot);Exit;end;if (Spot.Y-Height)<0 thenbeginInc(Spot.Y,N_PIXELS);CheckDownRight(Spot);Exit;end;ShowPos.X:=Spot.X;ShowPos.Y:=Spot.Y-Height;end;procedure TNewHint.CheckDownRight(Spot:TPoint);varWidth,Height:Integer;beginInc(Spot.Y,N_PIXELS*3);Width:=DownRect.Right-DownRect.Left;Height:=DownRect.Bottom-DownRect.Top;SelectHintDirection:=hdDownRight;if (Spot.X+Width)>Screen.Width thenbeginDec(Spot.Y,N_PIXELS*3);CheckDownLeft(Spot);Exit;end;if (Spot.Y+Height)>Screen.Height thenbeginDec(Spot.Y,N_PIXELS*3);CheckUpRight(Spot);Exit;end;ShowPos.X:=Spot.X;ShowPos.Y:=Spot.Y;end;procedure TNewHint.CheckDownLeft(Spot:TPoint);varWidth,Height:Integer;beginInc(Spot.Y,N_PIXELS*3);Width:=DownRect.Right-DownRect.Left;Height:=DownRect.Bottom-DownRect.Top;SelectHintDirection:=hdDownLeft;if (Spot.X+SHADOW_WIDTH-Width)<0 thenbeginDec(Spot.Y,N_PIXELS*3);CheckDownRight(Spot);Exit;end;if (Spot.Y+Height)>Screen.Height thenbeginDec(Spot.Y,N_PIXELS*3);CheckUpLeft(Spot);Exit;end;ShowPos.X:=Spot.X+SHADOW_WIDTH-Width;ShowPos.Y:=Spot.Y;end;function TNewHint.FindCursorControl:TControl;begin{ControlAtPos}end;procedure TNewHint.SelectProperHintDirection(ARect:TRect);varSpot:TPoint;OldHintDirection,SendHintDirection:THintDirection;HintControl:TControl;beginGetCursorPos(Spot);HintCOntrol:=FindDragTarget(Spot,True);Inc(ARect.Right,10+SHADOW_WIDTH);Inc(ARect.Bottom,20);UpRect:=ARect;Inc(ARect.Bottom,9);DownRect:=ARect;OldHintDirection:=FDanHint.HintDirection;SendHintDirection:=FDanHint.HintDirection;{ Tricky, why here can't use FDanHint.OnSe...? }if Assigned(FDanHint.FOnSelectHintDirection) thenbeginFDanHint.FOnSelectHintDirection(HintControl,SendHintDirection);FDanHint.HintDirection:=SendHintDirection;end;case FDanHint.HintDirection ofhdUpRight:CheckUpRight(Spot);hdUpLeft:CheckUpLeft(Spot);hdDownRight:CheckDownRight(Spot);hdDownLeft:CheckDownLeft(Spot);end;FDanHint.HintDirection:=OldHintDirection;end;procedure TNewHint.ActivateHint(Rect: TRect; const AHint: string);varScreenDC:HDC;LeftTop:TPoint;tmpWidth,tmpHeight:Integer;beginMemBmp:=TBitmap.Create;Caption := AHint;{ add by Dan from Here }FDanHint:=FindDanHint;SelectProperHintDirection(Rect);HintDirection:=SelectHintDirection;{ if the following changes, make sure to modifySelectProperHintDirection also }Inc(Rect.Right,10+SHADOW_WIDTH);Inc(Rect.Bottom,20);if (FHintDirection>=hdDownRight) then Inc(Rect.Bottom,9);{ to expand the rect }tmpWidth:=Rect.Right-Rect.Left;tmpHeight:=Rect.Bottom-Rect.Top;Rect.Left:=ShowPos.X;Rect.Top:=ShowPos.Y;Rect.Right:=Rect.Left+tmpWidth;Rect.Bottom:=Rect.Top+tmpHeight;BoundsRect := Rect;MemBmp.Width:=Width;MemBmp.Height:=Height;ScreenDC:=CreateDC('DISPLAY',nil,nil,nil);LeftTop.X:=0;LeftTop.Y:=0;LeftTop:=ClientToScreen(LeftTop);{ use MemBmp to store the original bitmapon screen }BitBlt(MemBmp.Canvas.Handle,0,0,Width,Height,ScreenDC,LeftTop.X,LeftTop.Y,SRCCOPY);{ SetBkMode(Canvas.Handle,TRANSPARENT);}SetWindowPos(Handle, HWND_TOPMOST, ShowPos.X, ShowPos.Y, 0,0, SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE);BitBlt(Canvas.Handle,0,0,Width,Height,MemBmp.Canvas.Handle,0,0,SRCCOPY);DeleteDC(ScreenDC);end;initializationend.
unit Danhint;interfaceusesSysUtils, Windows, Messages, Classes, Graphics, Controls,Forms, Dialogs;typeTHintDirection=(hdUpRight,hdUpLeft,hdDownRight,hdDownLeft);TOnSelectHintDirection=procedure(HintControl:TControl;var HintDirection:THintDirection) of object;TDanHint = class(TComponent)private{ Private declarations }FHintDirection:THintDirection;FHintColor:TColor;FHintShadowColor:TColor;FHintFont:TFont;FHintPauseTime:Integer;FOnSelectHintDirection:TOnSelectHintDirection;procedure SetHintDirection(Value:THintDirection);procedure SetHintColor(Value:TColor);procedure SetHintShadowColor(Value:TColor);procedure SetHintFont(Value:TFont);procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED;procedure SetHintPauseTime(Value:Integer);protected{ Protected declarations }public{ Public declarations }constructor Create(AOwner:TComponent);override;destructor Destroy;override;procedure Loaded;override;procedure SetNewHintFont;published{ Published declarations }property HintDirection:THintDirection read FHintDirection write SetHintDirection default hdUpRight;property HintColor:TColor read FHintColor write SetHintColor default clYellow;property HintShadowColor:TColor read FHintShadowColor write SetHintShadowColor default clPurple;property HintFont:TFont read FHintFont write SetHintFont;property HintPauseTime:Integer read FHintPauseTime write SetHintPauseTime default 600;property OnSelectHintDirection:TOnSelectHintDirection read FOnSelectHintDirection write FOnSelectHintDirection;end;TNewHint = class(THintWindow)private{ Private declarations }FDanHint:TDanHint;FHintDirection:THintDirection;procedure SelectProperHintDirection(ARect:TRect);procedure CheckUpRight(Spot:TPoint);procedure CheckUpLeft(Spot:TPoint);procedure CheckDownRight(Spot:TPoint);procedure CheckDownLeft(Spot:TPoint);function FindDanHint:TDanHint;function FindCursorControl:TControl;protected{ Protected declarations }procedure Paint;override;procedure CreateParams(var Params: TCreateParams);override;public{ Public declarations }constructor Create(AOwner:TComponent);override;destructor Destroy;override;procedure ActivateHint(Rect: TRect; const AHint: string);override;property HintDirection:THintDirection read FHintDirection write FHintDirection default hdUpRight;published{ Published declarations }end;procedure Register;implementationconstSHADOW_WIDTH=6;N_PIXELS=5;varMemBmp:TBitmap;UpRect,DownRect:TRect;SelectHintDirection:THintDirection;ShowPos:TPoint;procedure Register;beginRegisterComponents('ActiveX', [TDanHint]);end;procedure TDanHint.SetNewHintFont;varI:Integer;beginfor I:=0 to Application.ComponentCount-1 doif Application.Components[I] is TNewHint thenbeginTNewHint(Application.Components[I]).Canvas.Font.Assign(FHintFont);Exit;end;end;constructor TDanHint.Create(AOwner:TComponent);begininherited Create(AOwner);FHintDirection:=hdUpRight;FHintColor:=clYellow;{ $0080FFFF is Delphi's original setting }FHintShadowColor:=clPurple;FHintPauseTime:=600;Application.HintPause:=FHintPauseTime;FHintFont:=TFont.Create;FHintFont.Name:='MS Sans Serif';FHintFont.Size:=12;FHintFont.Color:=clBlue;FHintFont.Pitch:=fpDefault;FHintFont.Style:=FHintFont.Style+[fsBold,fsItalic];if not (csDesigning in ComponentState) thenbeginHintWindowClass:=TNewHint;Application.ShowHint:=not Application.ShowHint;Application.ShowHint:=not Application.ShowHint;{ in TApplication's SetShowHint, the privateFHintWindow is allocated according toHintWindowClass, so here do so actions tocall SetShowHint and keep ShowHint propertythe same value }SetNewHintFont;end;end;destructor TDanHint.Destroy;beginFHintFont.Free;inherited Destroy;end;procedure TDanHint.Loaded;beginif not (csDesigning in ComponentState) thenbegininherited Loaded;HintWindowClass:=TNewHint;Application.ShowHint:=not Application.ShowHint;Application.ShowHint:=not Application.ShowHint;{ to activate to allocate a new Hint Window }SetNewHintFont;end;end;procedure TDanHint.SetHintDirection(Value:THintDirection);beginFHintDirection:=Value;end;procedure TDanHint.SetHintColor(Value:TColor);beginFHintColor:=Value;end;procedure TDanHint.SetHintShadowColor(Value:TColor);beginFHintShadowColor:=Value;end;procedure TDanHint.SetHintFont(Value:TFont);beginFHintFont.Assign(Value);Application.ShowHint:=not Application.ShowHint;Application.ShowHint:=not Application.ShowHint;{ to activate to allocate a new Hint Window }SetNewHintFont;end;procedure TDanHint.CMFontChanged(var Message:TMessage);begininherited;Application.ShowHint:=not Application.ShowHint;Application.ShowHint:=not Application.ShowHint;{ to activate to allocate a new Hint Window }SetNewHintFont;end;procedure TDanHint.SetHintPauseTime(Value:Integer);begin
if (Spot.Y-Height)<0 thenbeginInc(Spot.Y,N_PIXELS);CheckDownLeft(Spot);Exit;end;ShowPos.X:=Spot.X+SHADOW_WIDTH-Width;ShowPos.Y:=Spot.Y-Height;end;procedure TNewHint.CheckUpRight(Spot:TPoint);varWidth,Height:Integer;beginDec(Spot.Y,N_PIXELS);Width:=UpRect.Right-UpRect.Left;Height:=UpRect.Bottom-UpRect.Top;SelectHintDirection:=hdUpRight;if (Spot.X+Width)>Screen.Width thenbeginInc(Spot.Y,N_PIXELS);CheckUpLeft(Spot);Exit;end;if (Spot.Y-Height)<0 thenbeginInc(Spot.Y,N_PIXELS);CheckDownRight(Spot);Exit;end;ShowPos.X:=Spot.X;ShowPos.Y:=Spot.Y-Height;end;procedure TNewHint.CheckDownRight(Spot:TPoint);varWidth,Height:Integer;beginInc(Spot.Y,N_PIXELS*3);Width:=DownRect.Right-DownRect.Left;Height:=DownRect.Bottom-DownRect.Top;SelectHintDirection:=hdDownRight;if (Spot.X+Width)>Screen.Width thenbeginDec(Spot.Y,N_PIXELS*3);CheckDownLeft(Spot);Exit;end;if (Spot.Y+Height)>Screen.Height thenbeginDec(Spot.Y,N_PIXELS*3);CheckUpRight(Spot);Exit;end;ShowPos.X:=Spot.X;ShowPos.Y:=Spot.Y;end;procedure TNewHint.CheckDownLeft(Spot:TPoint);varWidth,Height:Integer;beginInc(Spot.Y,N_PIXELS*3);Width:=DownRect.Right-DownRect.Left;Height:=DownRect.Bottom-DownRect.Top;SelectHintDirection:=hdDownLeft;if (Spot.X+SHADOW_WIDTH-Width)<0 thenbeginDec(Spot.Y,N_PIXELS*3);CheckDownRight(Spot);Exit;end;if (Spot.Y+Height)>Screen.Height thenbeginDec(Spot.Y,N_PIXELS*3);CheckUpLeft(Spot);Exit;end;ShowPos.X:=Spot.X+SHADOW_WIDTH-Width;ShowPos.Y:=Spot.Y;end;function TNewHint.FindCursorControl:TControl;begin{ControlAtPos}end;procedure TNewHint.SelectProperHintDirection(ARect:TRect);varSpot:TPoint;OldHintDirection,SendHintDirection:THintDirection;HintControl:TControl;beginGetCursorPos(Spot);HintCOntrol:=FindDragTarget(Spot,True);Inc(ARect.Right,10+SHADOW_WIDTH);Inc(ARect.Bottom,20);UpRect:=ARect;Inc(ARect.Bottom,9);DownRect:=ARect;OldHintDirection:=FDanHint.HintDirection;SendHintDirection:=FDanHint.HintDirection;{ Tricky, why here can't use FDanHint.OnSe...? }if Assigned(FDanHint.FOnSelectHintDirection) thenbeginFDanHint.FOnSelectHintDirection(HintControl,SendHintDirection);FDanHint.HintDirection:=SendHintDirection;end;case FDanHint.HintDirection ofhdUpRight:CheckUpRight(Spot);hdUpLeft:CheckUpLeft(Spot);hdDownRight:CheckDownRight(Spot);hdDownLeft:CheckDownLeft(Spot);end;FDanHint.HintDirection:=OldHintDirection;end;procedure TNewHint.ActivateHint(Rect: TRect; const AHint: string);varScreenDC:HDC;LeftTop:TPoint;tmpWidth,tmpHeight:Integer;beginMemBmp:=TBitmap.Create;Caption := AHint;{ add by Dan from Here }FDanHint:=FindDanHint;SelectProperHintDirection(Rect);HintDirection:=SelectHintDirection;{ if the following changes, make sure to modifySelectProperHintDirection also }Inc(Rect.Right,10+SHADOW_WIDTH);Inc(Rect.Bottom,20);if (FHintDirection>=hdDownRight) then Inc(Rect.Bottom,9);{ to expand the rect }tmpWidth:=Rect.Right-Rect.Left;tmpHeight:=Rect.Bottom-Rect.Top;Rect.Left:=ShowPos.X;Rect.Top:=ShowPos.Y;Rect.Right:=Rect.Left+tmpWidth;Rect.Bottom:=Rect.Top+tmpHeight;BoundsRect := Rect;MemBmp.Width:=Width;MemBmp.Height:=Height;ScreenDC:=CreateDC('DISPLAY',nil,nil,nil);LeftTop.X:=0;LeftTop.Y:=0;LeftTop:=ClientToScreen(LeftTop);{ use MemBmp to store the original bitmapon screen }BitBlt(MemBmp.Canvas.Handle,0,0,Width,Height,ScreenDC,LeftTop.X,LeftTop.Y,SRCCOPY);{ SetBkMode(Canvas.Handle,TRANSPARENT);}SetWindowPos(Handle, HWND_TOPMOST, ShowPos.X, ShowPos.Y, 0,0, SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE);BitBlt(Canvas.Handle,0,0,Width,Height,MemBmp.Canvas.Handle,0,0,SRCCOPY);DeleteDC(ScreenDC);end;initializationend.