tntjvspin.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

  if NewValue <> FMaxValue then
  begin
    b := not StoreCheckMaxValue;
    Z := (FMaxValue = 0) <> (NewValue = 0);
    FMaxValue := NewValue;
    if Z and FLCheckMaxValue then
    begin
      SetCheckMaxValue(CheckDefaultRange(True));
      if b and FLCheckMinValue then
        SetCheckMinValue(CheckDefaultRange(False));
    end;
    SetValue(Value);
  end;
end;

procedure TTntJvCustomSpinEdit.SetMinValue(NewValue: Extended);
var
  Z: Boolean;
  b: Boolean;
begin
  if NewValue <> FMinValue then
  begin
    b := not StoreCheckMinValue;
    Z := (FMinValue = 0) <> (NewValue = 0);
    FMinValue := NewValue;
    if Z and FLCheckMinValue then
    begin
      SetCheckMinValue(CheckDefaultRange(False));
      if b and FLCheckMaxValue then
        SetCheckMaxValue(CheckDefaultRange(True));
    end;
    SetValue(Value);
  end;
end;

procedure TTntJvCustomSpinEdit.SetThousands(Value: Boolean);
begin
  if ValueType <> vtHex then
    FThousands := Value;
end;

procedure TTntJvCustomSpinEdit.SetValueType(NewType: TValueType);
begin
  if FValueType <> NewType then
  begin
    FValueType := NewType;
    Value := GetValue;
    if FValueType in [{$IFDEF BCB} vtInt {$ELSE} vtInteger {$ENDIF}, vtHex] then
    begin
      FIncrement := Round(FIncrement);
      if FIncrement = 0 then
        FIncrement := 1;
    end;
    if FValueType = vtHex then
      Thousands := False;
  end;
end;

function TTntJvCustomSpinEdit.StoreCheckMaxValue: Boolean;
begin
  Result := (FMaxValue = 0) and (FCheckMaxValue = (FMinValue = 0));
end;

function TTntJvCustomSpinEdit.StoreCheckMinValue: Boolean;
begin
  Result := (FMinValue = 0) and (FCheckMinValue = (FMaxValue = 0));
end;

procedure TTntJvCustomSpinEdit.UpClick(Sender: TObject);
var
  OldText: string;
begin
  if ReadOnly then
    DoBeepOnError
  else
  begin
    FChanging := True;
    try
      OldText := inherited Text;
      Value := Value + FIncrement;
    finally
      FChanging := False;
    end;
    if AnsiCompareText(inherited Text, OldText) <> 0 then
    begin
      Modified := True;
      Change;
    end;
    if Assigned(FOnTopClick) then
      FOnTopClick(Self);
  end;
end;

procedure TTntJvCustomSpinEdit.UpDownClick(Sender: TObject; Button: TUDBtnType);
begin
  if TabStop and CanFocus then
    SetFocus;
  case Button of
    btNext:
      UpClick(Sender);
    btPrev:
      DownClick(Sender);
  end;
end;

//=== { TJvSpinButton } ======================================================

procedure TJvSpinButton.BottomClick;
begin
  if Assigned(FOnBottomClick) then
  begin
    FOnBottomClick(Self);
    if not (csLButtonDown in ControlState) then
      FDown := sbNotDown;
  end;
end;

procedure TJvSpinButton.CheckButtonBitmaps;
begin
  if Assigned(FButtonBitmaps) and
    ((TSpinButtonBitmaps(FButtonBitmaps).Height <> Height) or
     (TSpinButtonBitmaps(FButtonBitmaps).Width <> Width)) then
    RemoveButtonBitmaps;

  if FButtonBitmaps = nil then
  begin
    FButtonBitmaps := SpinButtonBitmapsManager.WantButtons(Width, Height, ButtonStyle,
      not FUpBitmap.Empty or not FDownBitmap.Empty);
    TSpinButtonBitmaps(FButtonBitmaps).AddClient;
  end;
end;

{$IFDEF VCL}
procedure TJvSpinButton.CMSysColorChange(var Msg: TMessage);
begin
  // The buttons we draw are buffered, thus we need to repaint them to theme changes etc.
  if FButtonBitmaps <> nil then
    TSpinButtonBitmaps(FButtonBitmaps).Reset;
end;
{$ENDIF VCL}

