Use of temporary variable changes formatted output - delphi

While maintaining some code, I came across this statement:
sActDiln := Format('%.*f',[tdDigits.ndd, Fields[itd].AsFloat * rfc / 100]);
In order to see what was going on, I added a temporary variable (actDiln) of type DOUBLE and altered the code as follows:
actDiln := Fields[itd].AsFloat * rfc / 100;
sActDiln := Format('%.*f',[tdDigits.ndd, actDiln]);
When "Fields[itd].AsString" is 35 and "rfc" is 109, the computed value changed from 38.15 to 38.14999999. When the number of decimal digits was 1, this then changed the computed value from 38.2 to 38.1. And this caused other problems.
I did not anticipate that using this temporary variable would cause such problems. Can anyone explain what is going on here? And what is best practice in the future to avoid this?
This demonstrates the problem:
Uses DB, DBISAMTb;
procedure TForm1.FormShow(Sender: TObject);
var
t : TDBISAMTable;
actDiln, rfc : double;
actDilnE : extended;
sActDiln1, sActDiln2, sActDiln3 : string;
begin
t := TDBISAMTable.Create(Application);
WITH t DO BEGIN
TableName := 'xxx';
DataBaseName := 'Study';
Active := False;
Exclusive := False;
IF Exists THEN DeleteTable;
WITH FieldDefs DO BEGIN
Clear;
Add('fld', ftString, 10, False);
END;
WITH IndexDefs DO BEGIN
Clear;
END;
CreateTable;
Exclusive := True; //<<<<<<<<<<<<<
IndexName := '';
Open;
Append;
FieldByName('fld').AsString := '35';
Post;
rfc := 109;
actDiln := Fields[0].AsFloat * rfc / 100;
sActDiln1 := Format('%.*f',[1, Fields[0].AsFloat * rfc / 100]);
sActDiln2 := Format('%.*f',[1, actDiln]);
actDilnE := Fields[0].AsFloat * rfc / 100;
sActDiln3 := Format('%.*f',[1, actDilnE]);
ShowMessage(sActDiln1 + ' vs ' + sActDiln2 + ' vs ' + sActDiln3);
end;
end;

Inline floating-point calculations are usually of Extended type. Check the behavior when your intermediate variable is Extended too.

Related

Pascal, how to mark an integer into money value

How can I mark an integer into thousands and hundreds?
Just say I have an integer 12345678910, then I want to change it into a money value like 12.345.678.910.
I try the following code but it is not working.
procedure TForm1.Button1Click(Sender: TObject);
var
j,iPos,i, x, y : integer;
sTemp, original, hasil, data : string;
begin
original := edit1.Text;
sTemp := '';
j := length(edit1.Text);
i := 3;
while i < j do
begin
insert('.',original, (j-i));
edit1.Text := original;
j := length(edit1.Text);
for x := 1 to y do
begin
i := i + ( i + x );
end;
end;
edit2.Text := original;
There is System.SysUtils.Format call in Delphi http://docwiki.embarcadero.com/Libraries/Tokyo/en/System.SysUtils.Format.
This call understand 'm' character as money specific formatter.
Try code like this:
Value := 12345678910;
FormattedStr := Format('Money = %m', [Value])
By default Format will use systemwide format settings, if you have to override default system settings, see official docs:
The conversion is controlled by the CurrencyString, CurrencyFormat,
NegCurrFormat, ThousandSeparator, DecimalSeparator, and
CurrencyDecimals global variables or their equivalent in a
TFormatSettings data structure. If the format string contains a
precision specifier, it overrides the value given by the
CurrencyDecimals global variable or its TFormatSettings equivalent.
This function does what you specify:
function FormatThousandsSeparators(Value: Int64): string;
var
Index: Integer;
begin
Result := IntToStr(Value);
Index := Length(Result) - 3;
while Index > 0 do
begin
Insert('.', Result, Index + 1);
Dec(Index, 3);
end;
end;
Note that your example 12345678910 does not fit into a 32 bit signed integer value which is why I used Int64.
This function does not handle negative values correctly. For instance, it returns '-.999' when passed -999. That can be dealt with like so:
function FormatThousandsSeparators(Value: Int64): string;
var
Index: Integer;
Negative: Boolean;
begin
Negative := Value < 0;
Result := IntToStr(Abs(Value));
Index := Length(Result) - 3;
while Index > 0 do
begin
Insert('.', Result, Index + 1);
Dec(Index, 3);
end;
if Negative then
Result := '-' + Result;
end;
i know now, its so simple. just use
showMessage(formatFloat('#.###.00', strToFloat(original)));
but thanks Remy, you opened my mind.

