Forum > Lazarus Extra Components

[SOLVED] Sorting a virtual string tree's columns

(1/4) > >>

JD:
Hi there everyone,

I have the following code in OnCompareNodes for sorting a virtual string tree. I want to click on any column header and sort the column using this code but I keep getting a range check error on the test.


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---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; 

When I investigated, I found out that the value of Column is -1.

Can anyone help me figure out what I am doing wrong?

Thanks a lot,

JD

Thaddy:
The virtual controls can be seen as a window on a usually larger set of data, often on a storage medium.
Hence for sort to work, you need to sort the - ALL - data, e.g. if the underlying storage is a database, you sort the database, which makes the virtual tree or virtual list also sorted.
The speed from the virtual controls comes from the fact that they only process a little part from a larger data collection.

So I am not surprised it doesn't work by using treeview methods.

If your data is small, don't use the virtual controls.

But maybe there are other options. I don't use these particular controls very much.

balazsszekely:
@JD

--- Quote ---I have the following code in OnCompareNodes for sorting a virtual string tree.
--- End quote ---
First you have to implement the OnHeaderClick event, where you should call the SortTree method, which internally will call the compare nodes event. The OnHeaderClick typically looks like this:

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TSomeClass.VSTHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);begin  if HitInfo.Button = mbLeft then  begin    with Sender, Treeview do    begin      if (SortColumn = NoColumn) or (SortColumn <> HitInfo.Column) then      begin        SortColumn    := HitInfo.Column;        SortDirection := sdAscending;      end      else      begin        if SortDirection = sdAscending then          SortDirection := sdDescending        else          SortDirection := sdAscending;        FSortDir := SortDirection;      end;      SortTree(SortColumn, SortDirection, False);      FSortCol := Sender.SortColumn;    end;  end;end;  
You can modify it according to your needs. Private properties FSortDir, FSortCol are used for later reference, not needed for the sort itself.

Thaddy:
Beware of side-effect, though. If you start scrolling funny things may happen. It is only a visual sort.
Out of order inserts may lead to a complete re-sort and a noticeable slowdown.

balazsszekely:
@Thaddy
After all this years, I'm still perplexed by your uncontrollable urge to reply in every single thread, even when you admit that the actual subject is not your strong point:

--- Quote ---I don't use these particular controls very much.
--- End quote ---

I'm not judging you in any way, just don't understand your motivations.

Navigation

[0] Message Index

[#] Next page

Go to full version