(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTHint;

interface

uses
  SysUtils, Windows, Messages, Classes,AHMTBackground,
  Graphics, Controls, Forms, ExtCtrls,AHMEnhancedClass, Buttons,
  StdCtrls,AHMEnhancedConst;

type
  TAHMHintDuplicateError = class(Exception);
  TAHMDirectionB = (dUpRight,dUpLeft,dDownRight,dDownLeft);
  TOnSelectHintDirection=procedure(HintControl:TControl;var HintDirection:TAHMDirectionB) of object;
  TAHMHint = class(TComponent)
  private
    FAHMAboutStr : TAHMAboutEnhancedStr;
    fshadow:boolean;
    fspeech: Boolean;
    f3d : TAHMFont3D;
    FHintDirection:TAHMDirectionB;
    FHintColor:TColor;
    FHintshadowColor:TColor;
    FHintFont:TFont;
    FHintPauseTime:Integer;
    fback : TAHMBackground;
    FOnSelectHintDirection:TOnSelectHintDirection;
    procedure SetHintDirection(Value:TAHMDirectionB);
    procedure SetBack(value : TAHMBackground);
    procedure SetHintColor(Value:TColor);
    procedure SetHintshadowColor(Value:TColor);
    procedure SetHintFont(Value:TFont);
    procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED;
    procedure SetHintPauseTime(Value:Integer);
    procedure Set3D(value : TAHMFont3D);
  protected
    procedure Notification(AComponent: TComponent;Operation: TOperation); override;
  public
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    procedure Loaded;override;
    procedure SetNewHintFont;
  published
    property About : TAHMAboutEnhancedStr read FAHMAboutStr write FAHMAboutStr stored False;
    property Font3D : TAHMFont3D read f3d write Set3D stored true;
    property Speechbubble : Boolean read fspeech write fspeech default False;
    property Shadow : Boolean read fshadow write fshadow default True;
    property HintDirection:TAHMDirectionB read FHintDirection write SetHintDirection default dUpRight;
    property UnUsedHintColor:TColor read FHintColor write SetHintColor default clLime;
    property HintShadowColor:TColor read FHintshadowColor write SetHintshadowColor default clBlack;
    property HintFont:TFont read FHintFont write SetHintFont;
    property HintPauseTime:Integer read FHintPauseTime write SetHintPauseTime default 600;
    property OnSelectHintDirection:TOnSelectHintDirection read FOnSelectHintDirection write FOnSelectHintDirection;
    property Background : TAHMBackground read fback write Setback;
  end;

  TAHMNewHint = class(THintWindow)
  private
    fahmhint:TAHMHint;
    FHintDirection:TAHMDirectionB;
    procedure SelectProperHintDirection(ARect:TRect);
    procedure CheckUpRight(Spot:TPoint);
    procedure CheckUpLeft(Spot:TPoint);
    procedure CheckDownRight(Spot:TPoint);
    procedure CheckDownLeft(Spot:TPoint);
    function FindHintAHM:TAHMHint;
  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;
    property HintDirection:TAHMDirectionB read FHintDirection write FHintDirection default dUpRight;
    published
  end;



implementation

const AHMHintCounter: Integer = 0;

procedure TAHMHint.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and  (AComponent = Background) then SetBack(nil);
end;

const
   SHADOW_WIDTH=6;
   N_PIXELS=5;
var
   MemBmp:TBitmap;
   UpRect,DownRect:TRect;
   SelectHintDirection:TAHMDirectionB;
   ShowPos:TPoint;

procedure TAHMHint.SetNewHintFont;
var
   I:Integer;
begin
  If not(csDesigning in Componentstate) then
  begin
    for I:=0 to Application.ComponentCount-1 do
    if Application.Components[I] is TAHMNewHint then
    begin
      TAHMNewHint(Application.Components[I]).Canvas.Font.Assign(FHintFont);
      Exit;
    end;
  end;
end;


constructor TAHMHint.Create(AOwner:TComponent);
begin
  if ((csdesigning in AOwner.Componentstate) or (Application.Mainform=nil)) then
    inherited Create(AOwner)
  else
    inherited Create(Application.Mainform as TForm);
  f3d:=TAHMFont3D.create(Self);
  FHintFont:=TFont.Create;
  FHintDirection:=dUpRight;
  FHintColor:=clLime;
  FHintshadowColor:=clblack;
  FHintPauseTime:=600;
  fspeech:=false;
  fshadow:=true;
  If not(csDesigning in AOwner.Componentstate) then
  begin
    HintWindowClass:=TAHMNewHint;
    Application.HintPause:=FHintPauseTime;
    Application.ShowHint:=not Application.ShowHint;
    Application.ShowHint:=not Application.ShowHint;
  end;
  SetNewHintFont;
  if not(csDesigning in Componentstate) then Inc(AHMHintCounter);
  if (AHMHintCounter > 1) then
    raise TAHMHintDuplicateError.Create(ahmschintdup1+self.classname+ahmschintdup2);
end;

destructor TAHMHint.Destroy;
begin
   Dec(AHMHintCounter);
   FHintFont.Free;
   f3d.Free;
   inherited Destroy;
end;

procedure TAHMHint.Loaded;
begin
  inherited Loaded;
  If not(csDesigning in Componentstate) then
  begin
    HintWindowClass:=TAHMNewHint;
    Application.ShowHint:=not Application.ShowHint;
    Application.ShowHint:=not Application.ShowHint;
    SetNewHintFont;
  end;
end;

procedure TAHMHint.SetHintDirection(Value:TAHMDirectionB);
begin
   FHintDirection:=Value;
end;

procedure TAHMHint.SetHintColor(Value:TColor);
begin
   FHintColor:=Value;
end;

procedure TAHMHint.Set3D(value : TAHMFont3D);
begin
  f3d:=value;
end;


procedure TAHMHint.Setback(value : TAHMBackground);
begin
  fback:=(value);
end;

procedure TAHMHint.SetHintshadowColor(Value:TColor);
begin
  FHintshadowColor:=Value;
end;

procedure TAHMHint.SetHintFont(Value:TFont);
begin
  FHintFont.Assign(Value);
  If not(csDesigning in Componentstate) then
  begin
    Application.ShowHint:=not Application.ShowHint;
    Application.ShowHint:=not Application.ShowHint;
  end;
  SetNewHintFont;
end;

procedure TAHMHint.CMFontChanged(var Message:TMessage);
begin
   inherited;
   If not(csDesigning in Componentstate) then
   begin
     Application.ShowHint:=not Application.ShowHint;
     Application.ShowHint:=not Application.ShowHint;
   end;
   SetNewHintFont;
end;

procedure TAHMHint.SetHintPauseTime(Value:Integer);
begin
  If not(csDesigning in Componentstate) then
  begin
    if (Value<>FHintPauseTime) then
    begin
      FHintPauseTime:=Value;
      Application.HintPause:=Value;
    end;
  end;
end;

function TAHMNewHint.FindHintAHM:TAHMHint;
var
   I:Integer;
begin
   Result:=nil;
   If not(csDesigning in Componentstate) then
   for I:=0 to Application.MainForm.ComponentCount-1 do
   if Application.MainForm.Components[I] is TAHMHint then
   begin
     Result:=TAHMHint(Application.MainForm.Components[I]);
     Exit;
   end;
end;

constructor TAHMNewHint.Create(AOwner:TComponent);
begin
   inherited Create(AOwner);
   ControlStyle:=ControlStyle-[csOpaque];
   If not(csDesigning in Componentstate) then
   with Canvas do
   begin
      Brush.Style:=bsClear;
      Brush.Color:=clBackground;
      Application.HintColor:=clBackground;
   end;
   FHintDirection:=dUpRight;
end;

destructor TAHMNewHint.Destroy;
begin
   inherited Destroy;
end;

procedure TAHMNewHint.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;

procedure TAHMNewHint.Paint;
var
  R,B,F: TRect;
  FillRegion,ShadowRgn:HRgn;
  AP:array[0..2] of TPoint;
  SP:array[0..2] of TPoint;
  X,Y:Integer;
  AddNum:Integer;
  cbit : TBitmap;
procedure drawit(x1,y1,x2,y2,x3,y3 : Longint);
begin
  if fahmhint.Speechbubble then
    MemBmp.Canvas.RoundRect(x1,y1,x2,y2,x3,y3)
  else
    MemBmp.Canvas.Rectangle(x1,y1,x2,y2);
end;
begin
  If (csDesigning in Componentstate) then inherited paint else
  begin
     R := ClientRect;
     cbit:=TBitmap.create;
     cbit.width:=width;
     cbit.height:=height;
     if assigned(fahmhint.fback) then
     fahmhint.fback.draw(cbit.canvas.Handle,width,height,true);
     Inc(R.Left,5+3);
     Inc(R.Top,3);
     AddNum:=0;
     if FHintDirection>=dDownRight then AddNum:=15;
     Inc(R.Top,AddNum);
     F:=R;
     B:=R;
     F.TOP:=R.TOP-fahmhint.font3D.offset;
     F.LEFT:=R.LEFT-fahmhint.font3D.offset;
     F.RIGHT:=R.RIGHT;
     F.BOTTOM:=R.BOTTOM;
     B.TOP:=R.TOP+fahmhint.font3D.offset;
     B.LEFT:=R.LEFT+fahmhint.font3D.offset;
     B.RIGHT:=R.RIGHT;
     B.BOTTOM:=R.BOTTOM;
     case HintDirection of
       dUpRight:
       begin
         AP[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;
       dUpLeft:
       begin
         AP[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;
       dDownRight:
       begin
         AP[0]:=Point(10,15);
         AP[1]:=Point(20,15);
         AP[2]:=Point(0,0);
         SP[0]:=Point(12,Height-15);
         SP[1]:=Point(25,Height-15);
         SP[2]:=Point(12,Height);
       end;
       dDownLeft:
       begin
         AP[0]:=Point(Width-SHADOW_WIDTH-20,15);
         AP[1]:=Point(Width-SHADOW_WIDTH-10,15);
         AP[2]:=Point(Width-SHADOW_WIDTH,0);
         SP[0]:=Point(12,Height-15);
         SP[1]:=Point(25,Height-15);
         SP[2]:=Point(12,Height);
       end;
     end;
     if fahmhint.Shadow then
     begin
       if (FHintDirection<=dUpLeft) then
       begin
         if fahmhint.Speechbubble then
           ShadowRgn:=CreateRoundRectRgn(0+10,0+8,Width,Height-9,8,8)
         else
           ShadowRgn:=CreateRectRgn(0+10,0+8,Width,Height-9);
         for X:=Width-SHADOW_WIDTH-8 to Width do
         for Y:=8 to Height-14 do
         begin
           if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
              MemBmp.Canvas.Pixels[X,Y]:=fahmhint.HintshadowColor;
         end;
         for X:=10 to Width do
         for Y:=Height-14 to Height-9 do
         begin
           if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
              MemBmp.Canvas.Pixels[X,Y]:=fahmhint.HintshadowColor;
         end;
       end
       else
       begin
         if fahmhint.Speechbubble then
           ShadowRgn:=CreateRoundRectRgn(0+10,0+8+15,Width,Height-2,8,8)
         else
           ShadowRgn:=CreateRectRgn(0+10,0+8+15,Width,Height-2);
         for X:=Width-SHADOW_WIDTH-8 to Width do
         for Y:=23 to Height-8 do
         begin
           if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
              MemBmp.Canvas.Pixels[X,Y]:=fahmhint.HintshadowColor;
         end;
         for X:=10 to Width do
         for Y:=Height-8 to Height-2 do
         begin
           if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
              MemBmp.Canvas.Pixels[X,Y]:=fahmhint.HintshadowColor;
         end;
       end;
       DeleteObject(ShadowRgn);
       if (HintDirection<=dUpLeft) then
       begin
         ShadowRgn:=CreatePolygonRgn(SP,3,WINDING);
         if fahmhint.Speechbubble then
         for X:=SP[0].X to SP[1].X do
         for Y:=SP[0].Y to SP[2].Y do
         begin
           if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
              MemBmp.Canvas.Pixels[X,Y]:=fahmhint.HintshadowColor;
         end;
         DeleteObject(ShadowRgn);
       end;
     end;
     MemBmp.Canvas.Pen.Color:=clBlack;
     MemBmp.Canvas.Pen.Style:=psSolid;
     MemBmp.Canvas.Brush.Color:=fahmhint.UnUsedHintColor;
     MemBmp.Canvas.Brush.Style:=bsSolid;
     if (FHintDirection<=dUpLeft) then
     begin
       MemBmp.Canvas.Pen.Color:=clblack;
       Drawit(1,0,Width-SHADOW_WIDTH,Height-14,9,9);
       MemBmp.Canvas.Pen.Color:=clwhite;
       Drawit(0,0,Width-SHADOW_WIDTH-1,Height-15,9,9);
       MemBmp.Canvas.Pen.Color:=fahmhint.UnUsedHintColor;
       Drawit(1,1,Width-SHADOW_WIDTH-1,Height-15,9,9);
     end
     else
     begin
       MemBmp.Canvas.Pen.Color:=clblack;
       Drawit(1,0+AddNum,Width-SHADOW_WIDTH,Height-14+6,9,9);
       MemBmp.Canvas.Pen.Color:=clwhite;
       Drawit(0,0+AddNum,Width-SHADOW_WIDTH-1,Height-15+6,9,9);
       MemBmp.Canvas.Pen.Color:=fahmhint.UnUsedHintColor;
       Drawit(1,1+AddNum,Width-SHADOW_WIDTH-1,Height-15+6,9,9);
     end;
     MemBmp.Canvas.Pen.Color:=fahmhint.UnUsedHintColor;
     if fahmhint.Speechbubble then
     begin
       MemBmp.Canvas.MoveTo(AP[0].X,AP[0].Y);
       MemBmp.Canvas.LineTo(AP[1].X,AP[1].Y);
       MemBmp.Canvas.Pen.Color:=clwhite;
       FillRegion:=CreatePolygonRgn(AP,3,WINDING);
       FillRgn(MemBmp.Canvas.Handle,FillRegion,MemBmp.Canvas.Brush.Handle);
       DeleteObject(FillRegion);
       MemBmp.Canvas.Pen.Color:=clbLACK;
       MemBmp.Canvas.LineTo(AP[2].X,AP[2].Y);
       MemBmp.Canvas.Pen.Color:=clwhite;
       MemBmp.Canvas.LineTo(AP[0].X,AP[0].Y);
     end;
     SetBkMode(MemBmp.Canvas.Handle,TRANSPARENT);
     AHMDrawTransparentBitmap(cbit.canvas,Membmp,0,0,fahmhint.UnUsedHintcolor);
     cbit.Canvas.Font.ASSIGN(fahmhint.HintFont);
     with fahmhint do
     begin
       Font3D.Write(cbit.Canvas.Font,cbit.Canvas.handle,F,Caption,
                    DT_LEFT or DT_NOPREFIX or DT_WORDBREAK,enabled);
     end;
     Canvas.CopyMode:=cmSrcCopy;
     Canvas.CopyRect(ClientRect,cbit.Canvas,ClientRect);
     cbit.free;
     MemBmp.Free;
  end;
end;

procedure TAHMNewHint.CheckUpLeft(Spot:TPoint);
var
   Width,Height:Integer;
begin
  Dec(Spot.Y,N_PIXELS);
  Width:=UpRect.Right-UpRect.Left;
  Height:=UpRect.Bottom-UpRect.Top;
  SelectHintDirection:=dUpLeft;
  if (Spot.X+SHADOW_WIDTH-Width)<0 then
  begin
    Inc(Spot.Y,N_PIXELS);
    CheckUpRight(Spot);
    Exit;
  end;
  if (Spot.Y-Height)<0 then
  begin
    Inc(Spot.Y,N_PIXELS);
    CheckDownLeft(Spot);
    Exit;
  end;
  ShowPos.X:=Spot.X+SHADOW_WIDTH-Width;
  ShowPos.Y:=Spot.Y-Height;
end;

procedure TAHMNewHint.CheckUpRight(Spot:TPoint);
var
  Width,Height:Integer;
begin
  Dec(Spot.Y,N_PIXELS);
  Width:=UpRect.Right-UpRect.Left;
  Height:=UpRect.Bottom-UpRect.Top;
  SelectHintDirection:=dUpRight;
  if (Spot.X+Width)>Screen.Width then
  begin
    Inc(Spot.Y,N_PIXELS);
    CheckUpLeft(Spot);
    Exit;
  end;
  if (Spot.Y-Height)<0 then
  begin
    Inc(Spot.Y,N_PIXELS);
    CheckDownRight(Spot);
    Exit;
  end;
  ShowPos.X:=Spot.X;
  ShowPos.Y:=Spot.Y-Height;
end;

procedure TAHMNewHint.CheckDownRight(Spot:TPoint);
var
  Width,Height:Integer;
begin
  Inc(Spot.Y,N_PIXELS*3);
  Width:=DownRect.Right-DownRect.Left;
  Height:=DownRect.Bottom-DownRect.Top;
  SelectHintDirection:=dDownRight;
  if (Spot.X+Width)>Screen.Width then
      begin
         Dec(Spot.Y,N_PIXELS*3);
         CheckDownLeft(Spot);
         Exit;
      end;
   if (Spot.Y+Height)>Screen.Height then
      begin
         Dec(Spot.Y,N_PIXELS*3);
         CheckUpRight(Spot);
         Exit;
      end;
   ShowPos.X:=Spot.X;
   ShowPos.Y:=Spot.Y;
end;

procedure TAHMNewHint.CheckDownLeft(Spot:TPoint);
var
   Width,Height:Integer;
begin
   Inc(Spot.Y,N_PIXELS*3);
   Width:=DownRect.Right-DownRect.Left;
   Height:=DownRect.Bottom-DownRect.Top;
   SelectHintDirection:=dDownLeft;
   if (Spot.X+SHADOW_WIDTH-Width)<0 then
      begin
         Dec(Spot.Y,N_PIXELS*3);
         CheckDownRight(Spot);
         Exit;
      end;
   if (Spot.Y+Height)>Screen.Height then
      begin
         Dec(Spot.Y,N_PIXELS*3);
         CheckUpLeft(Spot);
         Exit;
      end;
   ShowPos.X:=Spot.X+SHADOW_WIDTH-Width;
   ShowPos.Y:=Spot.Y;
end;


procedure TAHMNewHint.SelectProperHintDirection(ARect:TRect);
var
   Spot:TPoint;
   OldHintDirection,SendHintDirection:TAHMDirectionB;
   HintControl:TControl;
begin
   GetCursorPos(Spot);
   HintCOntrol:=FindDragTarget(Spot,True);
   Inc(ARect.Right,10+SHADOW_WIDTH);
   Inc(ARect.Bottom,20);
   UpRect:=ARect;
   Inc(ARect.Bottom,9);
   DownRect:=ARect;
   OldHintDirection:=fahmhint.HintDirection;
   SendHintDirection:=fahmhint.HintDirection;
   if Assigned(fahmhint.FOnSelectHintDirection) then
      begin
         fahmhint.FOnSelectHintDirection(HintControl,SendHintDirection);
         fahmhint.HintDirection:=SendHintDirection;
      end;
   case fahmhint.HintDirection of
      dUpRight:CheckUpRight(Spot);
      dUpLeft:CheckUpLeft(Spot);
      dDownRight:CheckDownRight(Spot);
      dDownLeft:CheckDownLeft(Spot);
   end;
   fahmhint.HintDirection:=OldHintDirection;
end;

procedure TAHMNewHint.ActivateHint(Rect: TRect; const AHint: string);
var
   ScreenDC:HDC;
   LeftTop:TPoint;
   tmpWidth,tmpHeight:Integer;
begin
   MemBmp:=TBitmap.Create;
   Caption := AHint;
   fahmhint:=FindHintAHM;
   SelectProperHintDirection(Rect);
   HintDirection:=SelectHintDirection;
   Inc(Rect.Right,10+SHADOW_WIDTH);
   Inc(Rect.Bottom,20);
   if (FHintDirection>=dDownRight) then Inc(Rect.Bottom,9);
   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);
   BitBlt(MemBmp.Canvas.Handle,0,0,Width,Height,ScreenDC,
          LeftTop.X,LeftTop.Y,SRCCOPY);
   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;

end.

