cxhint.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,789 行 · 第 1/4 页

end;

procedure TcxCustomHintWindow.SetAnimate(AValue: TcxHintAnimate);
begin
  AnimationStyle := AValue;
end;

procedure TcxCustomHintWindow.LoadPropertiesFromController(
  const AHintController: TcxCustomHintStyleController);
begin
  Caption := AHintController.HintWindow.Caption;
  LoadPropertiesFromHintStyle(AHintController.HintStyle);
end;

procedure TcxCustomHintWindow.LoadPropertiesFromHintInterface(const AHintIntf: IcxHint);
var
  FDefaultFont: TFont;
begin
  FCaption := AHintIntf.GetHintCaption;
  Animate := AHintIntf.GetAnimate;
  AnimationDelay := AHintIntf.GetAnimationDelay;
  FCallOutPosition := AHintIntf.GetCallOutPosition;
  FBorderColor := AHintIntf.GetBorderColor;
  FHintColor := AHintIntf.GetColor;
  FIconSize := AHintIntf.GetIconSize;
  FIconType := AHintIntf.GetIconType;
  FRounded := AHintIntf.GetRounded;
  FStandardHint := AHintIntf.GetStandard;
  if FRounded = False then
    FRoundRadius := 0
  else
    FRoundRadius := AHintIntf.GetRoundRadius;
  if Assigned(AHintIntf.GetHintIcon) then
    FIcon.Assign(AHintIntf.GetHintIcon)
  else
    FreeAndNil(FIcon);
  FDefaultFont := TFont.Create;
  try
  if Assigned(AHintIntf.GetHintFont) then
    Font.Assign(AHintIntf.GetHintFont)
  else
    Font.Assign(FDefaultFont);
  if Assigned(AHintIntf.GetHintCaptionFont) then
    FCaptionFont.Assign(AHintIntf.GetHintCaptionFont)
  else
    FCaptionFont.Assign(FDefaultFont);
  finally
    FreeAndNil(FDefaultFont);
  end;
end;

procedure TcxCustomHintWindow.LoadPropertiesFromHintStyle(
  const AHintStyle: TcxCustomHintStyle);
begin
  Animate := AHintStyle.Animate;
  AnimationDelay := AHintStyle.AnimationDelay;
  FCallOutPosition := AHintStyle.CallOutPosition;
  FBorderColor := AHintStyle.BorderColor;
  FHintColor := AHintStyle.Color;
  FIcon.Assign(AHintStyle.Icon);
  FIconSize := AHintStyle.IconSize;
  FIconType := AHintStyle.IconType;
  FRounded := AHintStyle.Rounded;
  FStandardHint := AHintStyle.Standard;
  if FRounded = False then
    FRoundRadius := 0
  else
    FRoundRadius := AHintStyle.RoundRadius;
  Font.Assign(AHintStyle.Font);
  FCaptionFont.Assign(AHintStyle.CaptionFont);
end;

procedure TcxCustomHintWindow.CalculateValues;

  function GetIconWidth: Integer;
  var
    FBitmap: TBitmap;
  begin
    FBitmap := TBitmap.Create;
    try
      FBitmap.Width := FIcon.Width;
      FBitmap.Height := FIcon.Height;
      DrawIconEx(FBitmap.Canvas.Handle, 0, 0, FIcon.Handle,
        FIcon.Width, FIcon.Height, 0, 0, DI_NORMAL);
      Result := FIcon.Width;
    finally
      FBitmap.Free;
    end;
  end;

begin
  FIndentDelta := 6;
  if FRounded = False then
  begin
    FLeftRightMargint := FIndentDelta;
    FTopBottomMargin := FIndentDelta;
  end
  else
  begin
    FLeftRightMargint := (FRoundRadius div 2) + 2;
    FTopBottomMargin := (FRoundRadius div 2) + 2;
  end;
  if not FIcon.Empty then
  begin
    if FIconType <> cxhiCustom then
      FIconWidth := FIcon.Width
    else
      FIconWidth := GetIconWidth;
    FIconHeight := FIcon.Height;
    case FIconSize of
      cxisLarge:
      begin
        FIconHeight := 32;
        FIconWidth := 32;
      end;
      cxisSmall:
      begin
        FIconHeight := 16;
        FIconWidth := 16;
      end;
    end;
  end
  else
  begin
    FIconHeight := 0;
    FIconWidth := 0;
  end;
  FIconLeftMargin := FLeftRightMargint;
  FIconTopMargin := FLeftRightMargint;
