jvballoonhint.pas

East make Tray Icon in delphi

    with CalcOffset(ARect) do
      OffsetRect(ARect, -X, -Y);

    FCurrentPosition := NewPosition;

    { ..and set the offset }
    with CalcOffset(ARect) do
      OffsetRect(ARect, X, Y);
  end;

  case FCurrentPosition of
    bpLeftDown, bpRightDown:
      FDeltaY := FTipHeight;
    bpLeftUp, bpRightUp:
      FDeltaY := 0;
  end;
end;

function TJvBalloonWindow.CalcHeaderRect(MaxWidth: Integer): TRect;
begin
  if FShowHeader then
  begin
    Result := Rect(0, 0, MaxWidth, 0);
    Canvas.Font := Screen.HintFont;
    Canvas.Font.Style := Canvas.Font.Style + [fsBold];
    DrawText(Canvas.Handle, PChar(FHeader), -1, Result,
      DT_CALCRECT or DefaultTextFlags or DrawTextBiDiModeFlagsReadingOnly);

    { Other }
    Inc(Result.Right, 13);
    Inc(Result.Bottom, 11);

    if FShowIcon then
      with FImageSize do
      begin
        { Include image }
        Inc(Result.Right, cx + 8);
        Result.Bottom := Max(Result.Bottom, cy + 11);
      end;
  end
  else
  if FShowIcon then
    with FImageSize do
      Result := Rect(0, 0, cx + 11, cy + 11)
  else
    SetRectEmpty(Result);
end;

function TJvBalloonWindow.CalcHintRect(MaxWidth: Integer; const AHint: string;
  AData: Pointer): TRect;
var
  MsgRect, HeaderRect: TRect;
  StemSize: TJvStemSize;
begin
  Init(AData);

  FMsg := AHint;

  { Calc HintRect }
  MsgRect := CalcMsgRect(MaxWidth);

  { Calc HeaderRect }
  HeaderRect := CalcHeaderRect(MaxWidth);
  if IsRectEmpty(HeaderRect) then
  begin
    HeaderRect.Bottom := 9;
    FMessageTop := 7;
    StemSize := ssSmall;
  end
  else
  begin
    Inc(HeaderRect.Right, 12);
    FMessageTop := HeaderRect.Bottom + 1;
    StemSize := ssNormal;
  end;

  FTipHeight := CTipHeight[StemSize];
  FTipWidth := CTipWidth[StemSize];
  FTipDelta := CTipDelta[StemSize];

  { Combine }
  Result := Rect(0, 0, Max(MsgRect.Right, HeaderRect.Right),
    HeaderRect.Bottom + MsgRect.Bottom + FTipHeight + 13);

  with CalcOffset(Result) do
    OffsetRect(Result, X, Y);
  { bpAuto returns the same value as bpLeftDown; bpLeftDown is choosen
    arbitrary }
  case FCurrentPosition of
    bpAuto, bpLeftDown, bpRightDown:
      FDeltaY := FTipHeight;
    bpLeftUp, bpRightUp:
      FDeltaY := 0;
  end;
end;

function TJvBalloonWindow.CalcMsgRect(MaxWidth: Integer): TRect;
begin
  if FMsg > '' then
  begin
    Result := Rect(0, 0, MaxWidth, 0);
    Canvas.Font := Screen.HintFont;
//    Canvas.Font.Style := Canvas.Font.Style - [fsBold];
    DrawText(Canvas.Handle, PChar(FMsg), -1, Result,
    DT_CALCRECT or DefaultTextFlags or DrawTextBiDiModeFlagsReadingOnly);

    { Other }
    Inc(Result.Right, 27);
  end
  else
    SetRectEmpty(Result);
end;

function TJvBalloonWindow.CalcOffset(const ARect: TRect): TPoint;
begin
  with ARect do
    case FCurrentPosition of
      { bpAuto returns the same value as bpLeftDown; bpLeftDown is choosen
        arbitrary }
      bpAuto, bpLeftDown:
        Result := Point(Left - Right + FTipDelta, 0);
      bpRightDown:
        Result := Point(-FTipDelta, 0);
      bpLeftUp:
        Result := Point(Left - Right + FTipDelta, Top - Bottom - FSwitchHeight);
      bpRightUp:
        Result := Point(-FTipDelta, Top - Bottom - FSwitchHeight);
    end;
