Initial implementation of TCDSpinEdit (supports both float and integer value)

git-svn-id: trunk@35973 -

components/customdrawn/customdrawnextras.pas

@@ -188,7 +188,9 @@ begin
     // Additional
     TCDStaticText,
     // Common Controls
-    TCDTrackBar, TCDProgressBar, TCDListView, TCDPageControl, TCDTabControl]);
+    TCDTrackBar, TCDProgressBar, TCDListView, TCDPageControl, TCDTabControl,
+    // Misc
+    TCDSpinEdit]);
   RegisterComponentEditor(TCDPageControl, TCDPageControlEditor);
   RegisterComponentEditor(TCDTabSheet, TCDPageControlEditor);
   RegisterNoIcon([TCDTabSheet]);

lcl/customdrawncontrols.pas

@@ -188,6 +188,7 @@ type
   private
     DragDropStarted: boolean;
     FCaretTimer: TTimer;
+    FOnChange: TNotifyEvent;
     function GetLeftTextMargin: Integer;
     function GetRightTextMargin: Integer;
     procedure HandleCaretTimer(Sender: TObject);
@@ -204,6 +205,8 @@ type
     FEditState: TCDEditStateEx; // Points to the same object as FStateEx, so don't Free!
     function GetControlId: TCDControlID; override;
     procedure CreateControlStateEx; override;
+    // for descendents to override
+    procedure DoChange; virtual;
     // keyboard
     procedure DoEnter; override;
     procedure DoExit; override;
@@ -231,6 +234,7 @@ type
     property Enabled;
     property TabStop default True;
     property Text: string read GetText write SetText;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
   end;
 
   { TCDCheckBox }
@@ -693,11 +697,214 @@ type
     property OnUserAddedPage;
   end;
 
+  // ===================================
+  // Misc Tab
+  // ===================================
+
+  { TCDSpinEdit }
+
+  TCDSpinEdit = class(TCDEdit)
+  private
+    FDecimalPlaces: Byte;
+    FIncrement: Double;
+    FMaxValue: Double;
+    FMinValue: Double;
+    FValue: Double;
+    FUpDown: TUpDown;
+    procedure SetDecimalPlaces(AValue: Byte);
+    procedure SetIncrement(AValue: Double);
+    procedure SetMaxValue(AValue: Double);
+    procedure SetMinValue(AValue: Double);
+    procedure UpDownChanging(Sender: TObject; var AllowChange: Boolean);
+    procedure SetValue(AValue: Double);
+    procedure DoUpdateText;
+    procedure DoUpdateUpDown;
+  protected
+    procedure DoChange; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    property DecimalPlaces: Byte read FDecimalPlaces write SetDecimalPlaces default 0;
+    property Increment: Double read FIncrement write SetIncrement;
+    property MinValue: Double read FMinValue write SetMinValue;
+    property MaxValue: Double read FMaxValue write SetMaxValue;
+    property Value: Double read FValue write SetValue;
+  end;
+
 implementation
 
 const
   sTABSHEET_DEFAULT_NAME = 'CTabSheet';
 
