jvqspin.pas

East make Tray Icon in delphi

//=== { TJvCustomSpinEdit } ==================================================

procedure TJvCustomSpinEdit.Change;
var
  //  OldText: string;
  OldSelStart: Integer;
begin
  { (rb) Maybe move to CMTextChanged }
  if FChanging or not HandleAllocated then
    Exit;

  FChanging := True;
  try
    //    OldText := inherited Text;
    OldSelStart := SelStart;
    try
      if not (csDesigning in ComponentState) and (coCheckOnChange in CheckOptions) then
      begin
        CheckValueRange(Value, not (coCropBeyondLimit in CheckOptions));
        SetValue(CheckValue(Value));
      end;
    except
      SetValue(CheckValue(Value));
    end;
  finally
    FChanging := False;
  end;
  if FOldValue <> Value then
  begin
    inherited Change;
    FOldValue := Value;
  end;
  //  if AnsiCompareText(inherited Text, OldText) <> 0 then
  //    inherited Change;

  SelStart := OldSelStart;
end;

function TJvCustomSpinEdit.CheckDefaultRange(CheckMax: Boolean): Boolean;
begin
  Result := (FMinValue <> 0) or (FMaxValue <> 0);
end;

function TJvCustomSpinEdit.CheckValue(NewValue: Extended): Extended;
begin
  Result := NewValue;
  {
    if (FMaxValue <> FMinValue) then
    begin
      if NewValue < FMinValue then
        Result := FMinValue
      else
      if NewValue > FMaxValue then
        Result := FMaxValue;
    end;
  }
  if FCheckMinValue or FCheckMaxValue then
  begin
    if FCheckMinValue and (NewValue < FMinValue) then
      Result := FMinValue;
    if FCheckMaxValue and (NewValue > FMaxValue) then
      Result := FMaxValue;
  end;
end;

function TJvCustomSpinEdit.CheckValueRange(NewValue: Extended; RaiseOnError: Boolean): Extended;
begin
  Result := CheckValue(NewValue);
  if (FCheckMinValue or FCheckMaxValue) and
    RaiseOnError and (Result <> NewValue) then
    raise ERangeError.CreateResFmt(@RsEOutOfRangeFloat, [FMinValue, FMaxValue]);
end;



constructor TJvCustomSpinEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FThousands := False; //new

  //Polaris
  FFocused := False;
  FCheckOptions := [coCheckOnChange, coCheckOnExit, coCropBeyondLimit];
  FLCheckMinValue := True;
  FLCheckMaxValue := True;
  FCheckMinValue := False;
  FCheckMaxValue := False;
  //Polaris
  ControlStyle := ControlStyle - [csSetCaption];
  FIncrement := 1.0;
  FDecimal := 2;
  FEditorEnabled := True;
  FButtonKind := bkDiagonal;
  FArrowKeys := True;
  FShowButton := True;
  RecreateButton;
end;



procedure TJvCustomSpinEdit.DataChanged;
var
  EditFormat: string;
  WasModified: Boolean;
begin
  if (ValueType = vtFloat) and FFocused and (FDisplayFormat <> '') then
  begin
    EditFormat := '0';
    if FDecimal > 0 then
      EditFormat := EditFormat + '.' + MakeStr('#', FDecimal);
    { Changing EditText sets Modified to false }
    WasModified := Modified;
    try
      Text := FormatFloat(EditFormat, Value);
    finally
      Modified := WasModified;
    end;
  end;
end;

function TJvCustomSpinEdit.DefaultDisplayFormat: string;
begin
  Result := ',0.##';
end;

destructor TJvCustomSpinEdit.Destroy;
begin
  Destroying;
  FChanging := True;
  if FButton <> nil then
  begin
    FButton.Free;
    FButton := nil;
    FBtnWindow.Free;
    FBtnWindow := nil;
  end;
  if FUpDown <> nil then
  begin
    FUpDown.Free;
    FUpDown := nil;
  end;
  inherited Destroy;
end;

procedure TJvCustomSpinEdit.BoundsChanged;
var
  MinHeight: Integer;