end;

procedure TJvBalloonWindow.CheckPosition(var ARect: TRect);
var
  NewPosition: TJvBalloonPosition;
  ScreenRect: TRect;
begin
  if FCurrentPosition = bpAuto then
    CalcAutoPosition(ARect);

  NewPosition := FCurrentPosition;
  ScreenRect := WorkAreaRect;

  if ARect.Bottom > ScreenRect.Bottom - ScreenRect.Top then
  begin
    if NewPosition = bpLeftDown then
      NewPosition := bpLeftUp
    else
    if NewPosition = bpRightDown then
      NewPosition := bpRightUp;
  end;
  if ARect.Right > ScreenRect.Right - ScreenRect.Left then
  begin
    if NewPosition = bpRightDown then
      NewPosition := bpLeftDown
    else
    if NewPosition = bpRightUp then
      NewPosition := bpLeftUp;
  end;
  if ARect.Left < ScreenRect.Left then
  begin
    if NewPosition = bpLeftDown then
      NewPosition := bpRightDown
    else
    if NewPosition = bpLeftUp then
      NewPosition := bpRightUp;
  end;
  if ARect.Top < ScreenRect.Top then
  begin
    if NewPosition = bpLeftUp then
      NewPosition := bpLeftDown
    else
    if NewPosition = bpRightUp then
      NewPosition := bpRightDown;
  end;

  if NewPosition <> FCurrentPosition then
  begin
    { Reset the offset.. }
    with CalcOffset(ARect) do
      OffsetRect(ARect, -X, -Y);
    FCurrentPosition := NewPosition;

    { ..and set the offset }
    with CalcOffset(ARect) do
      OffsetRect(ARect, X, Y);
  end;
  { final adjustment - just make sure no part is disappearing outside the top/left edge }
  if ARect.Left < ScreenRect.Left then
  begin
    with CalcOffset(ARect) do
      OffsetRect(ARect, -X, -Y);
    if FCurrentPosition = bpLeftUp then
      FCurrentPosition := bpRightUp
    else
    if FCurrentPosition = bpLeftDown then
      FCurrentPosition := bpRightDown;
    with CalcOffset(ARect) do
      OffsetRect(ARect, X, Y);
  end;

  if ARect.Top < ScreenRect.Top then
  begin
    with CalcOffset(ARect) do
      OffsetRect(ARect, -X, -Y);
    if FCurrentPosition = bpLeftUp then
      FCurrentPosition := bpLeftDown
    else
    if FCurrentPosition = bpRightUp then
      FCurrentPosition := bpRightDown;
    with CalcOffset(ARect) do
      OffsetRect(ARect, X, Y);
  end;

  case FCurrentPosition of
    bpLeftDown, bpRightDown:
      FDeltaY := FTipHeight;
    bpLeftUp, bpRightUp:
      FDeltaY := 0;
  end;
end;

procedure TJvBalloonWindow.CMShowingChanged(var Msg: TMessage);
begin
  { In response of RecreateWnd, SetParentWindow calls, only respond when visible }
  { Actually only necessairy for TJvBalloonWindow not for TJvBalloonWindowEx }
  if Showing then
    UpdateRegion;
  inherited;
end;

procedure TJvBalloonWindow.CMTextChanged(var Msg: TMessage);
begin
  {inherited;}
end;

procedure TJvBalloonWindow.CreateParams(var Params: TCreateParams);
const
  CS_DROPSHADOW = $00020000;
begin
  inherited CreateParams(Params);
  { Drop shadow in combination with custom animation may cause blurry effect,
    no solution.
  }
  if IsWinXP_UP then
    Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;

function TJvBalloonWindow.CreateRegion: HRGN;
var
  Rect: TRect;
  RegionRound, RegionTip: HRGN;
  PtTail: array [0..2] of TPoint;
