tntjvspin.pas

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

procedure TTntJvCustomSpinEdit.EnabledChanged;
begin
  inherited EnabledChanged;
  if FUpDown <> nil then
  begin
    FUpDown.Enabled := Enabled;
    ResizeButton;
  end;
  if FButton <> nil then
    FButton.Enabled := Enabled;
end;

procedure TTntJvCustomSpinEdit.FontChanged;
begin
  inherited FontChanged;
  ResizeButton;
  SetEditRect;
end;

{function TTntJvCustomSpinEdit.TryGetValue(var Value: Extended): Boolean;
var
  S: string;
begin
  try
    S := StringReplace(Text, ThousandSeparator, '', [rfReplaceAll]);
    if ValueType = vtFloat then
      Value := StrToFloat(S)
    else
      if ValueType = vtHex then
        Value := StrToInt('$' + Text)
      else
        Value := StrToInt(S);
    Result := True;
  except
    if ValueType = vtFloat then
      Value := FMinValue
    else
      Value := Trunc(FMinValue);
    Result := False;
  end;
end;}

function TTntJvCustomSpinEdit.GetAsInteger: Longint;
begin
  Result := Trunc(GetValue);
end;

function TTntJvCustomSpinEdit.GetButtonKind: TSpinButtonKind;
begin
  if NewStyleControls then
    Result := FButtonKind
      //>Polaris
  else
  begin
    Result := bkDiagonal;
    if Assigned(FButton) and (FButton.ButtonStyle = sbsClassic) then
      Result := bkClassic;
  end;
  //<Polaris
end;

function TTntJvCustomSpinEdit.GetButtonWidth: Integer;
begin
  if ShowButton then
  begin
    if FUpDown <> nil then
      Result := FUpDown.Width
    else
    if FButton <> nil then
      Result := FButton.Width
    else
      Result := DefBtnWidth;
  end
  else
    Result := 0;
end;

function TTntJvCustomSpinEdit.GetMinHeight: Integer;
var
  I, H: Integer;
begin
  GetTextHeight(I, H);
  if I > H then
    I := H;
  Result := H + (GetSystemMetrics(SM_CYBORDER) * 4) + 1;
end;

procedure TTntJvCustomSpinEdit.GetTextHeight(var SysHeight, Height: Integer);
var
  DC: HDC;
  SaveFont: HFONT;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(HWND_DESKTOP);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(HWND_DESKTOP, DC);
  SysHeight := SysMetrics.tmHeight;
  Height := Metrics.tmHeight;
end;

function TTntJvCustomSpinEdit.IsFormatStored: Boolean;
begin
  Result := DisplayFormat <> DefaultDisplayFormat;
end;

function TTntJvCustomSpinEdit.IsIncrementStored: Boolean;
begin
  Result := FIncrement <> 1.0;
end;

function TTntJvCustomSpinEdit.IsMaxStored: Boolean;
begin
  Result := MaxValue <> 0.0;
end;

function TTntJvCustomSpinEdit.IsMinStored: Boolean;
begin
  Result := MinValue <> 0.0;
end;

function TTntJvCustomSpinEdit.IsValidChar(Key: Char): Boolean;
var
  ValidChars: set of Char;
