You've already forked lazarus-ccr
Added: TJDBFloatEdit, TJDBLabeledFloatEdit
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2023 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
jujibo
@ -6,7 +6,8 @@ Note: Lazarus Trunk required
|
||||
Version pre-1.0
|
||||
--------------------------------------------------
|
||||
2011-09-27 Added: ftDateTime support to TJDBGridControl
|
||||
TJFloatEdit, TJLabeledFloatEdit
|
||||
TJFloatEdit, TJLabeledFloatEdit,
|
||||
TJDBFloatEdit, TJDBLabeledFloatEdit
|
||||
Examplenodb updated
|
||||
2011-09-26 Added: TJDateTimeEdit, TJLabeledDateTimeEdit
|
||||
TJDBDateTimeEdit, TJDBLabeledDateTimeEdit
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Files Count="26">
|
||||
<Files Count="28">
|
||||
<Item1>
|
||||
<Filename Value="src/jdbintegeredit.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
@ -147,6 +147,16 @@
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="JLabeledFloatEdit"/>
|
||||
</Item26>
|
||||
<Item27>
|
||||
<Filename Value="src/jdbfloatedit.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="JDBFloatEdit"/>
|
||||
</Item27>
|
||||
<Item28>
|
||||
<Filename Value="src/jdblabeledfloatedit.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="JDBLabeledFloatEdit"/>
|
||||
</Item28>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="2">
|
||||
|
||||
@ -13,7 +13,7 @@ uses
|
||||
JDateEdit, JLabeledDateEdit, JDBGridControl, jdbgridutils, JDBLabeledEdit,
|
||||
JTimeEdit, JLabeledTimeEdit, JDBTimeEdit, JDBLabeledTimeEdit, JDateTimeEdit,
|
||||
JLabeledDateTimeEdit, JDBDateTimeEdit, JDBLabeledDateTimeEdit, JFloatEdit,
|
||||
JLabeledFloatEdit, LazarusPackageIntf;
|
||||
JLabeledFloatEdit, JDBFloatEdit, JDBLabeledFloatEdit, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
@ -43,6 +43,8 @@ begin
|
||||
RegisterUnit('JDBLabeledDateTimeEdit', @JDBLabeledDateTimeEdit.Register);
|
||||
RegisterUnit('JFloatEdit', @JFloatEdit.Register);
|
||||
RegisterUnit('JLabeledFloatEdit', @JLabeledFloatEdit.Register);
|
||||
RegisterUnit('JDBFloatEdit', @JDBFloatEdit.Register);
|
||||
RegisterUnit('JDBLabeledFloatEdit', @JDBLabeledFloatEdit.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
378
components/jujiboutils/jujibo-utils/src/jdbfloatedit.pas
Normal file
378
components/jujiboutils/jujibo-utils/src/jdbfloatedit.pas
Normal file
@ -0,0 +1,378 @@
|
||||
unit JDBFloatEdit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, LResources, Controls, StdCtrls, DB, DBCtrls, LMessages, LCLType, Dialogs,
|
||||
SysUtils;
|
||||
|
||||
type
|
||||
|
||||
{ TJDBFloatEdit }
|
||||
|
||||
TJDBFloatEdit = class(TCustomEdit)
|
||||
private
|
||||
fFormat: string;
|
||||
FDataLink: TFieldDataLink;
|
||||
fDecimales: integer;
|
||||
|
||||
procedure DataChange(Sender: TObject);
|
||||
function getDecimals: integer;
|
||||
procedure setDecimals(AValue: integer);
|
||||
procedure UpdateData(Sender: TObject);
|
||||
procedure FocusRequest(Sender: TObject);
|
||||
|
||||
function GetDataField: string;
|
||||
function GetDataSource: TDataSource;
|
||||
function GetField: TField;
|
||||
|
||||
function IsReadOnly: boolean;
|
||||
|
||||
function getFormat: string;
|
||||
procedure setFormat(const AValue: string);
|
||||
procedure formatInput;
|
||||
|
||||
procedure SetDataField(const Value: string);
|
||||
procedure SetDataSource(Value: TDataSource);
|
||||
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
|
||||
|
||||
function IsValidFloat(const Value: string): boolean;
|
||||
function ScaleTo(const AValue: double; const NDecimals: integer): double;
|
||||
|
||||
protected
|
||||
procedure Loaded; override;
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
procedure ActiveChange(Sender: TObject); virtual;
|
||||
procedure KeyDown(var Key: word; Shift: TShiftState); override;
|
||||
procedure KeyPress(var Key: char); override;
|
||||
procedure DoEnter; override;
|
||||
function GetReadOnly: boolean; override;
|
||||
procedure SetReadOnly(Value: boolean); override;
|
||||
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure EditingDone; override;
|
||||
property Field: TField read GetField;
|
||||
|
||||
published
|
||||
property DisplayFormat: string read getFormat write setFormat;
|
||||
property DataField: string read GetDataField write SetDataField;
|
||||
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
||||
property Decimals: integer read getDecimals write setDecimals;
|
||||
property ReadOnly: boolean read GetReadOnly write SetReadOnly default False;
|
||||
|
||||
// From TEdit
|
||||
property Action;
|
||||
property Align;
|
||||
property Alignment;
|
||||
property Anchors;
|
||||
property AutoSize;
|
||||
property AutoSelect;
|
||||
property BidiMode;
|
||||
property BorderStyle;
|
||||
property BorderSpacing;
|
||||
property CharCase;
|
||||
property Color;
|
||||
property Constraints;
|
||||
property DragCursor;
|
||||
property DragKind;
|
||||
property DragMode;
|
||||
property Enabled;
|
||||
property Font;
|
||||
property HideSelection;
|
||||
property MaxLength;
|
||||
property ParentBidiMode;
|
||||
property OnChange;
|
||||
property OnChangeBounds;
|
||||
property OnClick;
|
||||
property OnContextPopup;
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEditingDone;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnResize;
|
||||
property OnStartDrag;
|
||||
property OnUTF8KeyPress;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property TabStop;
|
||||
property TabOrder;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
{$I jdbfloatedit_icon.lrs}
|
||||
RegisterComponents('Data Controls', [TJDBFloatEdit]);
|
||||
end;
|
||||
|
||||
|
||||
procedure TJDBFloatEdit.DataChange(Sender: TObject);
|
||||
begin
|
||||
if FDataLink.Field <> nil then
|
||||
begin
|
||||
if not Focused then
|
||||
formatInput
|
||||
else
|
||||
Caption := FDataLink.Field.AsString;
|
||||
end
|
||||
else
|
||||
Text := '';
|
||||
end;
|
||||
|
||||
function TJDBFloatEdit.getDecimals: integer;
|
||||
begin
|
||||
Result := fDecimales;
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.setDecimals(AValue: integer);
|
||||
begin
|
||||
if AValue >= 0 then
|
||||
fDecimales := AValue;
|
||||
end;
|
||||
|
||||
|
||||
procedure TJDBFloatEdit.UpdateData(Sender: TObject);
|
||||
var
|
||||
theValue: double;
|
||||
begin
|
||||
if FDataLink.Field <> nil then
|
||||
begin
|
||||
if IsValidFloat(Text) then
|
||||
begin
|
||||
theValue := StrToFloat(Text);
|
||||
theValue := ScaleTo(theValue, fDecimales);
|
||||
Text := FloatToStr(theValue);
|
||||
FDataLink.Field.Text := Text;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if FDataLink.Field <> nil then
|
||||
begin
|
||||
ShowMessage(Caption + ' no es un valor válido');
|
||||
Caption := FDataLink.Field.AsString;
|
||||
SelectAll;
|
||||
SetFocus;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
Text := '';
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.FocusRequest(Sender: TObject);
|
||||
begin
|
||||
SetFocus;
|
||||
end;
|
||||
|
||||
function TJDBFloatEdit.GetDataField: string;
|
||||
begin
|
||||
Result := FDataLink.FieldName;
|
||||
end;
|
||||
|
||||
function TJDBFloatEdit.GetDataSource: TDataSource;
|
||||
begin
|
||||
Result := FDataLink.DataSource;
|
||||
end;
|
||||
|
||||
function TJDBFloatEdit.GetField: TField;
|
||||
begin
|
||||
Result := FDataLink.Field;
|
||||
end;
|
||||
|
||||
function TJDBFloatEdit.IsReadOnly: boolean;
|
||||
begin
|
||||
if FDatalink.Active then
|
||||
Result := not FDatalink.CanModify
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TJDBFloatEdit.getFormat: string;
|
||||
begin
|
||||
Result := fFormat;
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.setFormat(const AValue: string);
|
||||
begin
|
||||
fFormat := AValue;
|
||||
if not Focused then
|
||||
formatInput;
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.formatInput;
|
||||
begin
|
||||
if FDataLink.Field <> nil then
|
||||
//FDataLink.Field.DisplayText -> formatted (tdbgridcolumns/persistent field DisplayFormat
|
||||
if fFormat <> '' then
|
||||
Caption := FormatFloat(fFormat, FDataLink.Field.AsFloat)
|
||||
else
|
||||
Caption := FDataLink.Field.DisplayText
|
||||
else
|
||||
Caption := 'nil';
|
||||
end;
|
||||
|
||||
function TJDBFloatEdit.GetReadOnly: boolean;
|
||||
begin
|
||||
Result := FDataLink.ReadOnly;
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.SetReadOnly(Value: boolean);
|
||||
begin
|
||||
inherited;
|
||||
FDataLink.ReadOnly := Value;
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.SetDataField(const Value: string);
|
||||
begin
|
||||
FDataLink.FieldName := Value;
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.SetDataSource(Value: TDataSource);
|
||||
begin
|
||||
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
|
||||
ChangeDataSource(Self, FDataLink, Value);
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.CMGetDataLink(var Message: TLMessage);
|
||||
begin
|
||||
Message.Result := PtrUInt(FDataLink); // Delphi dbctrls compatibility?
|
||||
end;
|
||||
|
||||
function TJDBFloatEdit.IsValidFloat(const Value: string): boolean;
|
||||
begin
|
||||
if StrToFloatDef(Value, MaxDouble) = MaxDouble then
|
||||
Result := False
|
||||
else
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TJDBFloatEdit.ScaleTo(const AValue: double;
|
||||
const NDecimals: integer): double;
|
||||
begin
|
||||
Result := round(AValue * power(10, NDecimals)) / power(10, NDecimals);
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
if (csDesigning in ComponentState) then
|
||||
DataChange(Self);
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.Notification(AComponent: TComponent; Operation: TOperation);
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
// clean up
|
||||
if (Operation = opRemove) then
|
||||
begin
|
||||
if (FDataLink <> nil) and (AComponent = DataSource) then
|
||||
DataSource := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.ActiveChange(Sender: TObject);
|
||||
begin
|
||||
if FDatalink.Active then
|
||||
datachange(Sender)
|
||||
else
|
||||
Text := '';
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.KeyDown(var Key: word; Shift: TShiftState);
|
||||
begin
|
||||
inherited KeyDown(Key, Shift);
|
||||
if Key = VK_ESCAPE then
|
||||
begin
|
||||
FDataLink.Reset;
|
||||
SelectAll;
|
||||
Key := VK_UNKNOWN;
|
||||
end
|
||||
else
|
||||
if Key in [VK_DELETE, VK_BACK] then
|
||||
begin
|
||||
if not IsReadOnly then
|
||||
FDatalink.Edit
|
||||
else
|
||||
Key := VK_UNKNOWN;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.KeyPress(var Key: char);
|
||||
begin
|
||||
if (Key in ['.', ',']) then
|
||||
Key := Decimalseparator;
|
||||
if (key = DecimalSeparator) and (Pos(key, Text) > 0) then
|
||||
key := #0;
|
||||
if not (Key in ['0'..'9', DecimalSeparator, '+', '-', #8, #9]) then
|
||||
Key := #0;
|
||||
if (Key = DecimalSeparator) and (fDecimales = 0) then
|
||||
Key := #0;
|
||||
|
||||
if (Key <> #0) and (not IsReadOnly) then
|
||||
FDatalink.Edit;
|
||||
inherited KeyPress(Key);
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.DoEnter;
|
||||
begin
|
||||
if FDataLink.Field <> nil then
|
||||
Caption := FDataLink.Field.AsString;
|
||||
inherited DoEnter;
|
||||
end;
|
||||
|
||||
constructor TJDBFloatEdit.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
ControlStyle := ControlStyle + [csReplicatable];
|
||||
FDataLink := TFieldDataLink.Create;
|
||||
FDataLink.Control := Self;
|
||||
FDataLink.OnDataChange := @DataChange;
|
||||
FDataLink.OnUpdateData := @UpdateData;
|
||||
FDataLInk.OnActiveChange := @ActiveChange;
|
||||
// Set default values
|
||||
//fDecimales := 2;
|
||||
//fFormat := '0.00';
|
||||
end;
|
||||
|
||||
destructor TJDBFloatEdit.Destroy;
|
||||
begin
|
||||
FDataLink.Free;
|
||||
FDataLink := nil;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJDBFloatEdit.EditingDone;
|
||||
begin
|
||||
inherited EditingDone;
|
||||
if DataSource.State in [dsEdit, dsInsert] then
|
||||
UpdateData(self);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
@ -0,0 +1,28 @@
|
||||
LazarusResources.Add('tjdbfloatedit','PNG',[
|
||||
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||
+#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167#147
|
||||
+#0#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#219#9#27#10
|
||||
+#19'!'#30'4 '#185#0#0#2#14'IDATH'#199#213'V1k'#19'a'#24'~'#190' -'#130#166
|
||||
+#135#154#132#14#177'4 '#6'L'#235#144'C(G'#151't'#19#127'@!'#224#16#236#228' '
|
||||
+'.'#233'P'#144'.'#29'n'#17#5#183#210#161'C'#209'U'#208#241#22#155'"'#148#155
|
||||
+#210#22#132'`h'#27#162'p'#150#154#164#21#218#208#220#227#160#223'y'#151'\h.m'
|
||||
+#6#31#248#184'{'#143#151#231#249#190#231'}'#239#229#19'$1H\q'#7#239#214#191
|
||||
+'s'#249'C'#217'7q'#238'Q'#2#179#211#163'"'#168#128' '#233'!~'#253#244'>R'#183
|
||||
+#175'a{'#255#24'V'#237#20'V'#189#9#171'v'#138#247#133'j_B'#130'$f'#230'78y'
|
||||
+#231#6#198'cW'#145#26#187#142#168'2'#236'!'#183#234'M'#252':i'#225#248#228#12
|
||||
+#229'J'#3#134#174#137'@'#22'%'#226'a'#20'K'#135'('#150#128#168#146#0#128#14
|
||||
+#242'b'#233#16'2'#183#175#26'LMD'#16#29#25'B'#183#26'LMD'#156'S'#4#22'(W'#26
|
||||
+#136')'#17#0#192'B6'#137#204#228#205#142#26'X'#245'&dn`'#129'D<'#140#205#157
|
||||
+#3#180'l"5'#150#244'M'#252#188#245#227'b'#22'='#184'w'#11#209#145'!,'#173'}'
|
||||
+#193#210#218#127'd'#145' '#137#185'7['#220#171#30#161'e'#19#11#217'$v'#205
|
||||
+#143#151#242#23#231'r'#143#133#175'E'#217#187#192'vq'#253'B'#228#139#139'/'
|
||||
+#254'Y'#180'W=BL'#25'v,'#218'5'#191#2#0'^'#190'Z'#238'['#160'Q'#171#0#0'B'#0
|
||||
+#144'{8'#142#205#157#3'g'#28#184'13'#191#209#17#203'og-'#219#19#171#170#234
|
||||
+'y'#2#0'H:'#235#237#167'o'#204#228#11'\YY'#229#243'gOH'#146#153'|'#129'~'#200
|
||||
+#228#11#180'm'#219#19#147'd:'#157'&I'#214#127#238#147#228#159#19'H'#204'N'
|
||||
+#143#138#243#230'L'#251'x'#151#155#235'i\'#159'G,'#132'pl2t'#205'c'#161#140
|
||||
+#219#17#234#185#159#255#146#203#167#20'5t'#13#134#174'u'#212'*'#176#128#187
|
||||
+#200'r'#183'n'#177'n'#8#5'!'#246#235'$'#249'n'#232#26'TU'#133'i'#154#221#187
|
||||
+'H.w'#23#181'wI'#175#144']$'#252':'#160'Q'#171'\'#202'M '#172#196#133#24#244
|
||||
+#173'"'#132#1#227'7'#130#187#166#12#191#254#238#196#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
371
components/jujiboutils/jujibo-utils/src/jdblabeledfloatedit.pas
Normal file
371
components/jujiboutils/jujibo-utils/src/jdblabeledfloatedit.pas
Normal file
@ -0,0 +1,371 @@
|
||||
unit JDBLabeledFloatEdit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, LResources, Controls, ExtCtrls, DB, DBCtrls,
|
||||
LMessages, LCLType, Dialogs,
|
||||
SysUtils;
|
||||
|
||||
type
|
||||
TJDBLabeledFloatEdit = class(TCustomLabeledEdit)
|
||||
private
|
||||
fFormat: string;
|
||||
FDataLink: TFieldDataLink;
|
||||
fDecimales: integer;
|
||||
|
||||
procedure DataChange(Sender: TObject);
|
||||
function getDecimals: integer;
|
||||
procedure setDecimals(AValue: integer);
|
||||
procedure UpdateData(Sender: TObject);
|
||||
procedure FocusRequest(Sender: TObject);
|
||||
|
||||
function GetDataField: string;
|
||||
function GetDataSource: TDataSource;
|
||||
function GetField: TField;
|
||||
|
||||
function IsReadOnly: boolean;
|
||||
|
||||
function getFormat: string;
|
||||
procedure setFormat(const AValue: string);
|
||||
procedure formatInput;
|
||||
|
||||
procedure SetDataField(const Value: string);
|
||||
procedure SetDataSource(Value: TDataSource);
|
||||
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
|
||||
|
||||
function IsValidFloat(const Value: string): boolean;
|
||||
function ScaleTo(const AValue: double; const NDecimals: integer): double;
|
||||
|
||||
protected
|
||||
procedure Loaded; override;
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
procedure ActiveChange(Sender: TObject); virtual;
|
||||
procedure KeyDown(var Key: word; Shift: TShiftState); override;
|
||||
procedure KeyPress(var Key: char); override;
|
||||
procedure DoEnter; override;
|
||||
function GetReadOnly: boolean; override;
|
||||
procedure SetReadOnly(Value: boolean); override;
|
||||
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure EditingDone; override;
|
||||
property Field: TField read GetField;
|
||||
|
||||
published
|
||||
property DisplayFormat: string read getFormat write setFormat;
|
||||
property DataField: string read GetDataField write SetDataField;
|
||||
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
||||
property Decimals: integer read getDecimals write setDecimals;
|
||||
property ReadOnly: boolean read GetReadOnly write SetReadOnly default False;
|
||||
|
||||
property Action;
|
||||
property Align;
|
||||
property Alignment;
|
||||
property Anchors;
|
||||
property AutoSelect;
|
||||
property AutoSize;
|
||||
property BidiMode;
|
||||
property BorderSpacing;
|
||||
property BorderStyle;
|
||||
property CharCase;
|
||||
property Color;
|
||||
property Constraints;
|
||||
property DragCursor;
|
||||
property DragMode;
|
||||
property EditLabel;
|
||||
property Enabled;
|
||||
property Font;
|
||||
property LabelPosition;
|
||||
property LabelSpacing;
|
||||
property MaxLength;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
property Visible;
|
||||
property OnChange;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEditingDone;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnStartDrag;
|
||||
property OnUTF8KeyPress;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
{$I jdblabeledfloatedit_icon.lrs}
|
||||
RegisterComponents('Data Controls', [TJDBLabeledFloatEdit]);
|
||||
end;
|
||||
|
||||
|
||||
procedure TJDBLabeledFloatEdit.DataChange(Sender: TObject);
|
||||
begin
|
||||
if FDataLink.Field <> nil then
|
||||
begin
|
||||
if not Focused then
|
||||
formatInput
|
||||
else
|
||||
Caption := FDataLink.Field.AsString;
|
||||
end
|
||||
else
|
||||
Text := '';
|
||||
end;
|
||||
|
||||
function TJDBLabeledFloatEdit.getDecimals: integer;
|
||||
begin
|
||||
Result := fDecimales;
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.setDecimals(AValue: integer);
|
||||
begin
|
||||
if AValue >= 0 then
|
||||
fDecimales := AValue;
|
||||
end;
|
||||
|
||||
|
||||
procedure TJDBLabeledFloatEdit.UpdateData(Sender: TObject);
|
||||
var
|
||||
theValue: double;
|
||||
begin
|
||||
if FDataLink.Field <> nil then
|
||||
begin
|
||||
if IsValidFloat(Text) then
|
||||
begin
|
||||
theValue := StrToFloat(Text);
|
||||
theValue := ScaleTo(theValue, fDecimales);
|
||||
Text := FloatToStr(theValue);
|
||||
FDataLink.Field.Text := Text;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if FDataLink.Field <> nil then
|
||||
begin
|
||||
ShowMessage(Caption + ' no es un valor válido');
|
||||
Caption := FDataLink.Field.AsString;
|
||||
SelectAll;
|
||||
SetFocus;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
Text := '';
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.FocusRequest(Sender: TObject);
|
||||
begin
|
||||
SetFocus;
|
||||
end;
|
||||
|
||||
function TJDBLabeledFloatEdit.GetDataField: string;
|
||||
begin
|
||||
Result := FDataLink.FieldName;
|
||||
end;
|
||||
|
||||
function TJDBLabeledFloatEdit.GetDataSource: TDataSource;
|
||||
begin
|
||||
Result := FDataLink.DataSource;
|
||||
end;
|
||||
|
||||
function TJDBLabeledFloatEdit.GetField: TField;
|
||||
begin
|
||||
Result := FDataLink.Field;
|
||||
end;
|
||||
|
||||
function TJDBLabeledFloatEdit.IsReadOnly: boolean;
|
||||
begin
|
||||
if FDatalink.Active then
|
||||
Result := not FDatalink.CanModify
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TJDBLabeledFloatEdit.getFormat: string;
|
||||
begin
|
||||
Result := fFormat;
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.setFormat(const AValue: string);
|
||||
begin
|
||||
fFormat := AValue;
|
||||
if not Focused then
|
||||
formatInput;
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.formatInput;
|
||||
begin
|
||||
if FDataLink.Field <> nil then
|
||||
//FDataLink.Field.DisplayText -> formatted (tdbgridcolumns/persistent field DisplayFormat
|
||||
if fFormat <> '' then
|
||||
Caption := FormatFloat(fFormat, FDataLink.Field.AsFloat)
|
||||
else
|
||||
Caption := FDataLink.Field.DisplayText
|
||||
else
|
||||
Caption := 'nil';
|
||||
end;
|
||||
|
||||
function TJDBLabeledFloatEdit.GetReadOnly: boolean;
|
||||
begin
|
||||
Result := FDataLink.ReadOnly;
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.SetReadOnly(Value: boolean);
|
||||
begin
|
||||
inherited;
|
||||
FDataLink.ReadOnly := Value;
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.SetDataField(const Value: string);
|
||||
begin
|
||||
FDataLink.FieldName := Value;
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.SetDataSource(Value: TDataSource);
|
||||
begin
|
||||
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
|
||||
ChangeDataSource(Self, FDataLink, Value);
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.CMGetDataLink(var Message: TLMessage);
|
||||
begin
|
||||
Message.Result := PtrUInt(FDataLink); // Delphi dbctrls compatibility?
|
||||
end;
|
||||
|
||||
function TJDBLabeledFloatEdit.IsValidFloat(const Value: string): boolean;
|
||||
begin
|
||||
if StrToFloatDef(Value, MaxDouble) = MaxDouble then
|
||||
Result := False
|
||||
else
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TJDBLabeledFloatEdit.ScaleTo(const AValue: double;
|
||||
const NDecimals: integer): double;
|
||||
begin
|
||||
Result := round(AValue * power(10, NDecimals)) / power(10, NDecimals);
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
if (csDesigning in ComponentState) then
|
||||
DataChange(Self);
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.Notification(AComponent: TComponent;
|
||||
Operation: TOperation);
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
// clean up
|
||||
if (Operation = opRemove) then
|
||||
begin
|
||||
if (FDataLink <> nil) and (AComponent = DataSource) then
|
||||
DataSource := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.ActiveChange(Sender: TObject);
|
||||
begin
|
||||
if FDatalink.Active then
|
||||
datachange(Sender)
|
||||
else
|
||||
Text := '';
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.KeyDown(var Key: word; Shift: TShiftState);
|
||||
begin
|
||||
inherited KeyDown(Key, Shift);
|
||||
if Key = VK_ESCAPE then
|
||||
begin
|
||||
FDataLink.Reset;
|
||||
SelectAll;
|
||||
Key := VK_UNKNOWN;
|
||||
end
|
||||
else
|
||||
if Key in [VK_DELETE, VK_BACK] then
|
||||
begin
|
||||
if not IsReadOnly then
|
||||
FDatalink.Edit
|
||||
else
|
||||
Key := VK_UNKNOWN;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.KeyPress(var Key: char);
|
||||
begin
|
||||
if (Key in ['.', ',']) then
|
||||
Key := Decimalseparator;
|
||||
if (key = DecimalSeparator) and (Pos(key, Text) > 0) then
|
||||
key := #0;
|
||||
if not (Key in ['0'..'9', DecimalSeparator, '+', '-', #8, #9]) then
|
||||
Key := #0;
|
||||
if (Key = DecimalSeparator) and (fDecimales = 0) then
|
||||
Key := #0;
|
||||
|
||||
if (Key <> #0) and (not IsReadOnly) then
|
||||
FDatalink.Edit;
|
||||
inherited KeyPress(Key);
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.DoEnter;
|
||||
begin
|
||||
if FDataLink.Field <> nil then
|
||||
Caption := FDataLink.Field.AsString;
|
||||
inherited DoEnter;
|
||||
end;
|
||||
|
||||
constructor TJDBLabeledFloatEdit.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
ControlStyle := ControlStyle + [csReplicatable];
|
||||
FDataLink := TFieldDataLink.Create;
|
||||
FDataLink.Control := Self;
|
||||
FDataLink.OnDataChange := @DataChange;
|
||||
FDataLink.OnUpdateData := @UpdateData;
|
||||
FDataLInk.OnActiveChange := @ActiveChange;
|
||||
// Set default values
|
||||
//fDecimales := 2;
|
||||
//fFormat := '0.00';
|
||||
end;
|
||||
|
||||
destructor TJDBLabeledFloatEdit.Destroy;
|
||||
begin
|
||||
FDataLink.Free;
|
||||
FDataLink := nil;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJDBLabeledFloatEdit.EditingDone;
|
||||
begin
|
||||
inherited EditingDone;
|
||||
if DataSource.State in [dsEdit, dsInsert] then
|
||||
UpdateData(self);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
@ -0,0 +1,33 @@
|
||||
LazarusResources.Add('tjdblabeledfloatedit','PNG',[
|
||||
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||
+#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167#147
|
||||
+#0#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#219#9#27#10
|
||||
+#20#14#250#164#139''''#0#0#2'}IDATH'#199#213#149'MHTa'#20#134#159#27#162#155
|
||||
+'r'#212'P'#193#208'h@raF'#220'!'#136'1'#23'3'#11'!'#130'6'#179#17#137#252#11
|
||||
+#162#22#210'fD'#132#176#149'L'#139'H'#220#4'"'#153'-'#220#204'F'#176#229'm'
|
||||
+#161#227'&'#230'"'#12#214'F'#20#127#24#137'!l'#198#31'p'#196#153#211#194#190
|
||||
+#219#157'?'#27#181#22#189#155'{'#206#185#151#247#156#243'~'#239#199#133#127
|
||||
+#12#205#158'L'#207'm'#201#248#236'j'#222#15#31#223'w'#210#209'V'#167#157#169
|
||||
+#129#157'x'#244#217'M'#154#27'.'#178#180#177'G,'#158'$'#150'8$'#22'O2'#19#138
|
||||
+#158#169#209#5#128#241#217'UZ'#26#171'x'#208'z'#133'X<i'#145#251'{'#218#173
|
||||
+'&-'#141'U8'#235#203')'#180#161#130#174#235#146#211#192'Y_Ndy'#155#153'P'#212
|
||||
+#154#216#223#211#14#192#212'K'#31#251#7')Z+'#191#178'8'#217'M'#194#232''''#24
|
||||
+#12'J6'#153#174#235#162'r{]'#3#232#27#139'HmE'#25'5'#142'RK'#10#128#132#209
|
||||
+#143#195';j'#197'w'#159'|`'#239#224#136#197#201'nL'#211#212#130#193#160#140
|
||||
+#140#140#0'088'#136#207#231#211't]'#23#211'4-'#9'K'#0'V7w'#168#173#168#6'`'
|
||||
+#168#179#9'O'#203'e'#150'6'#246#232'2'#142'5'#143#197#147'L'#25'0'#255#246'a'
|
||||
+#134#28#138'P'#197#5#207#192'Y_'#206#231'/'#223'3'#166#207#7#135'w'#148'[]'
|
||||
+#239'P'#19'*'#169#178#227#28#23#157'$'#145'"~z'#251#27'J'#14#0#211'43'#228'P'
|
||||
+#177#218'H'#213'5'#0#143'?$wnTS'#227'('#165#249#234'%K"'#187'Mc'#137'C'#246
|
||||
+#15'RD'#150#183#249#244#170'U;'#213'='#232#27#139#200'zt'#151'TZ'#24#234'lb-'
|
||||
+#252#241#175#220#226#222#222'GZ^'#137':'#175#175#176#20#153'?'#23#249#240#240
|
||||
+#11#28#149#13'Z'#9#192'zt'#151#218#138'2'#203'Ek'#225#21#0'^'#191#25'?s'#131
|
||||
+#157#248#230'o'#23#245#220#187'V'#208'E'#222#129#133#156'\'#213#142'R'#233
|
||||
+#140#220#229're<s0='#183'%'#30#127'H&&'#222#203#243#254'>'#17#17#241#248'C'
|
||||
+#146#15#30#127'H'#210#233'tF."'#162#235#186#136#136'$~l'#136#181#129'BG['#157
|
||||
+#246''''#135#136'HN'#158']'#179#163#164'XME'#4#237#216#19'x'#7#22'0'#2#238#12
|
||||
+#9'U'#158#247'&'#23#229#231'_'#228#234#169#154#26#1'7F'#192#157'sV'#167'n`?d'
|
||||
+'5'#173#189#217#137#255#131'b'#137#243'9I'#197'F'#192#141#203#229'"'#28#14#23
|
||||
+'v'#145#130#221'E'#217'.)'#22#202'EywT/'#207#11'Ge'#131#198#127#143#159#224
|
||||
+#14#176'G'#159'I'#209'a'#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
Reference in New Issue
Block a user