procedure CompareVSTNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode;
Column: TColumnIndex; var Result: Integer);
var
Data1, Data2: PVTData;
// HELPER FUNCTIONS
//
function CompareTextAsIPAddress(const s1, s2: string): integer;
function CompareIPs(AString1, AString2: string): integer;
// Modified original source: http:www.delphipages.com/forum/showthread.php?t=104191
// Also on http://forum.lazarus.freepascal.org/index.php/topic,23656.msg141508.html#msg141508
var
a, b: TInAddr;
begin
//
a := StrToHostAddr(PChar(AString1));
b := StrToHostAddr(PChar(AString2));
//
if ntohl(a.S_addr) > ntohl(b.S_addr) then
Result := -1
else if ntohl(a.S_addr) < ntohl(b.S_addr) then
Result := 1
else
Result := 0;
end;
begin
Result := CompareIPs(s1, s2);
end;
function CompareTextAsInteger(const s1, s2: string): Integer;
begin
Result := CompareValue(StrToInt(s1), StrToInt(s2));
end;
function CompareTextAsFloat(const s1, s2: string): Integer;
begin
Result := CompareValue(StrToFloat(s1), StrToFloat(s2));
end;
function CompareTextAsDateTime(const s1, s2: string): Integer;
begin
Result := CompareDateTime(StrToDateTime(s1), StrToDateTime(s2));
end;
// Source: http://delphiheaven.blogspot.fr/2007/03/check-if-string-is-valid-ip-address.html
function ValidateIP(IP4: string): Boolean; // Coding by Dave Sonsalla
var
Octet : String;
Dots, I : Integer;
begin
IP4 := IP4 + '.'; // add a dot. We use a dot to trigger the Octet check, so need the last one
Dots := 0;
Octet := '0';
//
for I := 1 To Length(IP4) do
begin
if IP4[I] in ['0'..'9', '.'] then
begin
if IP4[I] = '.' then // found a dot so inc dots and check octet value
begin
Inc(Dots);
//
if (length(Octet) = 1) or (StrToInt(Octet) > 255) then Dots := 5; // Either there's no number or it's higher than 255 so push dots out of range
Octet := '0'; // Reset to check the next octet
end // End of IP4[I] is a dot
else // Else IP4[I] is not a dot so
Octet := Octet + IP4[I]; // Add the next character to the octet
end // end of IP4[I] is not a dot
else // else IP4[I] Is not in CheckSet so
Dots := 5; // Push dots out of range
end;
Result := (Dots = 4) // The only way that Dots will equal 4 is if we passed all the tests
end;
function IsValidIntegerCheck(const AValue: String): Boolean;
var
intTemp: integer;
begin
Result := TryStrToInt(AValue, intTemp);
end;
function IsValidFloatCheck(const AValue: String): Boolean;
var
intTemp: float;
begin
Result := TryStrToFloat(AValue, intTemp);
end;
function IsValidDateTimeCheck(const AValue: String): Boolean;
var
dtTemp: TDateTime;
begin
Result := False;
//
if Length(AValue) = 10 then begin
if (AValue[3] = '/') and (AValue[6] = '/') then
Result := TryStrToDate(AValue, dtTemp);
end
else if Length(AValue) = 19 then begin
if (AValue[14] = ':') and (AValue[17] = ':') then
Result := TryStrToDateTime(AValue, dtTemp);
end;
end;
begin
//
Data1 := Sender.GetNodeData(Node1);
Data2 := Sender.GetNodeData(Node2);
//ShowMessage('Column: ' + IntToStr(Column));
// SUDDENLY DOES NOT WORK ANYMORE!! IS THIS A "FEATURE" OF VirtualTrees?
try
// TO BE COMPLETED
if IsValidIntegerCheck(Data1^.RowData[Column]) then
Result := CompareTextAsInteger(Data1^.RowData[Column], Data2^.RowData[Column])
else if IsValidFloatCheck(Data1^.RowData[Column]) then
Result := CompareTextAsFloat(Data1^.RowData[Column], Data2^.RowData[Column])
else if IsValidDateTimeCheck(Data1^.RowData[Column]) then
Result := CompareTextAsDateTime(Data1^.RowData[Column], Data2^.RowData[Column])
else if IsValidDateTimeCheck(Data1^.RowData[Column]) then
Result := CompareTextAsDateTime(Data1^.RowData[Column], Data2^.RowData[Column])
else if ValidateIP(Data1^.RowData[Column]) then
Result := CompareTextAsIPAddress(Data1^.RowData[Column], Data2^.RowData[Column])
else
Result := Utf8CompareText(UTF8UpperCase(Data1^.RowData[Column]), UTF8UpperCase(Data2^.RowData[Column]));
except
// Default result
Result := 0;
end;
end;
Recent
