rxhints.pas

灰鸽子1.23源码,,,,,,,

    end;
    W := Min(Max(8, Min(WidthOf(R), HeightOf(R)) div 4), WidthOf(R) div 2);
    case FPos of
      hpTopRight:
        Tail := CreatePolyRgn([Point(TileOffs, Height - HintShadowSize),
          Point(R.Left + W div 4, R.Bottom), Point(R.Left + 2 * W, R.Bottom)]);
      hpTopLeft:
        Tail := CreatePolyRgn([Point(TileOffs, Height - HintShadowSize),
          Point(R.Right - W div 4, R.Bottom), Point(R.Right - 2 * W, R.Bottom)]);
      hpBottomRight:
        Tail := CreatePolyRgn([Point(TileOffs, 0),
          Point(R.Left + W div 4, R.Top), Point(R.Left + 2 * W, R.Top)]);
      else {hpBottomLeft}
        Tail := CreatePolyRgn([Point(TileOffs, 0),
          Point(R.Right - W div 4, R.Top), Point(R.Right - 2 * W, R.Top)]);
    end;
    try
      Dest := Result;
      Result := CreateRectRgnIndirect(R);
      try
        CombineRgn(Result, Dest, Tail, RGN_OR);
      finally
        if Dest <> 0 then DeleteObject(Dest);
      end;
    finally
      DeleteObject(Tail);
    end;
  end;
end;

procedure TRxHintWindow.FillRegion(Rgn: HRgn; Shade: Boolean);
begin
  if Shade then begin
    FImage.Canvas.Brush.Bitmap :=
{$IFDEF RX_D4}
      AllocPatternBitmap(clBtnFace, clWindowText);
{$ELSE}
      CreateTwoColorsBrushPattern(clBtnFace, clWindowText);
{$ENDIF}
    FImage.Canvas.Pen.Style := psClear;
  end
  else begin
    FImage.Canvas.Pen.Style := psSolid;
    FImage.Canvas.Brush.Color := Color;
  end;
  try
    PaintRgn(FImage.Canvas.Handle, Rgn);
    if not Shade then begin
      FImage.Canvas.Brush.Color := Font.Color;
{$IFDEF WIN32}
      if (HintStyle = hsRectangle) and not HintTail then begin
        DrawEdge(FImage.Canvas.Handle, FRect, BDR_RAISEDOUTER, BF_RECT);
      end
      else
{$ENDIF}
        FrameRgn(FImage.Canvas.Handle, Rgn, FImage.Canvas.Brush.Handle, 1, 1);
    end;
  finally
    if Shade then begin
{$IFDEF RX_D4}
      FImage.Canvas.Brush.Bitmap := nil;
{$ELSE}
      FImage.Canvas.Brush.Bitmap.Free;
{$ENDIF}
      FImage.Canvas.Pen.Style := psSolid;
    end;
    FImage.Canvas.Brush.Color := Color;
  end;
end;