begin
  SetRect(Rect, 0, 0, Width, Height);

  case FCurrentPosition of
    bpLeftDown:
      begin
        {         0
                / |
               /  |
              /   |
             2----1
        }

        PtTail[0] := Point(Rect.Right - (FTipDelta + 1), 0);
        PtTail[1] := Point(Rect.Right - (FTipDelta + 1), FTipHeight + 1);
        PtTail[2] := Point(Rect.Right - (FTipDelta + FTipWidth + 2), FTipHeight + 1);
      end;
    bpRightDown:
      begin
        {    0
             | \
             |  \
             |   \
             1----2
        }
        PtTail[0] := Point(FTipDelta + 1, 0);
        PtTail[1] := Point(FTipDelta + 1, FTipHeight + 1);
        PtTail[2] := Point(FTipDelta + FTipWidth + 2, FTipHeight + 1);
      end;
    bpLeftUp:
      begin
        {    2----1
              \   |
               \  |
                \ |
                  0
        }

        PtTail[0] := Point(Rect.Right - (FTipDelta + 1), Rect.Bottom + 1);
        PtTail[1] := Point(Rect.Right - (FTipDelta + 1), Rect.Bottom - (FTipHeight + 1));
        PtTail[2] := Point(Rect.Right - (FTipDelta + FTipWidth + 2), Rect.Bottom - (FTipHeight + 1));
      end;
    bpRightUp:
      begin
        {    1----2
             |   /
             |  /
             | /
             0
        }

        PtTail[0] := Point(FTipDelta + 1, Rect.Bottom);
        PtTail[1] := Point(FTipDelta + 1, Rect.Bottom - (FTipHeight + 1));
        PtTail[2] := Point(FTipDelta + FTipWidth + 2, Rect.Bottom - (FTipHeight + 1));
      end;
  end;

  RegionTip := CreatePolygonRgn(PtTail, 3, WINDING);
  case FCurrentPosition of
    bpLeftDown, bpRightDown:
      RegionRound := CreateRoundRectRgn(1, FTipHeight + 1, Width, Height - 3, 11, 11);
  else {bpLeftUp, bpRightUp:}
    RegionRound := CreateRoundRectRgn(1, 1, Rect.Right, Rect.Bottom - FTipHeight, 11, 11);
  end;
  Result := CreateRectRgn(0, 0, 1, 1);

  CombineRgn(Result, RegionTip, RegionRound, RGN_OR);
  DeleteObject(RegionTip);
  DeleteObject(RegionRound);
end;

function TJvBalloonWindow.GetStemPointPosition: TPoint;
begin
  Result := GetStemPointPositionInRect(BoundsRect);
end;

function TJvBalloonWindow.GetStemPointPositionInRect(const ARect: TRect): TPoint;
begin
  { bpAuto returns the same value as bpLeftDown; bpLeftDown is choosen
    arbitrary }
  with ARect do
    case FCurrentPosition of
      bpAuto, bpLeftDown:
        Result := Point(Right - FTipDelta, Top);
      bpRightDown:
        Result := Point(Left + FTipDelta, Top);
      bpLeftUp:
        Result := Point(Right - FTipDelta, Bottom);
      bpRightUp:
        Result := Point(Left + FTipDelta, Bottom);
    end;
end;

procedure TJvBalloonWindow.Init(AData: Pointer);
begin
  with TGlobalCtrl.Instance.MainCtrl do
  begin
    FShowIcon := (ahShowIconInHint in ApplicationHintOptions) and
      (DefaultIcon <> ikNone) and
      ((DefaultIcon <> ikCustom) or (DefaultImageIndex > -1));
    FShowHeader := (ahShowHeaderInHint in ApplicationHintOptions) and (DefaultHeader <> '');
    FHeader := DefaultHeader;
    FCurrentPosition := DefaultBalloonPosition;
  end;

  FImageSize := TGlobalCtrl.Instance.HintImageSize;
  FSwitchHeight := GetSystemMetrics(SM_CYCURSOR);
end;

{$IFDEF COMPILER6_UP}
procedure TJvBalloonWindow.NCPaint(DC: HDC);
begin
  { Do nothing, thus prevent TJvHintWindow from drawing }
end;
{$ELSE}
procedure TJvBalloonWindow.WMNCPaint(var Msg: TMessage);
begin
  { Do nothing, thus prevent TJvHintWindow from drawing }
end;
{$ENDIF COMPILER6_UP}

procedure TJvBalloonWindow.Paint;
var
  HintRect: TRect;
  HeaderRect: TRect;