+{ TCDControl }
+
+procedure TCDControl.CalculatePreferredSize(var PreferredWidth,
+  PreferredHeight: integer; WithThemeSpace: Boolean);
+begin
+  PrepareControlState;
+  PrepareControlStateEx;
+  FDrawer.CalculatePreferredSize(Canvas, GetControlId(), FState, FStateEx,
+    PreferredWidth, PreferredHeight, WithThemeSpace);
+end;
+
+procedure TCDControl.SetState(const AValue: TCDControlState);
+begin
+  if AValue <> FState then
+  begin
+    FState := AValue;
+    Invalidate;
+  end;
+end;
+
+procedure TCDControl.PrepareCurrentDrawer;
+var
+  OldDrawer: TCDDrawer;
+begin
+  OldDrawer := FDrawer;
+  FDrawer := GetDrawer(FDrawStyle);
+  if FDrawer = nil then FDrawer := GetDrawer(dsCommon); // avoid exceptions in the object inspector if an invalid drawer is selected
+  if FDrawer = nil then raise Exception.Create('[TCDControl.PrepareCurrentDrawer] No registered drawers were found. Please add the unit customdrawn_common to your uses clause and also the units of any other utilized drawers.');
+  if OldDrawer <> FDrawer then FDrawer.LoadPalette();
+end;
+
+procedure TCDControl.SetDrawStyle(const AValue: TCDDrawStyle);
+begin
+  if FDrawStyle = AValue then exit;
+  FDrawStyle := AValue;
+  Invalidate;
+  PrepareCurrentDrawer();
+
+  //FCurrentDrawer.SetClientRectPos(Self);
+end;
+
+function TCDControl.GetClientRect: TRect;
+begin
+  // Disable this, since although it works in Win32, it doesn't seam to work in LCL-Carbon
+  //if (FCurrentDrawer = nil) then
+    Result := inherited GetClientRect()
+  //else
+    //Result := FCurrentDrawer.GetClientRect(Self);
+end;
+
+function TCDControl.GetControlId: TCDControlID;
+begin
+  Result := cidControl;
+end;
+
+procedure TCDControl.CreateControlStateEx;
+begin
+  FStateEx := TCDControlStateEx.Create;
+end;
+
+procedure TCDControl.PrepareControlState;
+begin
+  if Focused then FState := FState + [csfHasFocus]
+  else FState := FState - [csfHasFocus];
+
+  if Enabled then FState := FState + [csfEnabled]
+  else FState := FState - [csfEnabled];
+end;
+
+procedure TCDControl.PrepareControlStateEx;
+begin
+  if Parent <> nil then FStateEx.ParentRGBColor := Parent.GetRGBColorResolvingParent
+  else FStateEx.ParentRGBColor := clSilver;
+
+  if Color = clDefault then FStateEx.RGBColor := FDrawer.GetControlDefaultColor(GetControlId())
+  else FStateEx.RGBColor := GetRGBColorResolvingParent;
+
+  FStateEx.Caption := Caption;
+  FStateEx.Font := Font;
+  FStateEx.AutoSize := AutoSize;
+end;
+
+procedure TCDControl.DoEnter;
+begin
+  Invalidate;
+  inherited DoEnter;
+end;
+
+procedure TCDControl.DoExit;
+begin
+  Invalidate;
+  inherited DoExit;
+end;
+
+procedure TCDControl.EraseBackground(DC: HDC);
+begin
+
+end;
+
+procedure TCDControl.Paint;
+var
+  ABmp: TBitmap;
+begin
+  inherited Paint;
+
+  DrawToCanvas(Canvas);
+end;
+
+procedure TCDControl.DrawToCanvas(ACanvas: TCanvas);
+var
+  lSize: TSize;
+  lControlId: TCDControlID;
+begin
+  PrepareCurrentDrawer();
+
+  lSize := Size(Width, Height);
+  lControlId := GetControlId();
+  PrepareControlState;
+  PrepareControlStateEx;
+  FDrawer.DrawControl(ACanvas, lSize, lControlId, FState, FStateEx);
+end;
+
+procedure TCDControl.MouseEnter;
+begin
+  FState := FState + [csfMouseOver];
+  inherited MouseEnter;
+end;
+
+procedure TCDControl.MouseLeave;
+begin
+  FState := FState - [csfMouseOver];
+  inherited MouseLeave;
+end;
+
+procedure TCDControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
+  Y: integer);
+begin
+  inherited MouseDown(Button, Shift, X, Y);
+  SetFocus();
+end;
+
+constructor TCDControl.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  CreateControlStateEx;
+  PrepareCurrentDrawer();
+  {$ifdef CDControlsDoDoubleBuffer}
+  DoubleBuffered := True;
+  {$endif}
+end;
+
+destructor TCDControl.Destroy;
+begin
+  FStateEx.Free;
+  inherited Destroy;
+end;
+
+// A CalculatePreferredSize which is utilized by LCL-CustomDrawn
+procedure TCDControl.LCLWSCalculatePreferredSize(var PreferredWidth,
+  PreferredHeight: integer; WithThemeSpace, AAutoSize: Boolean);
+begin
+  PrepareControlState;
+  PrepareControlStateEx;
+  FStateEx.AutoSize := AAutoSize;
+  FDrawer.CalculatePreferredSize(Canvas, GetControlId(), FState, FStateEx,
+    PreferredWidth, PreferredHeight, WithThemeSpace);
+end;
+
 { TCDComboBox }
 
 function TCDComboBox.GetItems: TStrings;