procedure TRxHintWindow.Paint;
var
  R: TRect;
  FShadeRgn, FRgn: HRgn;

  procedure PaintText(R: TRect);
  const
    Flag: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
{$IFNDEF WIN32}
  var
    ACaption: array[0..255] of Char;
{$ENDIF}
  begin
{$IFDEF WIN32}
    DrawText(FImage.Canvas.Handle, PChar(Caption),
{$ELSE}
    DrawText(FImage.Canvas.Handle, StrPCopy(ACaption, Caption),
{$ENDIF}
      -1, R, DT_NOPREFIX or DT_WORDBREAK or Flag[HintAlignment]
      {$IFDEF RX_D4} or DrawTextBiDiModeFlagsReadingOnly {$ENDIF});
  end;

begin
  R := ClientRect;
  FImage.Handle := CreateCompatibleBitmap(Canvas.Handle,
    WidthOf(ClientRect), HeightOf(ClientRect));
  FImage.Canvas.Font := Self.Canvas.Font;
  if (HintStyle <> hsRectangle) or (HintShadowSize > 0) or HintTail then
    FImage.Canvas.Draw(0, 0, FSrcImage);
  FRgn := CreateRegion(False);
  FShadeRgn := CreateRegion(True);
  try
    FillRegion(FShadeRgn, True);
    FillRegion(FRgn, False);
  finally
    DeleteObject(FShadeRgn);
    DeleteObject(FRgn);
  end;
  R := FTextRect;
  if HintAlignment = taLeftJustify then Inc(R.Left, 2);
  PaintText(R);
  Canvas.Draw(0, 0, FImage);
end;

procedure TRxHintWindow.ActivateHint(Rect: TRect; const AHint: string);
var
  R: TRect;
  ScreenDC: HDC;
  P: TPoint;
begin
  Caption := AHint;
  GetCursorPos(P);
  FPos := hpBottomRight;
  R := CalcHintRect(Screen.Width, AHint, nil);
{$IFDEF RX_D3}
  OffsetRect(R, Rect.Left - R.Left, Rect.Top - R.Top);
{$ELSE}
 {$IFDEF WIN32}
  OffsetRect(R, P.X, P.Y + GetCursorHeightMargin);
 {$ELSE}
  OffsetRect(R, P.X, Rect.Top - R.Top);
 {$ENDIF WIN32}
{$ENDIF}
  Rect := R;
  BoundsRect := Rect;

  if HintTail then begin
    Rect.Top := P.Y - Height - 3;
    if Rect.Top < 0 then Rect.Top := BoundsRect.Top
    else Rect.Bottom := Rect.Top + HeightOf(BoundsRect);

    Rect.Left := P.X + 1;
    if Rect.Left < 0 then Rect.Left := BoundsRect.Left
    else Rect.Right := Rect.Left + WidthOf(BoundsRect);
  end;

  if Rect.Top + Height > Screen.Height then begin
    Rect.Top := Screen.Height - Height;
    if Rect.Top <= P.Y then Rect.Top := P.Y - Height - 3;
  end;
  if Rect.Left + Width > Screen.Width then begin
    Rect.Left := Screen.Width - Width;
    if Rect.Left <= P.X then Rect.Left := P.X - Width -3;
  end;
  if Rect.Left < 0 then begin
    Rect.Left := 0;
    if Rect.Left + Width >= P.X then Rect.Left := P.X - Width - 1;
  end;
  if Rect.Top < 0 then begin
    Rect.Top := 0;
    if Rect.Top + Height >= P.Y then Rect.Top := P.Y - Height - 1;
  end;

  if (HintStyle <> hsRectangle) or (HintShadowSize > 0) or HintTail then
  begin
    FPos := hpBottomRight;
    if (Rect.Top + Height < P.Y) then FPos := hpTopRight;
    if (Rect.Left + Width < P.X) then begin
      if FPos = hpBottomRight then FPos := hpBottomLeft
      else FPos := hpTopLeft;
    end;
    if HintTail then begin
      if (FPos in [hpBottomRight, hpBottomLeft]) then begin
        OffsetRect(FRect, 0, FTileSize.Y);
        OffsetRect(FTextRect, 0, FTileSize.Y);
      end;
      if (FPos in [hpBottomRight, hpTopRight]) then begin
        OffsetRect(FRect, FTileSize.X, 0);
        OffsetRect(FTextRect, FTileSize.X, 0);
      end;
    end;
    if HandleAllocated then begin
      SetWindowPos(Handle, HWND_BOTTOM, 0, 0, 0, 0, SWP_HIDEWINDOW or
        SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOMOVE);
      if Screen.ActiveForm <> nil then UpdateWindow(Screen.ActiveForm.Handle);
    end;
    ScreenDC := GetDC(0);
    try
      with FSrcImage do begin
        Width := WidthOf(BoundsRect);
        Height := HeightOf(BoundsRect);
        BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Rect.Left,
          Rect.Top, SRCCOPY);
      end;
    finally
      ReleaseDC(0, ScreenDC);
    end;
  end;
  SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, 0,
    0, SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE);
end;

function TRxHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string;
  AData: Pointer): TRect;
const
  Flag: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  A: Integer;
  X, Y, Factor: Double;
{$IFNDEF WIN32}
  ACaption: array[0..255] of Char;
{$ENDIF}
begin
  Result := Rect(0, 0, MaxWidth, 0);
  DrawText(Canvas.Handle,
{$IFDEF WIN32}
    PChar(AHint),
{$ELSE}
    StrPCopy(ACaption, AHint),
{$ENDIF}
    -1, Result, DT_CALCRECT or DT_WORDBREAK or DT_NOPREFIX or Flag[HintAlignment]
    {$IFDEF RX_D4} or DrawTextBiDiModeFlagsReadingOnly {$ENDIF});
  Inc(Result.Right, 8);
  Inc(Result.Bottom, 4);
  FRect := Result;
  FTextRect := Result;
  InflateRect(FTextRect, -1, -1);
  case HintAlignment of
    taCenter: OffsetRect(FTextRect, -1, 0);
    taRightJustify: OffsetRect(FTextRect, -4, 0);
  end;
  FRoundFactor := Max(6, Min(WidthOf(Result), HeightOf(Result)) div 4);
  if HintStyle = hsRoundRect then
    InflateRect(FRect, FRoundFactor div 4, FRoundFactor div 4)
  else if HintStyle = hsEllipse then begin
    X := WidthOf(FRect) / 2;
    Y := HeightOf(FRect) / 2;
    if (X <> 0) and (Y <> 0) then begin
      Factor := Round(Y / 3);
      A := Round(Sqrt((Sqr(X) * Sqr(Y + Factor)) / (Sqr(Y + Factor) - Sqr(Y))));
      InflateRect(FRect, A - Round(X), Round(Factor));
    end;
  end;
  Result := FRect;
  OffsetRect(FRect, -Result.Left, -Result.Top);
  OffsetRect(FTextRect, -Result.Left, -Result.Top);
  Inc(Result.Right, HintShadowSize);
  Inc(Result.Bottom, HintShadowSize);
  if HintTail then begin
    FTileSize.Y := Max(14, Min(WidthOf(FTextRect), HeightOf(FTextRect)) div 2);
    FTileSize.X := FTileSize.Y - 8;
    Inc(Result.Right, FTileSize.X);
    Inc(Result.Bottom, FTileSize.Y);
  end;
end;

{$IFDEF RX_D3}
procedure TRxHintWindow.ActivateHintData(Rect: TRect; const AHint: string;
  AData: Pointer);
begin
  ActivateHint(Rect, AHint);
end;
{$ENDIF}

end.