begin
  ValidChars := DigitChars + ['+', '-'];
  if ValueType = vtFloat then
  begin
    if Pos(DecimalSeparator, Text) = 0 then
    begin
      if not Thousands or (ThousandSeparator <> '.') then
        ValidChars := ValidChars + [DecimalSeparator, '.'] // Polaris
      else
        ValidChars := ValidChars + [DecimalSeparator];
    end;
    if Pos('E', AnsiUpperCase(Text)) = 0 then
      ValidChars := ValidChars + ['e', 'E'];
  end
  else
  if ValueType = vtHex then
  begin
    ValidChars := ValidChars + ['A'..'F', 'a'..'f'];
  end;
  Result := (Key in ValidChars) or (Key < #32);
  if not FEditorEnabled and Result and ((Key >= #32) or
    (Key = BackSpace) or (Key = Del)) then
    Result := False;
end;

function TTntJvCustomSpinEdit.IsValueStored: Boolean;
begin
  Result := GetValue <> 0.0;
end;

procedure TTntJvCustomSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if ArrowKeys and ((Key = VK_UP) or (Key = VK_DOWN)) then
  begin
    if Key = VK_UP then
      UpClick(Self)
    else
    if Key = VK_DOWN then
      DownClick(Self);
    Key := 0;
  end;
end;

procedure TTntJvCustomSpinEdit.KeyPress(var Key: Char);
var
  I: Integer;
begin
  // andreas
  if (Key = DecimalSeparator) and (ValueType = vtFloat) then
  begin
    { If the key is the decimal separator move the caret behind it. }
    I := Pos(DecimalSeparator, Text);
    if I <> 0 then
    begin
      Key := #0;
      SelLength := 0;
      SelStart := I;
      Exit;
    end;
  end;

  if not IsValidChar(Key) then
  begin
    Key := #0;
    DoBeepOnError;
  end;
  //Polaris
  if (Key = '.') and (not Thousands or (ThousandSeparator <> '.')) then
    Key := DecimalSeparator;

  if Key <> #0 then
  begin
    inherited KeyPress(Key);
    if (Key = Cr) or (Key = Esc) then
    begin
      { must catch and remove this, since is actually multi-line }
      {$IFDEF VCL}
      GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      THackedCustomForm(GetParentForm(Self)).WantKey(Integer(Key), [], Key);
      {$ENDIF VisualCLX}
      if Key = Cr then
        Key := #0;
    end;
  end;
end;

procedure TTntJvCustomSpinEdit.Loaded;
begin
  inherited Loaded;
  FLCheckMinValue := True;
  FLCheckMaxValue := True;
  FOldValue := Value;
end;

procedure TTntJvCustomSpinEdit.RecreateButton;
begin
  if csDestroying in ComponentState then
    Exit;
  FButton.Free;
  FButton := nil;
  FBtnWindow.Free;
  FBtnWindow := nil;
  FUpDown.Free;
  FUpDown := nil;
  if ShowButton then
    if GetButtonKind = bkStandard then
    begin
      FUpDown := TJvUpDown.Create(Self);
      with TJvUpDown(FUpDown) do
      begin
        Visible := True;
        //Polaris
        SetBounds(0, 1, DefBtnWidth, Self.Height);
        if BiDiMode = bdRightToLeft then
          Align := alLeft
        else
          Align := alRight;
        {$IFDEF VCL}
        Parent := Self;
        {$ENDIF VCL}
        {$IFDEF VisualCLX}
        Parent := Self.ClientArea;
        {$ENDIF VisualCLX}
        OnClick := UpDownClick;
      end;
    end
    else
    begin
      FBtnWindow := TWinControl.Create(Self);
      FBtnWindow.Visible := True;
      {$IFDEF VCL}
      FBtnWindow.Parent := Self;
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      FBtnWindow.Parent := Self.ClientArea;
      {$ENDIF VisualCLX}
      if FButtonKind <> bkClassic then
        FBtnWindow.SetBounds(0, 0, DefBtnWidth, Height)
      else
        FBtnWindow.SetBounds(0, 0, Height, Height);
      {$IFDEF VisualCLX}
      FBtnWindow.Align := alRight;
      {$ENDIF VisualCLX}
      FButton := TJvSpinButton.Create(Self);
      FButton.Visible := True;
      if FButtonKind = bkClassic then
        FButton.FButtonStyle := sbsClassic;
      FButton.Parent := FBtnWindow;
      FButton.FocusControl := Self;
      FButton.OnTopClick := UpClick;
      FButton.OnBottomClick := DownClick;
      //Polaris
      FButton.SetBounds(1, 1, FBtnWindow.Width - 1, FBtnWindow.Height - 1);
    end;
end;

procedure TTntJvCustomSpinEdit.ResizeButton;
var
  R: TRect;
begin
  if FUpDown <> nil then
  begin
    FUpDown.Width := DefBtnWidth;
    if BiDiMode = bdRightToLeft then
      FUpDown.Align := alLeft
    else
      FUpDown.Align := alRight;
  end
  else
  if FButton <> nil then
  begin { bkDiagonal }
    if NewStyleControls and {$IFDEF VCL} Ctl3D and {$ENDIF} (BorderStyle = bsSingle) then
      if FButtonKind = bkClassic then
        R := Bounds(Width - DefBtnWidth - 4, -1, DefBtnWidth, Height - 3)
      else
        R := Bounds(Width - Height - 1, -1, Height - 3, Height - 3)
    else
      if FButtonKind = bkClassic then
      R := Bounds(Width - DefBtnWidth, 0, DefBtnWidth, Height)
    else
      R := Bounds(Width - Height, 0, Height, Height);
    if BiDiMode = bdRightToLeft then
    begin
      if NewStyleControls and {$IFDEF VCL} Ctl3D and {$ENDIF} (BorderStyle = bsSingle) then
      begin
        R.Left := -1;
        R.Right := Height - 4;
      end
      else
      begin
        R.Left := 0;
        R.Right := Height;
      end;
    end;
    with R do
      FBtnWindow.SetBounds(Left, Top, Right - Left, Bottom - Top);
    {$IFDEF VisualCLX}
    if BiDiMode = bdRightToLeft then
      FBtnWindow.Align := alLeft
    else
      FBtnWindow.Align := alRight;
    {$ENDIF VisualCLX}
    //Polaris
    FButton.SetBounds(1, 1, FBtnWindow.Width - 1, FBtnWindow.Height - 1);
  end;
end;

procedure TTntJvCustomSpinEdit.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    {$IFDEF VCL}
    RecreateWnd;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    Invalidate;
    {$ENDIF VisualCLX}
  end;
end;

procedure TTntJvCustomSpinEdit.SetArrowKeys(Value: Boolean);
begin
  FArrowKeys := Value;
  ResizeButton;
end;

procedure TTntJvCustomSpinEdit.SetAsInteger(NewValue: Longint);
begin
  SetValue(NewValue);
end;

procedure TTntJvCustomSpinEdit.SetButtonKind(Value: TSpinButtonKind);
var
  OldKind: TSpinButtonKind;
begin
  OldKind := FButtonKind;
  FButtonKind := Value;
  if OldKind <> GetButtonKind then
  begin
    RecreateButton;
    ResizeButton;
    SetEditRect;
  end;
end;

procedure TTntJvCustomSpinEdit.SetCheckMaxValue(NewValue: Boolean);
begin
  if FMaxValue <> 0 then
    NewValue := True;
  FCheckMaxValue := NewValue;
  if csLoading in ComponentState then
    FLCheckMaxValue := False;
  SetValue(Value);
end;

procedure TTntJvCustomSpinEdit.SetCheckMinValue(NewValue: Boolean);
begin
  if FMinValue <> 0 then
    NewValue := True;
  FCheckMinValue := NewValue;
  if csLoading in ComponentState then
    FLCheckMinValue := False;
  SetValue(Value);
end;

procedure TTntJvCustomSpinEdit.SetShowButton(Value: Boolean);
begin
  if FShowButton <> Value then
  begin
    FShowButton := Value;
    RecreateButton;
    ResizeButton;
    SetEditRect;
  end;
end;

procedure TTntJvCustomSpinEdit.SetDecimal(NewValue: Byte);
begin
  if FDecimal <> NewValue then
  begin
    FDecimal := NewValue;
    Value := GetValue;
  end;
end;

procedure TTntJvCustomSpinEdit.SetDisplayFormat(const Value: string);
begin
  if DisplayFormat <> Value then
  begin
    FDisplayFormat := Value;
    Invalidate;
  end;
end;

procedure TTntJvCustomSpinEdit.SetEditRect;
var
  Loc: TRect;
begin
  //Polaris
  if BiDiMode = bdRightToLeft then
  begin
    SetRect(Loc, GetButtonWidth + 1, 0, ClientWidth - 1, ClientHeight + 1);
    {$IFDEF VCL}
    SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN, MakeLong(GetButtonWidth, 0));
    {$ENDIF VCL}
  end
  else
  begin
    SetRect(Loc, 0, 0, ClientWidth - GetButtonWidth - 2, ClientHeight + 1);
    {$IFDEF VCL}
    SendMessage(Handle, EM_SETMARGINS, EC_RIGHTMARGIN, MakeLong(0, GetButtonWidth));
    {$ENDIF VCL}
  end;
  {$IFDEF VCL}
  SendMessage(Handle, EM_SETRECTNP, 0, Longint(@Loc));
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  SetEditorRect(@Loc);
  {$ENDIF VisualCLX}
end;

procedure TTntJvCustomSpinEdit.SetFocused(Value: Boolean);
begin
  if Value <> FFocused then
  begin
    FFocused := Value;
    Invalidate;
    DataChanged;
  end;
end;

procedure TTntJvCustomSpinEdit.SetMaxValue(NewValue: Extended);
var
  Z: Boolean;
  b: Boolean;
begin