@@ -926,174 +1133,6 @@ begin
   inherited Destroy;
 end;
 
-{ TCDControl }
-
-procedure TCDControl.CalculatePreferredSize(var PreferredWidth,
-  PreferredHeight: integer; WithThemeSpace: Boolean);
-begin
-  PrepareControlState;
-  PrepareControlStateEx;
-  FDrawer.CalculatePreferredSize(Canvas, GetControlId(), FState, FStateEx,
-    PreferredWidth, PreferredHeight, WithThemeSpace);
-end;
-
-procedure TCDControl.SetState(const AValue: TCDControlState);
-begin
-  if AValue <> FState then
-  begin
-    FState := AValue;
-    Invalidate;
-  end;
-end;
-
-procedure TCDControl.PrepareCurrentDrawer;
-var
-  OldDrawer: TCDDrawer;
-begin
-  OldDrawer := FDrawer;
-  FDrawer := GetDrawer(FDrawStyle);
-  if FDrawer = nil then FDrawer := GetDrawer(dsCommon); // avoid exceptions in the object inspector if an invalid drawer is selected
-  if FDrawer = nil then raise Exception.Create('[TCDControl.PrepareCurrentDrawer] No registered drawers were found. Please add the unit customdrawn_common to your uses clause and also the units of any other utilized drawers.');
-  if OldDrawer <> FDrawer then FDrawer.LoadPalette();
-end;
-
-procedure TCDControl.SetDrawStyle(const AValue: TCDDrawStyle);
-begin
-  if FDrawStyle = AValue then exit;
-  FDrawStyle := AValue;
-  Invalidate;
-  PrepareCurrentDrawer();
-
-  //FCurrentDrawer.SetClientRectPos(Self);
-end;
-
-function TCDControl.GetClientRect: TRect;
-begin
-  // Disable this, since although it works in Win32, it doesn't seam to work in LCL-Carbon
-  //if (FCurrentDrawer = nil) then
-    Result := inherited GetClientRect()
-  //else
-    //Result := FCurrentDrawer.GetClientRect(Self);
-end;
-
-function TCDControl.GetControlId: TCDControlID;
-begin
-  Result := cidControl;
-end;
-
-procedure TCDControl.CreateControlStateEx;
-begin
-  FStateEx := TCDControlStateEx.Create;
-end;
-
-procedure TCDControl.PrepareControlState;
-begin
-  if Focused then FState := FState + [csfHasFocus]
-  else FState := FState - [csfHasFocus];
-
-  if Enabled then FState := FState + [csfEnabled]
-  else FState := FState - [csfEnabled];
-end;
-
-procedure TCDControl.PrepareControlStateEx;
-begin
-  if Parent <> nil then FStateEx.ParentRGBColor := Parent.GetRGBColorResolvingParent
-  else FStateEx.ParentRGBColor := clSilver;
-
-  if Color = clDefault then FStateEx.RGBColor := FDrawer.GetControlDefaultColor(GetControlId())
-  else FStateEx.RGBColor := GetRGBColorResolvingParent;
-
-  FStateEx.Caption := Caption;
-  FStateEx.Font := Font;
-  FStateEx.AutoSize := AutoSize;
-end;
-
-procedure TCDControl.DoEnter;
-begin
-  Invalidate;
-  inherited DoEnter;
-end;
-
-procedure TCDControl.DoExit;
-begin
-  Invalidate;
-  inherited DoExit;
-end;
-
-procedure TCDControl.EraseBackground(DC: HDC);
-begin
-
-end;
-
-procedure TCDControl.Paint;
-var
-  ABmp: TBitmap;
-begin
-  inherited Paint;
-
-  DrawToCanvas(Canvas);
-end;
-
-procedure TCDControl.DrawToCanvas(ACanvas: TCanvas);
-var
-  lSize: TSize;
-  lControlId: TCDControlID;
-begin
-  PrepareCurrentDrawer();
-
-  lSize := Size(Width, Height);
-  lControlId := GetControlId();
-  PrepareControlState;
-  PrepareControlStateEx;
-  FDrawer.DrawControl(ACanvas, lSize, lControlId, FState, FStateEx);
-end;
-
-procedure TCDControl.MouseEnter;
-begin
-  FState := FState + [csfMouseOver];
-  inherited MouseEnter;
-end;
-
-procedure TCDControl.MouseLeave;
-begin
-  FState := FState - [csfMouseOver];
-  inherited MouseLeave;
-end;
-
-procedure TCDControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
-  Y: integer);
-begin
-  inherited MouseDown(Button, Shift, X, Y);
-  SetFocus();
-end;
-
-constructor TCDControl.Create(AOwner: TComponent);
-begin
-  inherited Create(AOwner);
-  CreateControlStateEx;
-  PrepareCurrentDrawer();
-  {$ifdef CDControlsDoDoubleBuffer}
-  DoubleBuffered := True;
-  {$endif}
-end;
-
-destructor TCDControl.Destroy;
-begin
-  FStateEx.Free;
-  inherited Destroy;
-end;
-
-// A CalculatePreferredSize which is utilized by LCL-CustomDrawn
-procedure TCDControl.LCLWSCalculatePreferredSize(var PreferredWidth,
-  PreferredHeight: integer; WithThemeSpace, AAutoSize: Boolean);
-begin
-  PrepareControlState;
-  PrepareControlStateEx;
-  FStateEx.AutoSize := AAutoSize;
-  FDrawer.CalculatePreferredSize(Canvas, GetControlId(), FState, FStateEx,
-    PreferredWidth, PreferredHeight, WithThemeSpace);
-end;
-
 { TCDButtonDrawer }
 
 procedure TCDButtonControl.KeyDown(var Key: word; Shift: TShiftState);