constructor TJvSpinButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FButtonStyle := sbsDefault;
  FUpBitmap := TBitmap.Create;
  FDownBitmap := TBitmap.Create;
  FUpBitmap.OnChange := GlyphChanged;
  FDownBitmap.OnChange := GlyphChanged;
  Height := 20;
  Width := 20;
  FLastDown := sbNotDown;
  FButtonBitmaps := nil;

  SpinButtonBitmapsManager.AddClient;
end;

destructor TJvSpinButton.Destroy;
begin
  RemoveButtonBitmaps;
  SpinButtonBitmapsManager.RemoveClient;

  FUpBitmap.Free;
  FDownBitmap.Free;
  FRepeatTimer.Free;
  inherited Destroy;
end;

function TJvSpinButton.GetDownGlyph: TBitmap;
begin
  Result := FDownBitmap;
end;

function TJvSpinButton.GetUpGlyph: TBitmap;
begin
  Result := FUpBitmap;
end;

procedure TJvSpinButton.GlyphChanged(Sender: TObject);
begin
  if Sender is TBitmap then
  (Sender as TBitmap).Transparent := True;
  RemoveButtonBitmaps;
  Invalidate;
end;

procedure TJvSpinButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and Enabled then
  begin
    if (FFocusControl <> nil) and FFocusControl.TabStop and
      FFocusControl.CanFocus and (GetFocus <> FFocusControl.Handle) then
      FFocusControl.SetFocus;
    if FDown = sbNotDown then
    begin
      FLastDown := FDown;
      //>Polaris
      if ((FButtonStyle = sbsDefault) and (Y > (-(Height / Width) * X + Height))) or
        ((FButtonStyle = sbsClassic) and (Y > (Height div 2))) then
      begin
        FDown := sbBottomDown;
        BottomClick;
      end
      else
      begin
        FDown := sbTopDown;
        TopClick;
      end;
      if FLastDown <> FDown then
      begin
        FLastDown := FDown;
        Repaint;
      end;
      if FRepeatTimer = nil then
        FRepeatTimer := TTimer.Create(Self);
      FRepeatTimer.OnTimer := TimerExpired;
      FRepeatTimer.Interval := InitRepeatPause;
      FRepeatTimer.Enabled := True;
    end;
    FDragging := True;
  end;
end;

