cxhint.pas

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

  R: TRect;
  AHintInfo: THintInfo;
  ACanShow: Boolean;
begin
  ZeroMemory(@AHintInfo, SizeOf(THintInfo));
  AHintInfo.HintControl := FindVCLWindow(Point(X, Y));
  AHintInfo.HintWindowClass := FHintWindow.Classinfo;
  AHintInfo.HintPos := Point(X, Y);
  if AMaxWidth = 0 then
    AMaxWidth := Screen.Width;
  AHintInfo.HintMaxWidth := AMaxWidth;
  AHintInfo.HintStr := AHint;

  ACanShow := True;
  DoShowHintEx(AHintInfo.HintStr, ACaption, ACanShow, AHintInfo);
  if ACanShow then
  begin
    SetHintedControl(AHintInfo.HintControl);
    FHintWindow.Caption := ACaption;
    R := FHintWindow.CalcHintRect(AHintInfo.HintMaxWidth, AHint, AHintInfo.HintData);
    cxOffsetRect(R, AHintInfo.HintPos);
    FHintWindow.ActivateHint(R, AHint);
  end;
end;
}

function TcxCustomHintStyleController.GetHintWidth(AHint: string): Integer;
var
  R: TRect;
begin
  R := FHintWindow.CalcHintRect(Screen.Width, AHint, nil);
  Result := R.Right - R.Left;
end;

function TcxCustomHintStyleController.GetHintHeight(AHint: string): Integer;
var
  R: TRect;
begin
  R := FHintWindow.CalcHintRect(Screen.Width, AHint, nil);
  Result := R.Bottom - R.Top;
end;

procedure TcxCustomHintStyleController.HideHint;
begin
  SetHintedControl(nil);
  if (FHintWindow <> nil) and FHintWindow.HandleAllocated and
    IsWindowVisible(FHintWindow.Handle) then
    ShowWindow(FHintWindow.Handle, SW_HIDE);
end;

procedure TcxCustomHintStyleController.Loaded;
begin
  inherited Loaded;
  SetApplicationHintProperties;
  Changed;
  SaveShowHintEvent;
end;

procedure TcxCustomHintStyleController.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TcxCustomHintStyleController.EndUpdate;
begin
  Dec(FUpdateCount);
  if FUpdateCount = 0 then
    SetApplicationHintProperties;
end;

procedure TcxCustomHintStyleController.AddListener(AListener: TcxCustomHintStyle);
begin
  if (AListener = nil) or (FListeners.IndexOf(AListener) >= 0) then
    Exit;
  FListeners.Add(AListener);
end;

procedure TcxCustomHintStyleController.Changed;
var
  I: Integer;
begin
  if (HintStyle <> nil) and Assigned(FOnHintStyleChanged) then
    FOnHintStyleChanged(Self, HintStyle);
  if not IsDestruction then
    for I := 0 to Listeners.Count - 1 do
      DoHintStyleChanged(TcxCustomHintStyle(Listeners[I]));
end;

procedure TcxCustomHintStyleController.DoHintStyleChanged(AStyle: TcxCustomHintStyle);
begin
  AStyle.ControllerChangedNotification(Self);
  if Assigned(FOnHintStyleChanged) then
    FOnHintStyleChanged(Self, AStyle);
end;

function TcxCustomHintStyleController.GetHintStyleClass: TcxHintStyleClass;
begin
  Result := TcxCustomHintStyle;
end;

function TcxCustomHintStyleController.GetHintWindowClass: TcxCustomHintWindowClass;
begin
  Result := TcxCustomHintWindow;
end;

procedure TcxCustomHintStyleController.InitHintWindowClass;
var
  AShowHint: Boolean;
begin
  AShowHint := Application.ShowHint;
  Application.ShowHint := False;
  FPreviousHintWindowClass := HintWindowClass;
  HintWindowClass := GetHintWindowClass;
  Application.ShowHint := AShowHint;
end;

procedure TcxCustomHintStyleController.RemoveListener(AListener: TcxCustomHintStyle);
begin
  if (AListener = nil) or (FListeners.IndexOf(AListener) < 0) then
    Exit;
  if not IsDestruction then
    FListeners.Remove(AListener);
end;

procedure TcxCustomHintStyleController.UninitHintWindowClass;
var
  AShowHint: Boolean;
begin
  if (FControllerList[FControllerList.Count - 1] = Self) and
    (HintWindowClass = GetHintWindowClass) then
  begin
    AShowHint := Application.ShowHint;
    Application.ShowHint := False;
    HintWindowClass := FPreviousHintWindowClass;
    Application.ShowHint := AShowHint;
  end;
end;

procedure TcxCustomHintStyleController.DoApplicationShowHint(var HintStr: string;
  var CanShow: Boolean; var HintInfo: THintInfo);
begin
  if Assigned(FSavedApplicationOnShowHint) then
    FSavedApplicationOnShowHint(HintStr, CanShow, HintInfo);
end;