@@ -1325,6 +1364,11 @@ begin
   FStateEx := FEditState;
 end;
 
+procedure TCDEdit.DoChange;
+begin
+  if Assigned(FOnChange) then FOnChange(Self);
+end;
+
 procedure TCDEdit.HandleCaretTimer(Sender: TObject);
 begin
   if FEditState.EventArrived then
@@ -1403,8 +1447,12 @@ begin
 end;
 
 procedure TCDEdit.SetText(AValue: string);
+var
+  OldCaption: TCaption;
 begin
+  OldCaption := Caption;
   Caption := AValue;
+  if (AValue <> OldCaption) then DoChange;
   Invalidate;
 end;
 
@@ -2951,5 +2999,97 @@ begin
   Result := FTabIndex;
 end;
 
+{ TCDSpinEdit }
+
+procedure TCDSpinEdit.UpDownChanging(Sender: TObject; var AllowChange: Boolean);
+begin
+  Value := FUpDown.Position / Power(10, FDecimalPlaces);
+end;
+
+procedure TCDSpinEdit.SetIncrement(AValue: Double);
+begin
+  if FIncrement=AValue then Exit;
+  FIncrement:=AValue;
+  DoUpdateUpDown;
+end;
+
+procedure TCDSpinEdit.SetDecimalPlaces(AValue: Byte);
+begin
+  if FDecimalPlaces=AValue then Exit;
+  FDecimalPlaces:=AValue;
+  DoUpdateUpDown;
+  DoUpdateText;
+end;
+
+procedure TCDSpinEdit.SetMaxValue(AValue: Double);
+begin
+  if FMaxValue=AValue then Exit;
+  FMaxValue:=AValue;
+  if FValue > FMaxValue then Value := FMaxValue;
+  DoUpdateUpDown;
+end;
+
+procedure TCDSpinEdit.SetMinValue(AValue: Double);
+begin
+  if FMinValue=AValue then Exit;
+  FMinValue:=AValue;
+  if FValue < FMinValue then Value := FMinValue;
+  DoUpdateUpDown;
+end;
+
+procedure TCDSpinEdit.SetValue(AValue: Double);
+begin
+  if FValue=AValue then Exit;
+  if FValue < FMinValue then Exit;
+  if FValue > FMaxValue then Exit;
+  FValue:=AValue;
+  DoUpdateText;
+  DoUpdateUpDown;
+end;
+
+procedure TCDSpinEdit.DoUpdateText;
+begin
+  if FDecimalPlaces > 0 then Text := FloatToStr(FValue)
+  else Text := IntToStr(Round(FValue));
+  Invalidate;
+end;
+
+procedure TCDSpinEdit.DoUpdateUpDown;
+begin
+  FUpDown.Min := Round(FMinValue * Power(10, FDecimalPlaces));
+  FUpDown.Max := Round(FMaxValue * Power(10, FDecimalPlaces));
+  FUpDown.Position := Round(FValue * Power(10, FDecimalPlaces));
+end;
+
+procedure TCDSpinEdit.DoChange;
+var
+  lValue: Extended;
+begin
+  if SysUtils.TryStrToFloat(Caption, lValue) then FValue := lValue;
+  DoUpdateUpDown;
+  inherited DoChange;
+end;
+
+constructor TCDSpinEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+
+  FUpDown := TUpDown.Create(Self);
+  FUpDown.Align := alRight;
+  FUpDown.Parent := Self;
+  FUpDown.OnChanging :=@UpDownChanging;
+
+  FMinValue := 0;
+  FMaxValue := 100;
+  FIncrement := 1;
+
+  DoUpdateText();
+end;
+
+destructor TCDSpinEdit.Destroy;
+begin
+  inherited Destroy;
+end;
+
 end.
 