{$IFDEF JVCLThemesEnabled}
procedure TJvSpinButton.MouseEnter(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  { (rb) only themed spin buttons have hot states, so it's not necessairy
         to calc FMouseInBottomBtn and FMouseInTopBtn for non-themed apps }
  if not FMouseInTopBtn and not FMouseInBottomBtn then
  begin
    if MouseInBottomBtn(ScreenToClient(Mouse.CursorPos)) then
      FMouseInBottomBtn := True
    else
      FMouseInTopBtn := True;
    if ThemeServices.ThemesEnabled then
      Repaint;
    inherited MouseEnter(Control);
  end;
end;
{$ENDIF JVCLThemesEnabled}

function TJvSpinButton.MouseInBottomBtn(const P: TPoint): Boolean;
begin
  with P do
    Result :=
      ((FButtonStyle = sbsDefault)) and (Y > (-(Width / Height) * X + Height)) or
      ((FButtonStyle = sbsClassic) and (Y > (Height div 2)));
end;

{$IFDEF JVCLThemesEnabled}
procedure TJvSpinButton.MouseLeave(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if FMouseInTopBtn or FMouseInBottomBtn then
  begin
    FMouseInTopBtn := False;
    FMouseInBottomBtn := False;
    if ThemeServices.ThemesEnabled then
      Repaint;
    inherited MouseLeave(Control);
  end;
end;
{$ENDIF JVCLThemesEnabled}

procedure TJvSpinButton.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  NewState: TSpinButtonState;
begin
  inherited MouseMove(Shift, X, Y);
  if FDragging then
  begin
    if (X >= 0) and (X <= Width) and (Y >= 0) and (Y <= Height) then
    begin
      NewState := FDown;
      //>Polaris
      if MouseInBottomBtn(Point(X, Y)) then
      begin
        if FDown <> sbBottomDown then
        begin
          if FLastDown = sbBottomDown then
            FDown := sbBottomDown
          else
            FDown := sbNotDown;
          if NewState <> FDown then
            Repaint;
        end;
      end
      else
      begin
        if FDown <> sbTopDown then
        begin
          if FLastDown = sbTopDown then
            FDown := sbTopDown
          else
            FDown := sbNotDown;
          if NewState <> FDown then
            Repaint;
        end;
      end;
    end
    else
    if FDown <> sbNotDown then
    begin
      FDown := sbNotDown;
      Repaint;
    end;
  end
  {$IFDEF JVCLThemesEnabled}
  else
  if (FMouseInTopBtn or FMouseInBottomBtn) and ThemeServices.ThemesEnabled then
  begin
    if MouseInBottomBtn(Point(X, Y)) then
    begin
      if not FMouseInBottomBtn then
      begin
        FMouseInTopBtn := False;
        FMouseInBottomBtn := True;
        Repaint;
      end;
    end
    else
    begin
      if not FMouseInTopBtn then
      begin
        FMouseInTopBtn := True;
        FMouseInBottomBtn := False;
        Repaint;
      end;
    end;
  end;
  {$ENDIF JVCLThemesEnabled}
end;

procedure TJvSpinButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FDragging then
  begin
    FDragging := False;
    if (X >= 0) and (X <= Width) and (Y >= 0) and (Y <= Height) then
    begin
      FDown := sbNotDown;
      FLastDown := sbNotDown;
      Repaint;
    end;
  end;
end;

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

procedure TJvSpinButton.Paint;
begin
  CheckButtonBitmaps;

  if not Enabled and not (csDesigning in ComponentState) then
    FDragging := False;

  {$IFDEF JVCLThemesEnabled}
  TSpinButtonBitmaps(FButtonBitmaps).Draw(Canvas, FDown, Enabled, FMouseInTopBtn, FMouseInBottomBtn);
  {$ELSE}
  TSpinButtonBitmaps(FButtonBitmaps).Draw(Canvas, FDown, Enabled, False, False);
  {$ENDIF JVCLThemesEnabled}
  if not FUpBitmap.Empty or not FDownBitmap.Empty then
    TSpinButtonBitmaps(FButtonBitmaps).DrawGlyphs(Canvas, FDown, Enabled, FUpBitmap, FDownBitmap);
end;

procedure TJvSpinButton.RemoveButtonBitmaps;
begin
  if Assigned(FButtonBitmaps) then
  begin
    TSpinButtonBitmaps(FButtonBitmaps).RemoveClient;
    FButtonBitmaps := nil;
  end;
end;

procedure TJvSpinButton.SetButtonStyle(Value: TJvSpinButtonStyle);
begin
  if Value <> FButtonStyle then
  begin
    FButtonStyle := Value;
    GlyphChanged(Self);
  end;
end;

procedure TJvSpinButton.SetDown(Value: TSpinButtonState);
var
  OldState: TSpinButtonState;
begin
  OldState := FDown;
  FDown := Value;
  if OldState <> FDown then
    Repaint;
end;

procedure TJvSpinButton.SetDownGlyph(Value: TBitmap);
begin
  if Value <> nil then
    FDownBitmap.Assign(Value)
  else
    FDownBitmap.Handle := NullHandle;
end;

procedure TJvSpinButton.SetFocusControl(Value: TWinControl);
begin
  FFocusControl := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

procedure TJvSpinButton.SetUpGlyph(Value: TBitmap);
begin
  if Value <> nil then
    FUpBitmap.Assign(Value)
  else
    FUpBitmap.Handle := NullHandle;
end;

procedure TJvSpinButton.TimerExpired(Sender: TObject);
begin
  FRepeatTimer.Interval := RepeatPause;
  if (FDown <> sbNotDown) and MouseCapture then
  begin
    try
      if FDown = sbBottomDown then
        BottomClick
      else
        TopClick;
    except
      FRepeatTimer.Enabled := False;
      raise;
    end;
  end;
end;

procedure TJvSpinButton.TopClick;
begin
  if Assigned(FOnTopClick) then
  begin
    FOnTopClick(Self);
    if not (csLButtonDown in ControlState) then
      FDown := sbNotDown;
  end;
end;

//=== { TTntJvSpinEdit } ========================================================

// (rom) quite unusual not to have it in the Custom base class

constructor TTntJvSpinEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Text := '0';
end;

function TTntJvSpinEdit.GetValue: Extended;