cxhint.pas

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

      if Result = nil then
        Result := GetWindowParent(AWnd);
    end;
  end;
end;

function GetHintedControl: TControl;
begin
  if FHintedControlController <> nil then
    Result := FHintedControlController.HintedControl
  else
    Result := nil;
end;

function GetWindowParent(AWnd: HWND): TWinControl;
begin
  Result := nil;
  while (Result = nil) and (AWnd <> 0) and IsChildClassWindow(AWnd) do
  begin
    AWnd := GetParent(AWnd);
    Result := FindControl(AWnd);
  end;
end;

procedure SetHintedControl(Value: TControl);
begin
  if FHintedControlController <> nil then
    FHintedControlController.HintedControl := Value;
end;

{ TcxHintedControlController }

destructor TcxHintedControlController.Destroy;
begin
  HintedControl := nil;
  inherited Destroy;
end;

procedure TcxHintedControlController.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FHintedControl) then
    HintedControl := nil;
end;

procedure TcxHintedControlController.SetHintedControl(Value: TControl);
begin
  if Value <> FHintedControl then
  begin
    if FHintedControl <> nil then
      FHintedControl.RemoveFreeNotification(Self);
    FHintedControl := Value;
    if FHintedControl <> nil then
      FHintedControl.FreeNotification(Self);
  end;
end;

{ TcxCustomHintStyle }

constructor TcxCustomHintStyle.Create(AOwner: TPersistent; ADirectAccessMode: Boolean);
begin
  inherited Create;
  FOwner := AOwner;
  FDirectAccessMode := ADirectAccessMode;
  FFont := TFont.Create;
  FCaptionFont := TFont.Create;
  FIcon := TIcon.Create;
  FIcon.OnChange := IconChangeHandler;
  FModified := False;
  InternalRestoreDefault;
  HintStyleController := GetDefaultHintStyleController;
end;

destructor TcxCustomHintStyle.Destroy;
begin
  FIsDestroying := True;
  if FHintStyleController <> nil then
    FHintStyleController.RemoveListener(Self);
  FreeAndNil(FIcon);
  FreeAndNil(FCaptionFont);
  FreeAndNil(FFont);
  inherited Destroy;
end;

procedure TcxCustomHintStyle.Assign(Source: TPersistent);
begin
  if (Source is TcxCustomHintStyle) then
  begin
    BeginUpdate;
    try
      with (Source as TcxCustomHintStyle) do
      begin
        Self.Animate := Animate;
        Self.AnimationDelay := AnimationDelay;
        Self.BorderColor := BorderColor;
        Self.CallOutPosition := CallOutPosition;
        Self.CaptionFont.Assign(CaptionFont);
        Self.Color := Color;
        Self.HintStyleController := HintStyleController;
        Self.IconSize := IconSize;
        Self.IconType := IconType;
        Self.Rounded := Rounded;
        Self.RoundRadius := RoundRadius;
        Self.Standard := Standard;
        Self.Font.Assign(Font);
        Self.CaptionFont.Assign(CaptionFont);
        Self.Icon.Assign(Icon);
      end;
    finally
      EndUpdate;
    end
  end
  else
    inherited Assign(Source);
end;

procedure TcxCustomHintStyle.InternalRestoreDefault;
var
  FRestoreFont: TFont;
begin
  FAnimate := cxhaAuto;
  FAnimationDelay := 100;
  FBorderColor := clWindowFrame;
  FCallOutPosition := cxbpNone;
  FColor := clInfoBk;
  FIconSize := cxisDefault;
  FIconType := cxhiNone;
  FRounded := False;
  FRoundRadius := 11;
  FStandard := False;
  FRestoreFont := TFont.Create;
  try
    FFont.Assign(FRestoreFont);
    FCaptionFont.Assign(FRestoreFont);
  finally
    FreeAndNil(FRestoreFont);
  end;
end;

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

procedure TcxCustomHintStyle.EndUpdate;
begin
  if FUpdateCount <> 0 then
  begin
    Dec(FUpdateCount);
    if FModified then
      Changed;
  end;
end;

class function TcxCustomHintStyle.GetDefaultHintStyleController: TcxCustomHintStyleController;
begin
  Result := nil;
end;

procedure TcxCustomHintStyle.RestoreDefaults;
begin
  BeginUpdate;
  try
    InternalRestoreDefault;
  finally
    EndUpdate;
  end;
end;

function TcxCustomHintStyle.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TcxCustomHintStyle.BaseGetHintStyleController: TcxCustomHintStyleController;
begin
  if FHintStyleController = GetDefaultHintStyleController then
    Result := nil
  else
    Result := FHintStyleController;
end;

procedure TcxCustomHintStyle.BaseSetHintStyleController(Value: TcxCustomHintStyleController);

  function CheckHintStyleController(AHintStyleController: TcxCustomHintStyleController): Boolean;
  var
    AOwner: TPersistent;
  begin
    Result := False;
    AOwner := GetOwner;
    while AOwner <> nil do
    begin
      if (AOwner is TcxCustomHintStyleController) and (AOwner = AHintStyleController) then
        Exit;
      AOwner := GetPersistentOwner(AOwner);
    end;
    Result := True;
  end;

begin
  if Value = nil then
    Value := GetDefaultHintStyleController;

  if (Value <> nil) and (not CheckHintStyleController(Value)) then Exit;

  if Value <> FHintStyleController then
  begin
    if FHintStyleController <> nil then
      FHintStyleController.RemoveListener(Self);
    FHintStyleController := Value;
    if FHintStyleController <> nil then
      FHintStyleController.AddListener(Self);
    HintStyleControllerChanged;
  end;
end;

