paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 11:49:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@35973 -
This commit is contained in:
sekelsenmat 2012-03-14 09:39:36 +00:00
parent 1c114e532d
commit 6d8f89f7ee
4 changed files with 328 additions and 172 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/customdrawn/customdrawnextras.pas
View File

@ -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]);

476
lcl/customdrawncontrols.pas
View File

@ -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.

19
test/customdrawn/mainform.lfm
View File

@ -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

1
test/customdrawn/mainform.pas
View File

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