begin
  MinHeight := GetMinHeight;
  { text edit bug: if size to less than minheight, then edit ctrl does
    not display the text }
  if Height < MinHeight then
    Height := MinHeight
  else
  begin
    ResizeButton;
    SetEditRect;
    inherited BoundsChanged;
  end;
end;

procedure TJvCustomSpinEdit.WMCut(var Mesg: TMessage);
begin
  if FEditorEnabled then
    inherited;
end;

procedure TJvCustomSpinEdit.WMPaste(var Mesg: TMessage);
begin
  if FEditorEnabled then
    inherited ;

  { Polaris code:
  if not FEditorEnabled or ReadOnly then
    Exit;
  V := Value;
  inherited;
  try
    StrToFloat(Text);
  except
    SetValue(V);
  end;
  }
end;

procedure TJvCustomSpinEdit.DoEnter;
begin
  SetFocused(True);
  if AutoSelect and not (csLButtonDown in ControlState) then
    SelectAll;
  inherited DoEnter;
end;

procedure TJvCustomSpinEdit.DoExit;
begin
  SetFocused(False);
  try
    if not (csDesigning in ComponentState) and (coCheckOnExit in CheckOptions) then
    begin
      CheckValueRange(Value, not (coCropBeyondLimit in CheckOptions));
      SetValue(CheckValue(Value));
    end;
  except
    SetFocused(True);
    SelectAll;
    if CanFocus then
      SetFocus;
    raise;
  end;
  inherited DoExit;
end;

procedure TJvCustomSpinEdit.DoKillFocus(FocusedWnd: HWND);
begin
  if ([coCropBeyondLimit, coCheckOnExit] <= CheckOptions) and
    not (csDesigning in ComponentState) then
    SetValue(CheckValue(Value));
  inherited DoKillFocus(FocusedWnd);
end;

function TJvCustomSpinEdit.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;  const  MousePos: TPoint): Boolean;
begin
  if WheelDelta > 0 then
    UpClick(nil)
  else
    DownClick(nil);
  Result := True;
end;

procedure TJvCustomSpinEdit.DownClick(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(FOnBottomClick) then
      FOnBottomClick(Self);
  end;
end;

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

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

{function TJvCustomSpinEdit.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 TJvCustomSpinEdit.GetAsInteger: Longint;
begin
  Result := Trunc(GetValue);
end;

function TJvCustomSpinEdit.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 TJvCustomSpinEdit.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 TJvCustomSpinEdit.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 TJvCustomSpinEdit.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 TJvCustomSpinEdit.IsFormatStored: Boolean;
begin
  Result := DisplayFormat <> DefaultDisplayFormat;
end;

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

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

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

function TJvCustomSpinEdit.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 TJvCustomSpinEdit.IsValueStored: Boolean;
begin
  Result := GetValue <> 0.0;
end;

procedure TJvCustomSpinEdit.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 TJvCustomSpinEdit.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 }  
      THackedCustomForm(GetParentForm(Self)).WantKey(Integer(Key), [], Key); 
      if Key = Cr then
        Key := #0;
    end;
  end;
end;

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

procedure TJvCustomSpinEdit.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);
        SetBounds(0, 0, DefBtnWidth, Self.Height);
        if BiDiMode = bdRightToLeft then
          Align := alLeft
        else
          Align := alRight;
        Parent := Self.ClientArea;
        OnClick := UpDownClick;
      end;
    end
    else
    begin
      FBtnWindow := TWinControl.Create(Self);
      FBtnWindow.Visible := True;
      FBtnWindow.Parent := Self.ClientArea;
      if FButtonKind <> bkClassic then
        FBtnWindow.SetBounds(0, 0, DefBtnWidth, Height)
      else
        FBtnWindow.SetBounds(0, 0, Height, Height);
      FBtnWindow.Align := alRight;
      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);
      FButton.SetBounds(0, 0, FBtnWindow.Width, FBtnWindow.Height);
    end;
end;

procedure TJvCustomSpinEdit.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  (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  (BorderStyle = bsSingle) then
      begin
        R.Left := -1;