procedure TcxCustomHintStyle.Changed;
begin
  if FUpdateCount = 0 then
  begin
    if not DirectAccessMode and Assigned(FOnChanged) and not IsDestroying then
      FOnChanged(Self);
    FModified := False;
  end
  else
    FModified := True;
end;

procedure TcxCustomHintStyle.ControllerChangedNotification(AStyleController: TcxCustomHintStyleController);
begin
  Changed;
end;

procedure TcxCustomHintStyle.ControllerFreeNotification(AHintStyleController: TcxCustomHintStyleController);
begin
  if (AHintStyleController <> nil) and (AHintStyleController = FHintStyleController) then
    HintStyleController := nil;
end;

procedure TcxCustomHintStyle.HintStyleControllerChanged;
begin
  Changed;
end;

function TcxCustomHintStyle.GetControl: TcxControl;
begin
  Result := TcxControl(FOwner);
end;

function TcxCustomHintStyle.GetFont: TFont;
begin
  Result := FFont;
end;

procedure TcxCustomHintStyle.SetAnimate(Value: TcxHintAnimate);
begin
  if Value <> FAnimate then
  begin
    FAnimate := Value;
    Changed;
  end;
end;

procedure TcxCustomHintStyle.SetAnimationDelay(Value: TcxHintAnimationDelay);
begin
  if Value <> FAnimationDelay then
  begin
    FAnimationDelay := Value;
    Changed;
  end;
end;

procedure TcxCustomHintStyle.SetCallOutPosition(Value: TcxCallOutPosition);
begin
  if Value <> FCallOutPosition then
  begin
    FCallOutPosition := Value;
    Changed;
  end;
end;

procedure TcxCustomHintStyle.SetBorderColor(Value: TColor);
begin
  if Value <> FBorderColor then
  begin
    FBorderColor := Value;
    Changed;
  end;
end;

procedure TcxCustomHintStyle.SetColor(Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Changed;
  end;
end;

procedure TcxCustomHintStyle.SetCaptionFont(Value: TFont);
begin
  FCaptionFont.Assign(Value);
  Changed;
end;

procedure TcxCustomHintStyle.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
  Changed;
end;

procedure TcxCustomHintStyle.SetIconSize(Value: TcxHintIconSize);
begin
  if FIconSize <> Value then
  begin
    FIconSize := Value;
    Changed;
  end;
end;

procedure TcxCustomHintStyle.SetIconType(Value: TcxHintIconType);
begin
  if FIconType <> Value then
  begin
    FIconType := Value;
    Changed;
  end;
end;

procedure TcxCustomHintStyle.SetIcon(Value: TIcon);
begin
  if FIcon <> Value then
  begin
    FIcon.Assign(Value);
    Changed;
  end;
end;

procedure TcxCustomHintStyle.SetRounded(Value: Boolean);
begin
  if FRounded <> Value then
  begin
    FRounded := Value;
    Changed;
  end;
end;

procedure TcxCustomHintStyle.SetRoundRadius(Value: Integer);
begin
  if FRoundRadius <> Value then
  begin
    FRoundRadius := Value;
    Changed;
  end;
end;

procedure TcxCustomHintStyle.SetStandard(Value: Boolean);
begin
  if FStandard <> Value then
  begin
    FStandard := Value;
    Changed;
  end;
end;

procedure TcxCustomHintStyle.IconChangeHandler(Sender: TObject);
begin
  Changed;
end;

{ TcxCustomHintStyleController }

constructor TcxCustomHintStyleController.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FUpdateCount := 0;
  FActive := True;
  FHintShortPause := 50;
  FHintPause := 500;
  FHintHidePause :=2500;
  FListeners := TList.Create;
  FHintStyle := GetHintStyleClass.Create(Self, False);
  FHintStyle.OnChanged := HintStyleChanged;
  FHintWindow := GetHintWindowClass.Create(Self);
  if FControllerList.Count = 0 then
    FGlobal := True;
  FControllerList.Add(Self);
  if not (csDesigning in ComponentState) then
    InitHintWindowClass;
end;

destructor TcxCustomHintStyleController.Destroy;
var
  I: Integer;
begin
  FIsDestruction := True;
  if not (csDesigning in ComponentState) then
    UninitHintWindowClass;
  FControllerList.Remove(Self);
  for I := 0 to FListeners.Count - 1 do
    TcxCustomHintStyle(FListeners[I]).ControllerFreeNotification(Self);
  FreeAndNil(FHintStyle);
  FreeAndNil(FListeners);
  FreeAndNil(FHintWindow);
  RestoreShowHintEvent;
  inherited Destroy;
end;

procedure TcxCustomHintStyleController.Assign(Source: TPersistent);
begin
  if (Source is TcxCustomHintStyleController) then
  begin
    BeginUpdate;
    try
      with (Source as TcxCustomHintStyleController) do
      begin
        Self.OnHintStyleChanged := OnHintStyleChanged;
        Self.OnShowHint := OnShowHint;
        Self.OnShowHintEx := OnShowHintEx;
        Self.HintShortPause := HintShortPause;
        Self.HintPause := HintPause;
        Self.HintHidePause := HintHidePause;
        Self.HintStyle := HintStyle;
      end;
    finally
      EndUpdate;
    end
  end
  else
    inherited Assign(Source);
end;

procedure TcxCustomHintStyleController.ShowHint(X, Y: Integer; ACaption, AHint: string; AMaxWidth: Integer = 0);
var
  R: TRect;
begin
  SetHintedControl(FindVCLWindow(Point(X, Y)));
  FHintWindow.FCaption := ACaption;
  if AMaxWidth = 0 then
    AMaxWidth := Screen.Width;
  R := FHintWindow.CalcHintRect(AMaxWidth, AHint, nil);
  OffsetRect(R, X, Y);
  FHintWindow.ActivateHint(R, AHint);
end;

{ Q100672
var