begin
  if FShowIcon then
    TGlobalCtrl.Instance.DrawHintImage(Canvas, 12, FDeltaY + 8, Color);

  if FMsg > '' then
  begin
    HintRect := ClientRect;
    Inc(HintRect.Left, 12);
    Inc(HintRect.Top, FDeltaY + FMessageTop);
    Canvas.Font := Screen.HintFont;
//    Canvas.Font.Style := Canvas.Font.Style - [fsBold];
    DrawText(Canvas.Handle, PChar(FMsg), -1, HintRect,
      DefaultTextFlags or DrawTextBiDiModeFlagsReadingOnly);
  end;

  if FShowHeader then
  begin
    HeaderRect := ClientRect;
    Inc(HeaderRect.Left, 12);
    if FShowIcon then
      Inc(HeaderRect.Left, FImageSize.cx + 8);
    Inc(HeaderRect.Top, FDeltaY + 8);
    Canvas.Font := Screen.HintFont;
    Canvas.Font.Style := Canvas.Font.Style + [fsBold];
    DrawText(Canvas.Handle, PChar(FHeader), -1, HeaderRect,
      DefaultTextFlags or DrawTextBiDiModeFlagsReadingOnly);
  end;
end;

procedure TJvBalloonWindow.UpdateRegion;
var
  Region: HRGN;
begin
  Region := CreateRegion;
  if SetWindowRgn(Handle, Region, False) = 0 then
    DeleteObject(Region);
  { MSDN: After a successful call to SetWindowRgn, the system owns the region
    specified by the region handle hRgn. The system does not make a copy of
    the region. Thus, you should not make any further function calls with
    this region handle. In particular, do not delete this region handle. The
    system deletes the region handle when it no longer needed. }
end;

procedure TJvBalloonWindow.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
var
  Brush, BrushBlack: HBRUSH;
  Region: HRGN;
begin
  Brush := CreateSolidBrush(ColorToRGB(Color));
  BrushBlack := CreateSolidBrush(0);
  try
    Region := CreateRegion;
    OffsetRgn(Region, -1, -1);
    FillRgn(Msg.DC, Region, Brush);
    FrameRgn(Msg.DC, Region, BrushBlack, 1, 1);
    DeleteObject(Region);
  finally
    DeleteObject(Brush);
    DeleteObject(BrushBlack);
  end;
  Msg.Result := 1;
end;

//=== { TJvBalloonHint } =====================================================

constructor TJvBalloonHint.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActive := False;
  FHint := TJvBalloonWindowEx.Create(Self);
  FHint.FCtrl := Self;
  FHint.Visible := False;
  FHint.OnMouseDown := HandleMouseDown;
  FHint.OnMouseUp := HandleMouseUp;
  FHint.OnMouseMove := HandleMouseMove;
  FHint.OnClick := HandleClick;
  FHint.OnDblClick := HandleDblClick;
  FOptions := [boShowCloseBtn];
  FApplicationHintOptions := [ahShowHeaderInHint, ahShowIconInHint];
  FDefaultIcon := ikInformation;
  FDefaultBalloonPosition := bpAuto;
  FDefaultImageIndex := -1;
  FCustomAnimationTime := 100;
  FCustomAnimationStyle := atBlend;

  TGlobalCtrl.Instance.Add(Self);
end;

destructor TJvBalloonHint.Destroy;
begin
  CancelHint;
  StopHintTimer;

  if FHandle <> 0 then
    DeallocateHWndEx(FHandle);

  TGlobalCtrl.Instance.Remove(Self);

  inherited Destroy;
end;

procedure TJvBalloonHint.ActivateHint(ACtrl: TControl; const AHint: string;
  const AImageIndex: TImageIndex; const AHeader: string;
  const VisibleTime: Integer);
begin
  if not Assigned(ACtrl) then
    Exit;

  CancelHint;

  with FData do
  begin
    RHint := AHint;
    RIconKind := ikCustom;
    RImageIndex := AImageIndex;
    RHeader := AHeader;
    RVisibleTime := VisibleTime;
  end;

  InternalActivateHint(ACtrl);
end;

procedure TJvBalloonHint.ActivateHint(ACtrl: TControl;