I am trying to add following values to
procedure TForm1.FormCreate(Sender: TObject);
var
md: TDictionary<string, string>;
s, v: string;
begin
md := TDictionary<string, string>.Create;
try
s := 'orange';
v := 'fruit';
md.Add(s, v);
s := 'orange ';
v := 'color';
md.Add(s, v);
ShowMessage(IntToStr(md.Count));
finally
md.Free;
end;
end;
I know this is duplicate but if you look at second orange, you can see a space at the end. I think Delphi trims the value but it shouldn't.
Does anyone know solution of this problem?
Thanks,
This code shows a message box containing the number 2 on all known versions of Delphi. That is exactly as is expected and the TDictionary code most certainly does not trim your keys when comparing for equality.
Related
I have dbgrid which display column subtotal and column percentage, how to display column percentage from this formula : (subtotal / grandtotal) * 100% ? for detail information please see below picture
I couldnt modify my SQL, because my SQL is very complicated, so i think solution maybe use calculated field, doesnt it? Could someone help me to solve this problem.
Thanks in advanced.
The following assumes that your dataset doesn't actually contain the last row you've shown, the one that contains "111077, 100" - if it does, then the steps I show below to calculate the GrandTotal are unnecessary, and you only need to populate the Percent calculated field, which is trivial.
If your DataSet is a TClientDataSet, you can implement the Percent values quite easily using the
combination of a TAggregateField to represent the GrandTotal and a calculated field to represent each data row's contribution towards the GrandTotal. See code below.
If you are not using a TClientDataSet already then you have several options,
including
If your DataSet is of a type which supports aggregate fields then you can do the equivalent of the code below.
Use your existing DataSet as the dataset source of a TDataSetProvider, and use the TDataSetProvider as the Provider of a TClientDataSet and use the TClientDataSet to supply the data to your grid.
Don't use a TClientDataSet and/or TAggregateField and instead do similar to what is shown below with your existing DataSet, but make the Percent field an fkInternalCalc field if your DataSet type supports it, or an fkCalculated one if not, omit the GrantTotal TAggregateField field and calculate the GrandTotal in code. One way to do this would be to calculate it by a once-only traversal of the dataset (while not DataSet.Eof ...) after you open it.
In the code below, I've created all the fields in code, rather than using the Object Inspector's Fields editor, so you can easily see exactly what are the minimum settings necessary to get a TAggregateField to work.
Note: I could be wrong but don't think you could get a standard TDBGrid to display the final, 100%, row of your screenshot. Somthething similar could be done using the Developer Express TcxGrid, amongst others, but if you need a TDBGrid to do this, you should ask how to in a new question.
Code
TForm1 = class(TForm)
CDS: TClientDataSet;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
procedure CDSCalcFields(DataSet: TDataSet);
procedure FormCreate(Sender: TObject);
private
CDSID : TIntegerField;
CDSTotal : TCurrencyField;
CDSPercent : TFloatField;
CDSGrandTotal : TAggregateField;
public
procedure SetUp;
end;
[...]
procedure TForm1.SetUp;
var
i : Integer;
begin
CDSID := TIntegerField.Create(Self);
CDSID.FieldName := 'ID';
CDSID.FieldKind := fkData;
CDSID.DataSet := CDS;
CDSTotal := TCurrencyField.Create(Self);
CDSTotal.FieldName := 'Total';
CDSTotal.FieldKind := fkData;
CDSTotal.DataSet := CDS;
CDSPercent := TFloatField.Create(Self);
CDSPercent.FieldName := 'Percent';
CDSPercent.FieldKind := fkInternalCalc;
CDSPercent.DataSet := CDS;
CDSGrandTotal := TAggregateField.Create(Self);
CDSGrandTotal.FieldName := 'GrandTotal';
CDSGrandTotal.FieldKind := fkAggregate;
CDSGrandTotal.Expression := 'Sum(Total)';
CDSGrandTotal.DataSet := CDS;
CDSGrandTotal.Active := True;
CDS.OnCalcFields := CDSCalcFields;
CDS.IndexFieldNames := 'ID';
CDS.CreateDataSet;
for i := 1 to 2 do begin
CDS.InsertRecord([i, i]);
end;
CDS.First;
end;
procedure TForm1.CDSCalcFields(DataSet: TDataSet);
var
Value : Double;
V : Variant;
begin
V := CDSGrandTotal.Value;
if not VarIsNull(V) then begin
Value := CDSTotal.AsFloat;
Value := Value * 100 / V;
CDSPercent.Value := Value;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SetUp;
end;
in Delphi the procedure write can handle:
write(TF,st1)
and
write(TF,st1,st2,st3,st4);
I want to declare a procedure that can also do that, what is the syntax?
and the option of:
write(TF,[st1,st2,st3])
is less desirable, though I know how to do that.
the main purpose was to pass ShortStrings into function, that would make a read call from file, and would read at the length of the shortString as defined. however after passing it as variant or in open array the shortString loses its "size" and become 255, which making this pass unusable, for me.
but the answer is still got if you want to pass open array.
Just to complement Cosmin's answer: if the list of parameters are of different types, you could use an variant open array parameter (also know as "array of const"). More on Delphi documentation.
Example (from documentation):
function MakeStr(const Args: array of const): string;
var
I: Integer;
begin
Result := '';
for I := 0 to High(Args) do
with Args[I] do
case VType of
vtInteger: Result := Result + IntToStr(VInteger);
vtBoolean: Result := Result + BoolToStr(VBoolean);
vtChar: Result := Result + VChar;
vtExtended: Result := Result + FloatToStr(VExtended^);
vtString: Result := Result + VString^;
vtPChar: Result := Result + VPChar;
vtObject: Result := Result + VObject.ClassName;
vtClass: Result := Result + VClass.ClassName;
vtAnsiString: Result := Result + string(VAnsiString);
vtCurrency: Result := Result + CurrToStr(VCurrency^);
vtVariant: Result := Result + string(VVariant^);
vtInt64: Result := Result + IntToStr(VInt64^);
end;
end;
First of all Inc and Write are bad examples because they both get special treatment from the compiler. You can't write a function that behaves exactly like those two do yourself. There are alternatives you should investigate.
Take a look at overloads
You can create multiple versions of your method using varying number of parameters, and varying types. Something like this:
procedure MyInc(var i:Integer); overload;
procedyre MyInc(var i:Integer; const N:Integer); overload;
procedure MyInc(var i:Integer; const N1, N2: Integer); overload;
procedure MyInc(var i:Integer; const N1, N2, N3: Integer):overload;
This is feasible if the required number of overloads is not that large. The compiler would probably handle lots of overloads easily, but you'd probably not want to write them. When the number of overloads becomes a problem you can switch to arrays:
Using Open Arrays as parameters
A function can take a parameter of type array of YourType, and when you call that function you can pass as many parameters as you might need:
procedure MyInc(var i:Integer; Vals: array of Integer);
And then use it like this:
MyInc(i, []); // no parameters
MyInc(i, [1]);
MyInc(i, [1, 34, 43, 12]);
For ilustrative purposes only:
Delphi supports a way of writing "real" variable arguments functions, but it is really cumbersome and intended for use mainly for declaring external C functions with variable arguments like printf, as it involves playing some low-level dirty tricks for accessing the arguments in the stack.
It involves using cdecl and varargs modifiers:
procedure MyWrite_; cdecl;
begin
... some magic here ...
end;
var
MyWrite: procedure; cdecl varargs = MyWrite_;
begin
MyWrite(1);
MyWrite(1, 2);
MyWrite(1, 2, 3);
end;
More detailed explanation can be found in the answer from Barry Kelly to How can a function with 'varargs' retrieve the contents of the stack?
So I'm working in Delphi 2007 and I am cleaning up my code. I have come to notice that in a great many procedures I declare a number of different variables of the same type.
for example the one procedure I am looking at now I declare 4 different string lists and I have to type var1 := TStringList.Create for each one.
I had the idea to make a procedure that took in an open array of variables, my list of 4 variables and then create them all. The call would be something like this
CreateStringLists([var1,var2,var3,var4]);
But as to my knowledge you cannot pass the open array by reference and therefore not do what I was hoping to. Does anyone have any interesting ideas about this?
Often in refactoring you need to take a very wide view of the code. Why "cleanup" a couple of operations like this, when most likely you shouldn't be doing any of these operations at all?
In this case, it seems suspicous to me that you have one routine that needs to deal with 4 separate string lists. That doesn't seem very likely to have good cohesion. Perhaps instead it should be one string list-handling routine called four times. So I'd really like to see the entire routine, rather than comment on how to make this one nit in it prettier.
You can do anything (or nearly anything) with Delphi. I don't recommend the following code to use, just to know that the trick is possible:
type
PStringList = ^TStringList;
procedure CreateStringLists(const SL: array of PStringList);
var
I: Integer;
begin
for I:= 0 to High(SL) do begin
SL[I]^:= TStringList.Create;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
SL1, SL2, SL3: TStringList;
begin
CreateStringLists([#SL1, #SL2, #SL3]);
SL3.Add('123');
Caption:= SL3[0];
SL1.Free;
SL2.Free;
SL3.Free;
end;
Actually, what's the problem with 4 constructors?
If it makes sense in your context, you can aggregate declarations inside a specialized TObjectList.
type
TMyList<T:class,constructor> = class(TObjectList<T>)
public
procedure CreateItems(const ACount : integer);
end;
procedure TMyList<T>.CreateItems(const ACount: integer);
var
Index: Integer;
begin
for Index := 0 to (ACount - 1) do Add(T.Create);
end;
// Test procedure
procedure TestMe;
var
MyStringsList : TMyList<TStringList>;
begin
MyStringsList := TMyList<TStringList>.Create(True);
MyStringsList.CreateItems(10);
// ...
FreeAndNil(MyStringsList);
end;
So you can specialized your list.
You could create a series of overloaded versions with 2, 3, 4 etc. parameters. For example:
procedure CreateStringLists(var L1, L2: TStringList); overload;
procedure CreateStringLists(var L1, L2, L3: TStringList); overload;
procedure CreateStringLists(var L1, L2, L3, L4: TStringList); overload;
procedure CreateStringLists(var L1, L2: TStringList);
begin
L1 := nil;
L2 := nil;
Try
L1 := TStringList.Create;
L2 := TStringList.Create;
Except
FreeAndNil(L2);
FreeAndNil(L1);
raise;
End;
end;
// etc.
If I were doing this, I'd write a script to generate the code.
As an aside, in my own code, I would write InitialiseNil(L1, L2) at the start of that function, and FreeAndNil(L2, L1) in the exception handler. InitialiseNil and FreeAndNil are functions generated by a very simple Python script that is included in the codebase as a comment so that it can be re-run. A routine like CreareStringLists as defined above is only useful if you have a matching routine to free them all in one shot. This allows you to write:
CreateStringLists(L1, L2);
Try
// do stuff with L1, L2
Finally
FreeAndNil(L2, L1);
End;
Finally, I'm not saying that I would necessarily do this, but this is meant as a naive and direct answer to the question. As #T.E.D. states, the need to do this suggests deeper problems in the codebase.
I'm doing some heavy work on large integer numbers in UInt64 values, and was wondering if Delphi has an integer square root function.
Fow now I'm using Trunc(Sqrt(x*1.0)) but I guess there must be a more performant way, perhaps with a snippet of inline assembler? (Sqrt(x)with x:UInt64 throws an invalid type compiler error in D7, hence the *1.0 bit.)
I am very far from an expert on assembly, so this answer is just me fooling around.
However, this seems to work:
function isqrt(const X: Extended): integer;
asm
fld X
fsqrt
fistp #Result
fwait
end;
as long as you set the FPU control word's rounding setting to "truncate" prior to calling isqrt. The easiest way might be to define the helper function
function SetupRoundModeForSqrti: word;
begin
result := Get8087CW;
Set8087CW(result or $600);
end;
and then you can do
procedure TForm1.FormCreate(Sender: TObject);
var
oldCW: word;
begin
oldCW := SetupRoundModeForSqrti; // setup CW
// Compute a few million integer square roots using isqrt here
Set8087CW(oldCW); // restore CW
end;
Test
Does this really improve performance? Well, I tested
procedure TForm1.FormCreate(Sender: TObject);
var
oldCW: word;
p1, p2: Int64;
i: Integer;
s1, s2: string;
const
N = 10000000;
begin
oldCW := SetupRoundModeForSqrti;
QueryPerformanceCounter(p1);
for i := 0 to N do
Tag := isqrt(i);
QueryPerformanceCounter(p2);
s1 := inttostr(p2-p1);
QueryPerformanceCounter(p1);
for i := 0 to N do
Tag := trunc(Sqrt(i));
QueryPerformanceCounter(p2);
s2 := inttostr(p2-p1);
Set8087CW(oldCW);
ShowMessage(s1 + #13#10 + s2);
end;
and got the result
371802
371774.
Hence, it is simply not worth it. The naive approach trunc(sqrt(x)) is far easier to read and maintain, has superior future and backward compatibility, and is less prone to errors.
I believe that the answer is no it does not have an integer square root function and that your solution is reasonable.
I'm a bit surprised at the need to multiple by 1.0 to convert to a floating point value. I think that must be a Delphi bug and more recent versions certainly behave as you would wish.
This is the code I end up using, based on one of the algorhythms listed on wikipedia
type
baseint=UInt64;//or cardinal for the 32-bit version
function isqrt(x:baseint):baseint;
var
p,q:baseint;
begin
//get highest power of four
p:=0;
q:=4;
while (q<>0) and (q<=x) do
begin
p:=q;
q:=q shl 2;
end;
//
q:=0;
while p<>0 do
begin
if x>=p+q then
begin
dec(x,p);
dec(x,q);
q:=(q shr 1)+p;
end
else
q:=q shr 1;
p:=p shr 2;
end;
Result:=q;
end;
This is not exactly a straight-out question because I have just solved it, but more like "am I getting it right" type of question and a reminder for those who might get stuck into that.
Turns out, Delphi does not align variables on stack and there are no directives/options to control this behavior. Default COM marshaller on my XP SP3 seem to require 4-byte alignment when marshaling records though. Worse, when it encounters unaligned pointer, it does not return an error, oh no: it rounds the pointer down to the nearest 4-byte boundary and continues like that.
Therefore, if you pass a record you have allocated on stack into COM-marshaled function by reference, you're screwed and you won't even know.
The problem can be solved by using New/Dispose to allocate records, as memory managers tend to align everything at 8 bytes or better, but god, this is annoying, both the misalignment part and the "trim-down-pointers" part.
Is this really the reason, or am I wrong somewhere?
Update: How to reproduce (Delphi 2007 for Win32).
uses SysUtils;
type
TRec = packed record
a, b, c, d, e: int64;
end;
TDummy = class
protected
procedure Proc(param1: integer);
end;
procedure TDummy.Proc(param1: integer);
var a, b, c: byte;
rec: TRec;
begin
a := 5;
b := 9;
c := 100;
rec.a := param1;
rec.b := a;
rec.c := b;
rec.d := c;
writeln(IntToHex(integer(#rec), 8));
readln;
end;
var Obj: TDummy;
begin
obj := TDummy.Create;
try
obj.Proc(0);
finally
FreeAndNil(obj);
end;
end.
This gives odd result address, clearly not aligned on anything. If it doesn't, try adding more byte variables to "a, b, c: byte" (and don't forget to simulate some work with them at the end of the function).
The part with COM is easier to reproduce but longer to explain. Create a new VCL app called Sample Server, add a COM object SampleObject implementing ISampleObject, with a type library, free-threaded, single instance (make sure to check ISampleObject is marked as Ole Automation in type library). Open the type library, declare a new SampleRecord with five __int64 fields. Add a SampleFunction with a single SampleRecord* out parameter to ISampleObject. Implement SampleFunction in TSampleObject by returning fixed values:
function TSampleObject.SampleFunction(out rec: SampleRecord): HResult;
begin
rec.a := 1291;
rec.b := 742310;
//...
Result := S_OK;
end;
Note how Delphi declares SampleRecord as "packed record" in automatically generated type library header code:
SampleRecord = packed record
a: Int64;
b: Int64;
//...
end;
I have checked, and this, at least, was fixed in Delphi 2010. Automatically generated records are not packed there.
Register the COM server. Run it.
Now modify the source above (sample 1) to call this server instead of just doing writeln:
uses SysUtils, Windows, ActiveX, SampleServer_TLB;
procedure TDummy.Proc(param1: integer);
var a, b, c: byte;
rec: SampleRecord;
Server: ISampleObject;
begin
a := 5;
b := 9;
c := 100;
rec.a := param1;
rec.b := a;
rec.c := b;
rec.d := c;
Server := CoSampleObject.Create;
hr := Server.SampleFunction(rec);
writeln('#: 'IntToHex(integer(#rec), 8)+', rec.a='+IntToStr(rec.a));
readln;
end;
var Obj: TDummy;
begin
CoInitializeEx(nil, COINIT_MULTITHREADED);
obj := TDummy.Create;
try
obj.Proc(0);
finally
FreeAndNil(obj);
CoUninitialize();
end;
end.
Observe that when the address of rec is not aligned, values of rec fields are wrong (specifically, bitshifted to 8, 16 or 24 bits, sometimes wrapped over to the next value).
Do you have an example of the stack being misaligned? Delphi should be aligning everything to 4 byte boundaries. The only case I can think of that would cause misalignment is if someplace along the call-chain is some assembler code that has explicitly done something to the stack to mis-align it.