procedure TcxCustomHintStyleController.DoShowHintEx(var AHintStr, AHintCaption: string;
  var ACanShow: Boolean; var AHintInfo: THintInfo);
begin
  if Assigned(FOnShowHintEx) then
    FOnShowHintEx(Self, AHintCaption, AHintStr, ACanShow, AHintInfo);
end;

procedure TcxCustomHintStyleController.DoShowHint(var AHintStr: string;
  var ACanShow: Boolean; var AHintInfo: THintInfo);
var
  AHintCaption: string;
begin
  if Assigned(FOnShowHint) then
    FOnShowHint(Self, AHintStr, ACanShow, AHintInfo);
  AHintCaption := '';
  DoShowHintEx(AHintStr, AHintCaption, ACanShow, AHintInfo);
  FHintWindow.Caption := AHintCaption;
  if ACanShow then
    DoApplicationShowHint(AHintStr, ACanShow, AHintInfo);
end;

function TcxCustomHintStyleController.IsGlobalStored: Boolean;
begin
  Result := (FControllerList.Count > 1) or not FGlobal;
end;

procedure TcxCustomHintStyleController.SetGlobal(Value: Boolean);

  procedure ResetGlobal;
  var
    I: Integer;
  begin
    for I := 0 to FControllerList.Count - 1 do
      TcxCustomHintStyleController(FControllerList[I]).FGlobal := False;
  end;

begin
  if FGlobal <> Value then
  begin
    if Value then
      ResetGlobal;
    FGlobal := Value;
  end;
end;

procedure TcxCustomHintStyleController.SetHintStyle(Value: TcxCustomHintStyle);
begin
  FHintStyle.Assign(Value);
end;

procedure TcxCustomHintStyleController.HintStyleChanged(Sender: TObject);
begin
  Changed;
end;

procedure TcxCustomHintStyleController.SetApplicationHintProperties;
begin
  if not (csDesigning in ComponentState) then
  begin
    Application.HintShortPause := FHintShortPause;
    Application.HintPause := FHintPause;
    Application.HintHidePause := FHintHidePause;
  end;
end;

procedure TcxCustomHintStyleController.SetHintShortPause(Value: Integer);
begin
  if FHintShortPause <> Value then
  begin
    FHintShortPause := Value;
    if FUpdateCount = 0 then
      SetApplicationHintProperties;
  end;
end;

procedure TcxCustomHintStyleController.SetHintPause(Value: Integer);
begin
  if FHintPause <> Value then
  begin
    FHintPause := Value;
    if FUpdateCount = 0 then
      SetApplicationHintProperties;
  end;
end;

procedure TcxCustomHintStyleController.SetHintHidePause(Value: Integer);
begin
  if FHintHidePause <> Value then
  begin
    FHintHidePause := Value;
    if FUpdateCount = 0 then
      SetApplicationHintProperties;
  end;
end;

procedure TcxCustomHintStyleController.SaveShowHintEvent;
begin
  if not (csDesigning in ComponentState) and not FIsApplicationOnShowHintSaved then
  begin
    FSavedApplicationOnShowHint := Application.OnShowHint;
    FIsApplicationOnShowHintSaved := True;
    Application.OnShowHint := ShowHintHandler;
  end;
end;

procedure TcxCustomHintStyleController.RestoreShowHintEvent;
begin
  if not (csDesigning in ComponentState) and (FControllerList.Count = 0) and
    FIsApplicationOnShowHintSaved then
      Application.OnShowHint := FSavedApplicationOnShowHint;
end;

procedure TcxCustomHintStyleController.ShowHintHandler(var HintStr: string;
  var CanShow: Boolean; var HintInfo: THintInfo);
var
  AController: TcxCustomHintStyleController;
begin
  SetHintedControl(HintInfo.HintControl);
  AController := FindHintController;
  if AController <> nil then
    AController.DoShowHint(HintStr, CanShow, HintInfo)
  else
    DoApplicationShowHint(HintStr, CanShow, HintInfo);
end;

{ TcxCustomHintWindow }

constructor TcxCustomHintWindow.Create(AOwner: TComponent);
begin
  inherited;
  FCallOutSize := 15;
  FCallOutPosition := cxbpNone;
  FCalculatedCallOutPos := cxbpNone;
  FCaption := '';
  Color := clInfoBk;
  FHintColor := clInfoBk;
  FBorderColor := clWindowFrame;
  FRounded := False;
  FRoundRadius := 11;
  FIconType := cxhiQuestion;
  FStandardHint := True;
  FWordWrap := True;
  FCaptionFont := TFont.Create;
  FCaptionFont.Assign(Font);
  FCaptionFont.Style := FCaptionFont.Style + [fsBold];
  FIcon := TIcon.Create;

  BorderStyle := bsSingle;
end;

destructor TcxCustomHintWindow.Destroy;
begin
  if Assigned(FIcon) then FreeAndNil(FIcon);
  FCaptionFont.Free;
  inherited;
end;

procedure TcxCustomHintWindow.SetIcon(Value: TIcon);
begin
  FIcon.Assign(Value);