end;

procedure TcxCustomHintWindow.CalculateRects(const ACaption, AText: string;
  const AMaxWidth: Integer);

  function IsCaptionEpty: Boolean;
  begin
    Result := ACaption = '';
  end;

  function GetIconHorzOffset: Integer;
  begin
    if FIconWidth > 0 then
      Result := FIndentDelta
    else
      Result := 0;
  end;

  function GetMaxCaptionWidth(AIsCaption: Boolean = True): Integer;
  var
    ADec: Integer;
  begin
    Result := AMaxWidth;
    if Result <= 0 then
    begin
      Result := MaxInt;
      Exit;
    end;
    ADec := GetIconHorzOffset + 2 * FLeftRightMargint + FIndentDelta;
    if AIsCaption then
      Inc(ADec, FIconWidth);
    Dec(Result, ADec);
  end;

  procedure GetCaptionBounds(var ARect: TRect; ACaption: string);
  begin
    DrawText(Canvas.Handle, PChar(ACaption),
      Length(ACaption), ARect, DT_CALCRECT or DT_WORDBREAK or DT_NOPREFIX);
  end;

  procedure OffsetRectWithIndents(var ARect: TRect; AIsCaption: Boolean = True);
  var
   AIconHorzOffset: Integer;
  begin
    AIconHorzOffset := GetIconHorzOffset;
    if AIsCaption then
      Inc(AIconHorzOffset, FIconWidth);
    InflateRectEx(ARect, FLeftRightMargint + AIconHorzOffset, FTopBottomMargin,
      FLeftRightMargint + AIconHorzOffset + FIndentDelta, FTopBottomMargin);
  end;

  procedure VertOffsetTextRect(var ATextRect: TRect; const ACaptionBounds: TRect);
  var
    AVertOffset: Integer;
  begin
    if RectHeight(ACaptionBounds) > FIconHeight then
      AVertOffset := RectHeight(ACaptionBounds) + FIndentDelta
    else
      AVertOffset := FIconHeight + FIndentDelta;
    Inc(ATextRect.Top, AVertOffset);
    Inc(ATextRect.Bottom, AVertOffset);
  end;

  function CalcCallOutPosition(AHintWndRect: TRect): TRect;
  begin
    Result := cxEmptyRect;
    FCalculatedCallOutPos := CalculateAutoCallOutPosition(AHintWndRect);
    with Result do
      case FCalculatedCallOutPos of
        cxbpRightBottom, cxbpRightTop: Right := FCallOutSize;
        cxbpBottomLeft, cxbpBottomRight: Bottom := FCallOutSize;
        cxbpLeftTop, cxbpLeftBottom:
          begin
            Left := FCallOutSize;
            Right := FCallOutSize;
            FIconLeftMargin := FIconLeftMargin + FCallOutSize;
          end;
        cxbpTopLeft, cxbpTopRight:
          begin
            Top := FCallOutSize;
            Bottom := FCallOutSize;
            FIconTopMargin := FIconTopMargin + FCallOutSize;
          end;
      end;
  end;

  procedure OffsetRectWithCallOutPosition(var ARect: TRect;
    const ACalloutPosition: TRect);
  begin
    with ACalloutPosition do
      InflateRectEx(ARect, Left, Top, Right, Bottom);
  end;

  procedure CorrectRectHeightWithIcon(var ARect: TRect);
  begin
    if RectHeight(ARect) < FIconHeight then
      ARect.Bottom := ARect.Top + FIconHeight;
  end;

  procedure CalculateTextsBouds(var ACaptionBounds, ATextBounds: TRect);
  begin
    if ACaption = '' then
    begin
      ATextBounds := Rect(0, 0, GetMaxCaptionWidth, 1);
      ACaptionBounds := Rect(0, 0, 0, 0);
    end
    else
    begin
      ACaptionBounds := Rect(0, 0, GetMaxCaptionWidth, 1);
      Canvas.Font.Assign(FCaptionFont);
      GetCaptionBounds(ACaptionBounds, ACaption);
      ATextBounds := Rect(0, 0, GetMaxCaptionWidth(False), 1);
    end;
    Canvas.Font.Assign(Font);
    if AText = '' then
      ATextBounds := cxEmptyRect
    else
      GetCaptionBounds(ATextBounds, AText);
  end;

  procedure OffsetRectsWithIndents(var ACaptionRect, ATextRect,
    AHintWndRect: TRect);
  var
    ACallOutPosition: TRect;
  begin
    if ACaption <> '' then
    begin
      OffsetRectWithIndents(ACaptionRect);
      OffsetRectWithIndents(ATextRect, False);
      VertOffsetTextRect(ATextRect, ACaptionRect);
      if ACaptionRect.Right > ATextRect.Right then
        ATextRect.Right := ACaptionRect.Right
      else
        ACaptionRect.Right := ATextRect.Right;
    end
    else
    begin
      OffsetRectWithIndents(ATextRect);
      CorrectRectHeightWithIcon(ATextRect);
    end;
    with ATextRect do
      AHintWndRect :=
        Rect(0, 0, Right + FLeftRightMargint, Bottom + FTopBottomMargin);
    ACallOutPosition := CalcCallOutPosition(AHintWndRect);
    if FCaption <> '' then
      OffsetRectWithCallOutPosition(ACaptionRect, ACallOutPosition);
    OffsetRectWithCallOutPosition(ATextRect, ACallOutPosition);
    OffsetRectWithCallOutPosition(AHintWndRect, ACallOutPosition);
  end;