test/customdrawn/mainform.lfm

@@ -61,7 +61,7 @@ object Form1: TForm1
     Height = 240
     Top = 40
     Width = 463
-    PageIndex = 9
+    PageIndex = 0
     Anchors = [akTop, akLeft, akRight]
     TabOrder = 2
     TabStop = True
@@ -419,6 +419,7 @@ object Form1: TForm1
         Width = 128
         DrawStyle = dsDefault
         Text = 'CDComboBox1'
+        ItemIndex = 0
       end
     end
     object pageScrollBars: TPage
@@ -1295,7 +1296,7 @@ object Form1: TForm1
     object pageSpins: TPage
       object SpinEdit1: TSpinEdit
         Left = 13
-        Height = 21
+        Height = 25
         Top = 24
         Width = 85
         TabOrder = 0
@@ -1303,7 +1304,7 @@ object Form1: TForm1
       end
       object FloatSpinEdit1: TFloatSpinEdit
         Left = 13
-        Height = 21
+        Height = 25
         Top = 104
         Width = 85
         Increment = 0.1
@@ -1312,6 +1313,18 @@ object Form1: TForm1
         TabOrder = 1
         Value = 1.1
       end
+      object CDSpinEdit1: TCDSpinEdit
+        Left = 160
+        Height = 25
+        Top = 24
+        Width = 80
+        DrawStyle = dsDefault
+        Text = 'CDSpinEdit1'
+        Increment = 1
+        MinValue = 0
+        MaxValue = 100
+        Value = 0
+      end
     end
   end
   object memoLog: TMemo

test/customdrawn/mainform.pas

@@ -36,6 +36,7 @@ type
     CDEdit1: TCDEdit;
     CDEdit2: TCDEdit;
     CDEdit3: TCDEdit;
+    CDSpinEdit1: TCDSpinEdit;
     CDTabControl1: TCDTabControl;
     ComboBox1: TComboBox;
     Edit2: TEdit;