How to limit decimal digits for a ftFloat field?

I need to limit the number of decimal digits that the user can type as value for a ftFloat field.
var
Dst : TClientDataSet;
Dsc : TDataSource;
Fld : TNumericField;
Edt : TDBEdit;
begin
//dataset
Dst := TClientDataSet.Create(Self);
Dst.FieldDefs.Add('TEST', ftFloat);
Dst.CreateDataSet();
Dst.Active := True;
Fld := Dst.Fields[0] as TNumericField;
Dst.Append();
Fld.AsFloat := 1234.56;
Dst.Post();
//field
Fld.DisplayFormat := '0,.##'; //2 optional decimals, with thousands separator
Fld.EditFormat := '0.##'; //2 optional decimals, withhout thousands separator
//datasource
Dsc := TDataSource.Create(Self);
Dsc.DataSet := Dst;
//control
Edt := TDBEdit.Create(Self);
Edt.DataSource := Dsc;
Edt.DataField := Fld.FieldName;
Edt.Top := 5;
Edt.Left := 5;
Edt.Parent := Self;
end;
In the example, after typing 1234,5678, the TDBEdit control displays 1234,56 but the field's value is 1234,5678.
As suggested in this answer, I've tried using the EditMask property.
Fld.EditMask := '9' + DecimalSeparator + '99;1; ';
Unfortunately this approach introduces several problems:
I can't set a variable number of digits for the integer part (e.g. values like 12, 123... can't be typed)
I can't set negative values (e.g. values like -1, -12 can't be typed)
The decimal separator is always visible when editing.
How can I avoid that the user types more than N digits in the decimal part (Without adding any other kind of limitation)?
Rather than avoiding typing the field extra digits, you can also strip the digits before they are posted to the datasaet.
Strip the "extra" digits on the TDataset.OnBeforePost event, or maybe better using the OnDataChange event of a TDatasource. (Pseudocode,untested)
procedure TSomeClass.OnDataChange(aField:TField)
begin
if Assigned(aField) and (aField.FieldName='TEST') and not aField.IsNull then
aField.AsFloat:=round(aField.AsFloat*100)/100.0;
end;
As I found nothing in standard VCL controls to achieve this, my approach would be to have a TDBEdit descendant that can be assigned desired DecimalPlaces and can then prohibit the user from entering more than configured.
This is independent of the underlying data-type, but for ftFloat it will try to convert the resulting value, eliminating e.g. multiple times decimalseperator.
This uses KeyPress to eliminate unwanted keys that would invalidate the current value, either adding too many decimal places or in case of ftFloat not being convertible by TryStrToFloat.
An example using sample then would be:
//control
Edt := TDecimalPlacesDBEdit.Create(Self);
Edt.DataSource := Dsc;
Edt.DataField := Fld.FieldName;
Edt.Top := 5;
Edt.Left := 5;
Edt.Parent := Self;
Edt.DecimalPlaces := 2;
Here is an implementation approach in a new unit:
unit Unit1;
interface
uses
Vcl.DBCtrls;
type
TDecimalPlacesDBEdit = class(TDBEdit)
private
FDecimalPlaces: Integer;
function IsValidChar(Key: Char): Boolean;
protected
procedure KeyPress(var Key: Char); override;
public
property DecimalPlaces: Integer read FDecimalPlaces write FDecimalPlaces;
end;
implementation
uses
System.SysUtils,
Data.DB,
Winapi.Windows;
{ TDecimalPlacesDBEdit }
function TDecimalPlacesDBEdit.IsValidChar(Key: Char): Boolean;
function IsValidText(const S: string): Boolean;
var
ADecPos, AStartPos: Integer;
V: Double;
begin
Result := False;
ADecPos := Pos(FormatSettings.DecimalSeparator, S);
if ADecPos > 0 then
begin
AStartPos := Pos('E', UpperCase(S));
if AStartPos > ADecPos then
ADecPos := AStartPos - ADecPos - 1
else
ADecPos := Length(S) - ADecPos;
if ADecPos > DecimalPlaces then
Exit;
end;
if Assigned(Field) and (Field.DataType in [ftFloat{, ftSingle, ftExtended}]) then
Result := TryStrToFloat(S, V)
else
Result := True;
end;
var
AEndPos, AStartPos: Integer;
S: string;
begin
Result := DecimalPlaces = 0;
if not Result then
begin
S := Text;
AStartPos := SelStart;
AEndPos := SelStart + SelLength;
// Prepare current Text as if the user typed his key, then check if still valid.
Delete(S, SelStart + 1, AEndPos - AStartPos);
Insert(Key, S, AStartPos + 1);
Result := IsValidText(S);
end;
end;
procedure TDecimalPlacesDBEdit.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
if (Key >= #32) and not IsValidChar(Key) then
begin
MessageBeep(0);
Key := #0;
end;
end;
end.

Params.asBlob assignment under FireDAC gives W1058

The FireDAC sample project (demonstrating ArrayDML) c:\Users\Public\Documents\Embarcadero\Studio\19.0\Samples\Object Pascal\Database\FireDAC\Samples\Comp Layer\TFDQuery\ExecSQL\Batch\Batch.dproj compiles with two // W1058 Implicit string cast with potential data loss from string to rawbytestring warnings on the Params[2].AsBlobs assignments indicated with //W 1058:
procedure TfrmBatch.btnExecSQLClick(Sender: TObject);
var
i: Integer;
iTm: LongWord;
begin
qrySelect.Open;
qrySelect.ServerDeleteAll(True);
qrySelect.Close;
with qryBatch do
if cbxBatchExec.Checked then begin
Params.ArraySize := StrToInt(edtArraySize.Text);
iTm := GetTickCount;
for i := 0 to Params.ArraySize - 1 do begin
Params[0].AsIntegers[i] := i;
Params[1].AsStrings[i] := 'string' + IntToStr(i);
Params[1].Size := 20;
if cbxInsertBlob.Checked then
Params[2].AsBlobs[i] := 'blob' + IntToStr(i); // W1058
end;
Execute(Params.ArraySize);
iTm := GetTickCount - iTm;
end
else begin
Params.ArraySize := 1;
iTm := GetTickCount;
for i := 0 to StrToInt(edtArraySize.Text) - 1 do begin
Params[0].AsInteger := i;
Params[1].AsString := 'string' + IntToStr(i);
Params[1].Size := 20;
if cbxInsertBlob.Checked then
Params[2].AsBlob := 'blob' + IntToStr(i); // W1058
ExecSQL;
end;
iTm := GetTickCount - iTm;
end;
StatusBar1.SimpleText := 'Time executing is ' + FloatToStr(iTm / 1000.0) + ' sec.';
qrySelect.Open;
end;
What is the correct way to solve this? (Under FireDAC the AsBlobs has changed to TFDByteString = RawByteString under Windows). Both a cast as RawByteString() or a Params[2].Value assignment make the compiler warning go away but I'm unsure it this won't lead to potential problems...
If you decide storing binary BLOB data in a String type variable, you can lose them, and by adding typecast to RawByteString before that parameter value assignment you just say the compiler, that you agree with a potential data loss. There's nothing more than that.
Correct way is storing your BLOB data in RawByteString type variable for such parameter.

Round TTime to nearest 15 minutes

I have the following function which I'm led to believe should round time to nearest 15 minutes.
function TdmData.RoundTime(T: TTime): TTime;
var h, m, s, ms : Word;
begin
DecodeTime(T, h, m, s, ms);
m := (m div 15) * 15;
s := 0;
Result := EncodeTime(h, m, s, ms);
end;
To test the function I have put a tbutton and a tedit on a form and at the click of the button I do:
begin
Edit1.Text := RoundTime('12:08:27');
end;
I get an error when compiling : 'Incompatible types TTime and string'
Any help with this would be great.
Thanks,
The error which causes the compilation failure is that you are passing a string to a function which needs a TTime as a parameter.
Once this is fixed, Edit1.Text needs a string type but your function returns TTime.
Using StrToTime and TimeToStr you can obtain the desired conversion from and to a string type.
Your function can be called like this:
begin
Edit1.Text := TimeToStr(RoundTime(StrToTime('12:08:27'));
end;
Stealing the gabr user's answer - In Delphi: How do I round a TDateTime to closest second, minute, five-minute etc? - you can obtain a date rounded to an arbitrary nearest value assigned to the interval parameter:
function RoundToNearest(time, interval: TDateTime): TDateTime;
var
time_sec, int_sec, rounded_sec: int64;
begin
time_sec := Round(time * SecsPerDay);
int_sec := Round(interval * SecsPerDay);
rounded_sec := (time_sec div int_sec) * int_sec;
if ((rounded_sec + int_sec - time_sec) - (time_sec - rounded_sec)) > 0 then
rounded_sec := rounded_sec + time_sec + int_sec;
Result := rounded_sec / SecsPerDay;
end;
begin
Edit1.Text := TimeToStr(RoundToNearest(StrToTime('12:08:27'), StrToTime('0:0:15')));
end;

Save Dbgrid Column Width Values to Ini and Reread them

I have Inherited form and a Ehlib dbgrid on it for selecting-listing records... The form is ready made for a lot of buttons and im using this form with different queries.
Like this...
If Dm.QrTmp.Active then Dm.QrTmp.Active:=False;
Dm.QrTmp.SQL.Clear;
Dm.QrTmp.SQL.Add(' SELECT ');
Dm.QrTmp.SQL.Add(' ch.cari_RECno AS KayitNo ');
Dm.QrTmp.SQL.Add(' FROM CARI_HESAPLAR ch ');
if FrmTmp=nil then FrmTmp:=TFrmTmp.Create(Self);
FrmTmp.StatusBar.Hide;
Dm.QrTmp.Open;
FrmTmp.DbGrid.DataSource:=Dm.DsQrTmp;
This query is cutted down but i have of course use a lot of fields. And Queries changes alot of time in the application.
The problem is column width. Manager wants to set column widths and restore them again. Actually my grid component supports save - restore column properties but as you can see my usage i m not using static columns. also i dont want to use xgrid.columns[0].width percent by percent.
Im using a ini in may app.
I want to add new section on it and named "Gridwidth"...
[Gridname]
Colwidths=x,y,z (where they are width values)
I'm now coding this line by line.
My write procedure is like this.
With dbgridx do
begin
For i:=0 to columns.count-1
begin
widthstr:=widthstr+Column[i].width+',';
end;
end;
Widthstr will be "15,23,45,67" etc...
But i want to know if this is good solution and if somebody know a better way and has some good code.
This should do it:
uses
IniFiles;
const
SETTINGS_FILE = 'Edijus\Settings.ini';
procedure TForm1.LoadDBGridColumnsWidth(const ADBGrid: TDBGrid);
var
_MemIniU: TMemIniFile;
_SettingsPath: string;
i, j: integer;
_ParentClass: TWinControl;
begin
_SettingsPath := GetHomePath + PathDelim + SETTINGS_FILE;
if (not Assigned(ADBGrid)) or (not Assigned(ADBGrid.DataSource)) or
(not Assigned(ADBGrid.DataSource.DataSet)) then
Exit;
_MemIniU := TMemIniFile.Create(_SettingsPath, TEncoding.UTF8);
try
_ParentClass := ADBGrid.Parent;
while not(_ParentClass is TForm) do
_ParentClass := _ParentClass.Parent;
for i := 0 to Pred(ADBGrid.DataSource.DataSet.Fields.Count) do
for j := 0 to Pred(ADBGrid.Columns.Count) do
begin
if (ADBGrid.DataSource.DataSet.Fields[i].FieldName = ADBGrid.Columns[j]
.FieldName) then
ADBGrid.Columns[j].Width :=
_MemIniU.ReadInteger(_ParentClass.Name + '_' + ADBGrid.Name,
ADBGrid.Columns[j].FieldName, 64);
end;
finally
FreeAndNil(_MemIniU);
end;
end;
procedure TForm1.SaveDBGridColumnsWidth(const ADBGrid: TDBGrid);
var
_MemIniU: TMemIniFile;
_SettingsPath: string;
i: integer;
_ParentClass: TWinControl;
begin
_SettingsPath := GetHomePath + PathDelim + SETTINGS_FILE;
if (not Assigned(ADBGrid)) or
(not ForceDirectories(ExtractFilePath(_SettingsPath))) then
Exit;
_MemIniU := TMemIniFile.Create(_SettingsPath, TEncoding.UTF8);
try
_ParentClass := ADBGrid.Parent;
while not(_ParentClass is TForm) do
_ParentClass := _ParentClass.Parent;
for i := 0 to Pred(ADBGrid.Columns.Count) do
if (ADBGrid.Columns[i].FieldName <> '') then
_MemIniU.WriteInteger(_ParentClass.Name + '_' + ADBGrid.Name,
ADBGrid.Columns[i].FieldName, ADBGrid.Columns[i].Width);
_MemIniU.UpdateFile;
finally
FreeAndNil(_MemIniU);
end;
end;

Resources