begin
  CalculateValues;
  CalculateTextsBouds(FCaptionRect, FTextRect);
  OffsetRectsWithIndents(FCaptionRect, FTextRect, FHintWndRect);
end;

function TcxCustomHintWindow.CalculateAutoCallOutPosition(const ARect: TRect): TcxCallOutPosition;
var
  FCursorPos: TPoint;
begin
  if FCallOutPosition = cxbpAuto then
  begin
    Windows.GetCursorPos(FCursorPos);
    if FCursorPos.Y < (Screen.Height div 2) then
    begin
      if FCursorPos.X - RectWidth(ARect) < 0 then
        Result := cxbpTopLeft
      else
        Result := cxbpTopRight;
    end
    else
    begin
      if FCursorPos.X - RectWidth(ARect) < 0 then
        Result := cxbpBottomLeft
      else
        Result := cxbpBottomRight;
    end;
  end
  else
    Result := FCallOutPosition;
end;

procedure TcxCustomHintWindow.CalculateIcon;
type
  TcxRealHintIconType = (IDIAPPLICATION, IDIINFORMATION, IDIWARNING,
    IDIERROR, IDIQUESTION, IDIWINLOGO);
const
  FRealIconTypes: array[TcxRealHintIconType] of MakeIntResource = (
    IDI_APPLICATION, IDI_INFORMATION, IDI_WARNING, IDI_ERROR, IDI_QUESTION,
    IDI_WINLOGO);
begin
  if FIconType = cxhiNone then
  begin
    if Assigned(FIcon) and not FIcon.Empty then
    begin
      FreeAndNil(FIcon);
      FIcon := TIcon.Create;
    end;
    Exit;
  end;
  if FIconType = cxhiCustom then
    Exit;
  if FIconType = cxhiCurrentApplication then
    FIcon.Assign(Application.Icon)
  else
    FIcon.Handle := LoadIcon(0,
      FRealIconTypes[TcxRealHintIconType(Ord(FIconType) - 1)]);
end;

procedure TcxCustomHintWindow.EnableRegion;
begin
  CreateBalloonForm;
end;

procedure TcxCustomHintWindow.CreateBalloonForm;
var
  R: TRect;
  CallOutRgn: HRGN;
  CallOutTops: array[0..2] of TPoint;
