How can you get cxGrid to preform sorting in
Latin-2 (ISO-8859-2) encoding ?
I don't want the grid to be dependent on the regional settings of Windows.
Problem is that I am in Slovenia but I need sorting in Croatian language.
(Right now Ć,Č,Š are not sorted properly)
Can it be done ?
You could hook the OnCompare-event exposed by the DataController of the DBTableView for the cxGrid and implement the handler something like this:
procedure TMyForm.cxGrid1DBTableView1DataControllerCompare(
ADataController: TcxCustomDataController;
ARecordIndex1, ARecordIndex2, AItemIndex: Integer;
const V1, V2: Variant;
var Compare: Integer );
var
S1, S2 : String;
CompareResult: Integer;
begin
S1 := V1;
S2 := V2;
CompareResult := CompareStringW( LANG_CROATIAN, 0, pWideChar( S1 ), -1,
pWideChar( S2 ), -1 );
case CompareResult of
CSTR_LESS_THAN : Compare := -1;
CSTR_EQUAL : Compare := 0;
CSTR_GREATER_THAN : Compare := 1;
end;
end;
If S1 = 'Ć,Č,Š' and S2 = 'Č,Ć,Š' then S1 > S2, which I think is what is expected. If you switch to LOCALE_NEUTRAL you get the opposite result.
Care should be taken when casting V1 and V2 to strings as not all columns may cast in the desired way. Dates - for example - might need special treatment.
Also note, that CompareStringW return 0 if the function fails. A full implementation may have to deal with this.
Related
I need to check if N values are equals.
var
A, B, C, D : Integer;
begin
...
if(A = B) and (B = C) and (C = D) then
ShowMessage('Same value');
end;
Is there a shorter way to compare N values?
I mean something like:
var
A, B, C, D : Integer;
begin
...
if SameValue([A, B, C, D]) then
ShowMessage('Same value');
end;
Well, the best you can achieve is basically your own suggestion.
You would implement this using an open array parameter:
function AllEqual(const AValues: array of Integer): Boolean;
var
i: Integer;
begin
for i := 1 to High(AValues) do
if AValues[i] <> AValues[0] then
Exit(False);
Result := True;
end;
The correctness of this implementation is obvious:
If the number of values in the array is 0 or 1, it returns True.
Otherwise, and in general, it returns False iff the array contains two non-equal values.
AValues[0] is only accessed if High(AValues) >= 1, in which case the 0th value exists.
A function like this one is straightforward to implement for ordinal types. For real types (floating-point values), it becomes much more subtle, at least if you want to compare the elements with epsilons (like the SameValue function does in the Delphi RTL). Indeed, then you get different behaviour depending on if you compare every element against the first element, or if you compare every element against its predecessor.
Andreas' answer is correct, I'd like to add a different approach though:
uses Math;
function AllEqual(const AValues: array of Integer): Boolean;
begin
Result := (MinIntValue(AValues) = MaxIntValue(AValues));
end;
function AllEqualF(const AValues: array of Double; Epsilon: Double): Boolean;
begin
Result := ((MaxValue(AValues)- MinValue(AValues)) <= Epsilon);
end;
There is quite simple and very fast equality comparison approach for ints without a need of additional method and stuff like this - it's Bitwise Operators
And of course, this could be put in a method with open array or so.
There are even 2 options (or maybe more), with second you also can replace "or" to "+" , OR (not both, it will ruin equality-test logic) you can replace "xor" to "-" (last case)
BUT the resulting condition length is not shorter than original (only the last case is same and all brackets/parenthesis are vital, except first xor/-), here is the testing code:
program Project1;{$APPTYPE CONSOLE}
uses Math; var a, b, c, d, x : Integer; s: string;
begin
Randomize;
repeat
x := Random(10) - 5;
a := x + Sign(Random() - 0.5);
b := x + Sign(Random() - 0.5);
c := x + Sign(Random() - 0.5);
d := x + Sign(Random() - 0.5);
Writeln(a, ' ', b, ' ', c, ' ', d);
Writeln((A = B) and (B = C) and (C = D));
Writeln(a or b or c or d = a and b and c and d);
Writeln(a xor b or (b xor c) or (c xor d) = 0);
Writeln(a - b or (b - c) or (c - d) = 0);
Readln(s);
until s <> '';
end.
I have a TStringList in Delphi.
after the items are inserted i call .sort procedure to sort the items.
the Items are first names followed by last names. for example: "John Smith".
I want to sort the items by last name. I mean by the first character after the space.
how can I do this?
and also the items may be unicode strings like persian characters.
I'd use the CustomSort method of TStringList to supply a custom compare function. First of all, let's imagine that we have already got the compare function:
function NameCompareFunc(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := ...;
end;
This function will (in due course) return negative to mean less than, positive to mean greater than and zero to mean equal.
Then we sort the list like this:
List.CustomSort(NameCompareFunc);
So, that's the easy bit done. But how do we implement NameCompareFunc? First of all let's split the name into last name and the rest.
procedure SplitName(const Name: string; out Last, Rest: string);
var
P: Integer;
begin
P := Pos(' ', Name);
if P = 0 then begin
Last := Trim(Name);
Rest := '';
end else begin
Last := Trim(Copy(Name, P+1, MaxInt));
Rest := Trim(Copy(Name, 1, P-1));
end;
end;
This is a pretty naive way to split a name. You'd probably want to search for separators starting from the end of the name, but I'll let you decide how to do that.
Now we can implement the compare function:
function NameCompareFunc(List: TStringList; Index1, Index2: Integer): Integer;
var
Last1, Last2, Rest1, Rest2: string;
begin
SplitName(List[Index1], Last1, Rest1);
SplitName(List[Index2], Last2, Rest2);
Result := AnsiCompareText(Last1, Last2);
if Result = 0 then begin
Result := AnsiCompareText(Rest1, Rest2);
end;
end;
Some notes:
I'm assuming that name comparison should always be case-insensitive.
We use AnsiCompareText to perform locale aware comparison.
If we encounter two names that have the same last name, then we implement a secondary comparison o the rest of the name.
You could use the CustomSort methos of Stringlist:
function LastNameCompareStrings(List: TStringList; Index1, Index2: Integer): Integer;
var
S1, S2: string;
SpaceIndex: Integer;
begin
S1 := List[Index1];
SpaceIndex := Pos(' ', S1);
if SpaceIndex <> 0 then
S1 := Copy(S1, 1, SpaceIndex - 1);
S2 := List[Index2];
SpaceIndex := Pos(' ', S2);
if SpaceIndex <> 0 then
S2 := Copy(S2, 1, SpaceIndex - 1);
if List.CaseSensitive then
Result := AnsiCompareStr(S1, S2)
else
Result := AnsiCompareText(S1, S2);
end;
procedure TForm7.ButtonFirstNameClick(Sender: TObject);
begin
NameBuffer.Sort;
Memo1.Lines.Assign(NameBuffer);
end;
procedure TForm7.ButtonLastNameClick(Sender: TObject);
begin
NameBuffer.CustomSort(#LastNameCompareStrings);
Memo1.Lines.Assign(NameBuffer);
end;
I my example I have all your names in a StringList called NameBuffer. Then I've added two buttons to a form where I sort mylist, and display the result on the Screen.
You could iterate through each item of your StringList (lets call it FullNames),
split each string and put the "splits" in two new separate stringlists which you could call
FirstNameList and LastNameList.
Now create a third stringlist which you can call ReverseFirstLast,
and combine the items from LastNameList with FirstNameList and put them in ReverseNames.
Now you have all names in reverse order. Last name first, and first name last.
You can now sort the ReverseFirstLast-list and do a split&combine method again to reverse orders again and maintain the sorting.
That is one way to do it to get a rough method up and running.
I have a TStringList of Name/Value pairs. The names are all integer values 9stored as strings of course) and the values are all strings (comma separated).
e.g.
5016=Catch the Fish!,honeyman,0
30686=Ozarktree1 Goes to town,ozarktreel,0
.
.
.
I would like to call the add routine and add new lines in the TStringlist, but need a way to sort the list afterwards.
e.g.
Tags.Add(frmTag.edtTagNo.Text + '=' +
frmTag.edtTitle.Text + ',' +
frmTag.edtCreator.Text + ',' +
IntToStr(ord(frmTag.cbxOwned.Checked)));
Tags.Sort;
Here is what I tried:
Tags:= TStringList.Create;
Tags.CustomSort(StringListSortComparefn);
Tags.Sorted:= True;
my custom sort routine:
function StringListSortComparefn(List: TStringList; Index1, Index2: Integer): Integer;
var
i1, i2 : Integer;
begin
i1 := StrToIntDef(List.Names[Index1], 0);
i2 := StrToIntDef(List.Names[Index2], 0);
Result:= CompareValue(i1, i2);
end;
However, it still seems to be sorting them like strings instead of integers.
I even tried creating my own class:
type
TXStringList = class(TStringList)
procedure Sort;override;
end;
implementation
function StringListSortComparefn(List: TStringList; Index1, Index2: Integer): Integer;
var
i1, i2 : Integer;
begin
i1 := StrToIntDef(List.Names[Index1], 0);
i2 := StrToIntDef(List.Names[Index2], 0);
Result:= CompareValue(i1, i2);
end;
procedure TXStringList.Sort;
begin
CustomSort(StringListSortComparefn);
end;
I even tried some examples on SO (e.g. Sorting TSTringList Names property as integers instead of strings)
Can someone tell me what I am doing wrong? Everytime, the list gets sorted as strings and not as integers.
30686=Ozarktree1 Goes to town,ozarktreel,0
5016=Catch the Fish!,honeyman,0
You can do a simple integer subtraction:
function StringListSortComparefn(List: TStringList; Index1, Index2: Integer): Integer;
var
i1, i2 : Integer;
begin
i1 := StrToIntDef(List.Names[Index1], 0);
i2 := StrToIntDef(List.Names[Index2], 0);
Result := i1 - i2
end;
To reverse the sort order, simply reverse the operands in the subtraction:
Result := i2 - i1;
Here's a quick, compiilable console example:
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes;
function StringListSortProc(List: TStringList; Index1, Index2: Integer): Integer;
var
i1, i2: Integer;
begin
i1 := StrToIntDef(List.Names[Index1], -1);
i2 := StrToIntDef(List.Names[Index2], -1);
Result := i1 - i2;
end;
var
SL: TStringList;
s: string;
begin
SL := TStringList.Create;
SL.Add('3456=Line 1');
SL.Add('345=Line 2');
SL.Add('123=Line 3');
SL.Add('59231=Line 4');
SL.Add('545=Line 5');
WriteLn('Before sort');
for s in SL do
WriteLn(#32#32 + s);
SL.CustomSort(StringListSortProc);
WriteLn('');
WriteLn('After sort');
for s in SL do
WriteLn(#32#32 + s);
ReadLn;
SL.Free;
end.
And the resulting output:
Before sort
3456=Line 1
345=Line 2
123=Line 3
59231=Line 4
545=Line 5
After sort
123=Line 3
345=Line 2
545=Line 5
3456=Line 1
59231=Line 4
The question is, do you require the list to remain sorted? Or is it sufficient to sort it at the end, after all the items have been added.
If you just need to be able to sort the list as needed, you're first example is almost correct. You just need to call CustomSort at the end, after your items have been added.
Tags := tStringList . Create;
Tags . Add ( '5016=Catch the Fish!,honeyman,0' );
Tags . Add ( '30686=Ozarktree1 Goes to town,ozarktreel,0' );
Tags.CustomSort(StringListSortComparefn);
If you need the list to stay sorted, then you need to override CompareStrings.
type
TXStringList = class(TStringList)
function CompareStrings(const S1, S2: string): Integer; override;
end;
function NumberOfNameValue ( const S : string ) : integer;
begin
Result := StrToIntDef(copy(S,1,pos('=',S)-1), 0);
end;
function txStringList . CompareStrings ( const S1, S2 : string ) : integer;
var
i1, i2 : Integer;
begin
i1 := NumberOfNameValue ( S1 );
i2 := NumberOfNameValue ( S2 );
Result:= CompareValue(i1, i2);
end;
begin
Tags := txstringlist . Create;
Tags . Sorted := true;
Tags . Add ( '5016=Catch the Fish!,honeyman,0' );
Tags . Add ( '30686=Ozarktree1 Goes to town,ozarktreel,0' );
// List will be correctly sorted at this point.
end;
The CustomSort command is a one-time operation. You appear to be using it as though you're setting a property so that further sorting will use the custom comparison function, but that's not really how it works. It sorts the (newly created, empty) list once. Then, when you set the Sorted property, you re-sort the list using the default comparison, and you specify that any further additions to the list should be inserted using that default sort order.
When you override the Sort method, you're a little closer to a solution, but insertions to a sorted list (where Sorted=True) do not actually call Sort! Instead, they perform a binary search for the correct insertion location and then insert there. Instead of overriding Sort, you could try overriding CompareStrings:
type
TXStringList = class(TStringList)
protected
function CompareStrings(const S1, S2: string): Integer; override;
end;
function TXStringList.CompareStrings(const S1, S2: string): Integer;
var
i1, i2, e1, e2: Integer;
begin
Val(S1, i1, e1);
Assert((e1 = 0) or (S1[e1] = NameValueSeparator));
Val(S2, i2, e2);
Assert((e2 = 0) or (S2[e2] = NameValueSeparator));
Result := CompareValue(i1, i2);
end;
Beware that this will break the IndexOf method, though. It might also break Find, but you might want that, depending on how you want to treat elements with the same numeric key. (Find is what's used to locate the correct insertion point of a sorted list, and with the above code, it would treat all elements with the same key as equal.) They all use CompareStrings just like Sort does.
I came across the following (conceptually very simple) problem, and want to write code to do it, but am struggling. Let's say we have two rows of equal length, k. Each cell of each row can be either a 0 or a 1.
For e.g., consider the following row-pair, with k = 5: 01011, 00110
Now if the two rows could freely exchange values at each cell, there would be 2^5 possible combinations of row-pairs (some of which may not be unique). For instance, we could have 00010, 01111 as one possible row-pair from the above data. I want to write code in Delphi to list all the possible row-pairs. This is easy enough to do with a set of nested for-loops. However, if the value of k is known only at run-time, I'm not sure how I can use this approach for I don't know how many index variables I would need. I can't see how case statements will help either because I don't know the value of k.
I am hoping that there is an alternative to a nested for-loop, but any thoughts would be appreciated. Thanks.
Given two vectors A and B of length k, we can generate a new pair of vectors A1 and B1 by selectively choosing elements from A or B. Let our decision to choose from A or B be dictated by a bit vector S, also of length k. For i in [0..k), when Si is 0, store Ai in A1i and Bi in B1i. If Si is 1, then vice versa.
We can define that in Delphi with a function like this:
procedure GeneratePair(const A, B: string; S: Cardinal; out A1, B1: string);
var
k: Cardinal;
i: Cardinal;
begin
Assert(Length(A) = Length(B));
k := Length(A);
Assert(k <= 32);
SetLength(A1, k);
SetLength(B1, k);
for i := 1 to k do
if (S and (1 shl Pred(i))) = 0 then begin
A1[i] := A[i];
B1[i] := B[i];
end else begin
A1[i] := B[i];
B1[i] := A[i];
end;
end;
If we count in binary from 0 to 2k−1, that will give us a sequence of bit vectors representing all the possible combinations of exchanging or not-exchanging characters between A and B.
We can write a loop and use the above function to generate all 2k combinations:
A := '01011';
B := '00110';
for S := 0 to Pred(Round(IntPower(2, Length(A)))) do begin
GeneratePair(A, B, S, A1, B1);
writeln(A1, ', ', B1);
end;
That effectively uses one set of nested loops. The outer loop is the one from 0 to 31. The inner loop is the one inside the function from 1 to k. As you can see, we don't need to know the value of k in advance.
Now that, thanks to Rob, I understand the problem, I offer this recursive solution:
{$APPTYPE CONSOLE}
procedure Swap(var A, B: Char);
var
temp: Char;
begin
temp := A;
A := B;
B := temp;
end;
procedure Generate(const A, B: string; Index: Integer);
var
A1, B1: string;
begin
Assert(Length(A)=Length(B));
inc(Index);
if Index>Length(A) then // termination
Writeln(A, ', ', B)
else
begin // recurse
// no swap
Generate(A, B, Index);
//swap
A1 := A;
B1 := B;
Swap(A1[Index], B1[Index]);
Generate(A1, B1, Index);
end;
end;
begin
Generate('01011', '00110', 0);
Readln;
end.
In Delphi, it is possible to create an array of the type
var
Arr: array[2..N] of MyType;
which is an array of N - 1 elements indexed from 2 to N.
If we instead declare a dynamic array
var
Arr: array of MyType
and later allocate N - 1 elements by means of
SetLength(Arr, N - 1)
then the elements will be indexed from 0 to N - 2. Is it possible to make them indexed from 2 to N (say) instead?
No, in Delphi dynamic arrays are always indexed from zero.
YES! By using a trick!First declare a new type. I use a record type instead of a class since records are a bit easier to use.
type
TMyArray = record
strict private
FArray: array of Integer;
FMin, FMax:Integer;
function GetItem(Index: Integer): Integer;
procedure SetItem(Index: Integer; const Value: Integer);
public
constructor Create(Min, Max: integer);
property Item[Index: Integer]: Integer read GetItem write SetItem; Default;
property Min: Integer read FMin;
property Max: Integer read FMax;
end;
With the recordtype defined, you now need to implement a bit of code:
constructor TMyArray.Create(Min, Max: integer);
begin
FMin := Min;
FMax := Max;
SetLength(FArray, Max + 1 - Min);
end;
function TMyArray.GetItem(Index: Integer): Integer;
begin
Result := FArray[Index - FMin];
end;
procedure TMyArray.SetItem(Index: Integer; const Value: Integer);
begin
FArray[Index - FMin] := Value;
end;
With the type declared, you can now start to use it:
var
Arr: TMyArray;
begin
Arr := TMyArray.Create(2, 10);
Arr[2] := 10;
It's actually a simple trick to create arrays with a specific range and you can make it more flexible if you like. Or convert it to a class. Personally, I just prefer records for these kinds of simple types.
The only thing that you can do that mimics this behaviour is using pointers..
type
TMyTypeArr = array [ 0..High(Integer) div sizeof( MyType ) - 1 ] of Mytype;
PMyTypeArr = ^TMyTypeArr;
var
x: ;
A: PMyTypeArr;
begin
SetLength( A, 2 );
x := PMyTypeArr( #A[ 0 ] ); Dec( PMyType( x ), 2 ); // now [2,4> is valid.
x[2] := Get_A_MyType();
end;
Please note that you lose any range checking, and combine that with non zero starting arrays is a VERY VERY bad idea!
If you really need this indexing, then you could write a simple "translation" function, which will receive an index figure in the range from 2 to N and will return an index from 0 to N-2, just by subtracting 2 from the parameter, for example:
function translate(i : integer) : integer;
begin
result := i - 2;
end;
And you could call your array like this:
array[translate(2)]
Of course, you could in addition do range checking within the function, and maybe you could give it a shorter name.
Or even better, wrap the whole access to the array with a function like this:
function XYZ(i : integer) : MyType;
begin
// Do range checking here...
result := MyArray[i - 2];
end;
Hope this helps