end;

function TcxCustomHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string;
  AData: Pointer): TRect;
begin
  CalculateController;
  if not FStandardHint then
  begin
    FText := AHint;
    inherited Caption := AHint;
    CalculateIcon;
    CalculateRects(FCaption, FText, MaxWidth);
    Result := Rect(0, 0, FHintWndRect.Right, FHintWndRect.Bottom);
  end else
  begin
    Canvas.Font.Assign(Screen.HintFont);
    Result := inherited CalcHintRect(MaxWidth, AHint, AData);
  end;
end;

procedure TcxCustomHintWindow.ActivateHint(ARect: TRect; const AHint: string);
begin
  if not StandardHint then
  begin
    Inc(ARect.Bottom, 4);
    case FCalculatedCallOutPos of
      cxbpLeftBottom:
        OffsetRect(ARect, -1, - RectHeight(ARect) - 3);
      cxbpLeftTop:
        OffsetRect(ARect, 0, -(FCallOutSize * 2) - 6);
      cxbpTopLeft:
        OffsetRect(ARect, -FCallOutSize, 0);
      cxbpTopRight:
        OffsetRect(ARect, FCallOutSize - RectWidth(ARect), 0);
      cxbpRightBottom:
        OffsetRect(ARect, - RectWidth(ARect) + 3, - RectHeight(ARect) - 2);
      cxbpRightTop:
        OffsetRect(ARect, - RectWidth(ARect) + 1, -(FCallOutSize * 2) - 5);
      cxbpBottomRight:
        OffsetRect(ARect, - RectWidth(ARect) + FCallOutSize + 1, - RectHeight(ARect) - FCallOutSize - 1);
      cxbpBottomLeft:
        OffsetRect(ARect, - FCallOutSize - 1, - RectHeight(ARect) - FCallOutSize - 3);
    end;
  end;

  inherited;
end;

procedure TcxCustomHintWindow.WMShowWindow(var Message: TWMShowWindow);
begin
  inherited;
  if not Message.Show then
    SetHintedControl(nil);
end;

procedure TcxCustomHintWindow.Paint;
var
  ActualRgn: HRGN;
  FIconDrawSize: Integer;
  FIconDrawFlag: Integer;
begin
  if not FStandardHint then
  begin
    Canvas.Brush.Color := FHintColor;
    Canvas.FillRect(ClientRect);
    Canvas.Pen.Color := FBorderColor;
    Canvas.Pen.Style := psSolid;
    Canvas.Brush.Color := FBorderColor;
    Canvas.Brush.Style := bsSolid;

    ActualRgn := CreateRectRgnIndirect(Rect(0, 0, 0, 0));
    try
      GetWindowRgn(Handle, ActualRgn);
      OffsetRgn(ActualRgn, -1, -1);
      FrameRgn(Canvas.Handle, ActualRgn, Canvas.Brush.Handle, 1, 1);

      Canvas.Brush.Color := FHintColor;

      if not FIcon.Empty then
      begin
        FIconDrawFlag := DI_NORMAL;
        case IconSize of
          cxisLarge: FIconDrawSize := 32;
          cxisSmall: FIconDrawSize := 16;
          else
            FIconDrawSize := FIcon.Width;
        end;
        DrawIconEx(Canvas.Handle, FIconLeftMargin, FIconTopMargin, FIcon.Handle,
          FIconDrawSize, FIconDrawSize, 0, 0, FIconDrawFlag);
      end;
      if FCaption <> '' then
      begin
        Canvas.Font.Assign(FCaptionFont);
        DrawText(Canvas.Handle, PChar(FCaption),
          Length(FCaption), FCaptionRect,
          DT_WORDBREAK or DT_NOPREFIX or DT_VCENTER);
      end;
      Canvas.Font.Assign(Font);
      DrawText(Canvas.Handle, PChar(FText), Length(FText),
        FTextRect, DT_WORDBREAK or DT_NOPREFIX);
    finally
      DeleteObject(ActualRgn);
    end;
  end
  else
  begin
    DisableRegion;
    Canvas.Brush.Color := FHintColor;
    Canvas.FillRect(ClientRect);
{$IFDEF DELPHI5}
    Canvas.Font.Assign(Screen.HintFont);
{$ENDIF}
    inherited Paint;
  end;
end;

procedure TcxCustomHintWindow.CalculateController;

  procedure ResetToStandardHint;
  begin
    FStandardHint := True;
    FHintColor := Application.HintColor;
  end;

var
  AController: TcxCustomHintStyleController;
  AIHint: IcxHint;
begin
  if (GetHintedControl <> nil) and Supports(GetHintedControl, IcxHint, AIHint) then
  begin
    LoadPropertiesFromHintInterface(AIHint);
    Exit;
  end;
  AController := FindHintController;
  if AController <> nil then
    LoadPropertiesFromController(AController)
  else
    ResetToStandardHint;
end;

function TcxCustomHintWindow.GetAnimate: TcxHintAnimate;
begin
  Result := AnimationStyle;