begin
  if (FCalculatedCallOutPos = cxbpNone) and (Rounded = False) then
  begin
    DisableRegion;
    Exit;
  end;
  R := ClientRect;

  case FCalculatedCallOutPos of
    cxbpLeftBottom:
      begin
        InflateRectEx(R, FCallOutSize, 0, 0, 0);
        CallOutTops[0] := Point(R.Left, R.Bottom - FCallOutSize);
        CallOutTops[1] := Point(R.Left, R.Bottom - FCallOutSize * 2);
        CallOutTops[2] := Point(R.Left - FCallOutSize, R.Bottom - FCallOutSize);
      end;
    cxbpLeftTop:
      begin
        InflateRectEx(R, FCallOutSize, 0, 0, 0);
        CallOutTops[0] := Point(R.Left, R.Top + FCallOutSize);
        CallOutTops[1] := Point(R.Left, R.Top + FCallOutSize * 2);
        CallOutTops[2] := Point(R.Left - FCallOutSize, R.Top + FCallOutSize);
      end;
    cxbpTopRight:
      begin
        InflateRectEx(R, 0, FCallOutSize, 0, 0);
        CallOutTops[0] := Point(R.Right - FCallOutSize, R.Top);
        CallOutTops[1] := Point(R.Right - FCallOutSize * 2, R.Top);
        CallOutTops[2] := Point(R.Right - FCallOutSize, R.Top - FCallOutSize);
      end;
    cxbpTopLeft:
      begin
        InflateRectEx(R, 0, FCallOutSize, 0, 0);
        CallOutTops[0] := Point(R.Left + FCallOutSize, R.Top);
        CallOutTops[1] := Point(R.Left + FCallOutSize * 2, R.Top);
        CallOutTops[2] := Point(R.Left + FCallOutSize, R.Top - FCallOutSize);
      end;
    cxbpRightBottom:
      begin
        InflateRectEx(R, 0, 0, -FCallOutSize, 0);
        CallOutTops[0] := Point(R.Right - 1, R.Bottom - FCallOutSize);
        CallOutTops[1] := Point(R.Right - 1, R.Bottom - FCallOutSize * 2);
        CallOutTops[2] := Point(R.Right + FCallOutSize, R.Bottom - FCallOutSize);
      end;
    cxbpRightTop:
      begin
        InflateRectEx(R, 0, 0, -FCallOutSize, 0);
        CallOutTops[0] := Point(R.Right - 1, R.Top + FCallOutSize);
        CallOutTops[1] := Point(R.Right - 1, R.Top + FCallOutSize * 2);
        CallOutTops[2] := Point(R.Right + FCallOutSize, R.Top + FCallOutSize);
      end;
    cxbpBottomRight:
      begin
        InflateRectEx(R, 0, 0, 0, -FCallOutSize);
        CallOutTops[0] := Point(R.Right - FCallOutSize, R.Bottom - 1);
        CallOutTops[1] := Point(R.Right - FCallOutSize * 2, R.Bottom - 1);
        CallOutTops[2] := Point(R.Right - FCallOutSize, R.Bottom + FCallOutSize);
      end;
    cxbpBottomLeft:
      begin
        InflateRectEx(R, 0, 0, 0, -FCallOutSize);
        CallOutTops[0] := Point(R.Left + FCallOutSize, R.Bottom - 1);
        CallOutTops[1] := Point(R.Left + FCallOutSize * 2, R.Bottom - 1);
        CallOutTops[2] := Point(R.Left + FCallOutSize, R.Bottom + FCallOutSize);
      end;
  end;

  Rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, FRoundRadius, FRoundRadius);
  CallOutRgn := 0;
  if FCalculatedCallOutPos <> cxbpNone then
  begin
    CallOutRgn := CreatePolygonRgn(CallOutTops, 3, WINDING);
    CombineRgn(Rgn, Rgn, CallOutRgn, RGN_OR );
  end;
  OffsetRgn(Rgn, 1, 1);
  SetWindowRgn(Handle, Rgn, True);
  if CallOutRgn <> 0 then
    DeleteObject(CallOutRgn);
end;

initialization
{$IFNDEF DELPHI6}
  UserHandle := GetModuleHandle('USER32');
  if UserHandle <> 0 then
    @AnimateWindowProc := GetProcAddress(UserHandle, 'AnimateWindow');
{$ENDIF}
  FControllerList := TList.Create;
  FHintedControlController := TcxHintedControlController.Create(nil);

finalization
  FreeAndNil(FHintedControlController);
  if FControllerList.Count <> 0 then
    raise EcxEditError.Create('HintStyleControllerList.Count <> 0');
  FreeAndNil(FControllerList);

end.