sorting - Descending List box Items Delphi XE8 -


i reviewing questions how sort list box items in descending sequence. seem default , sequence ascending. have availability of collection of string (tstringlist).

it seems me if insert sort target collection list, perform sort (in ascending order) access sorted items in descending order , add them unsorted list box item after key stripped off, receive desired descending effect.

procedure tbcslbdemoc.descendlzb(var lb: tlistbox); var   sc: tstringlist;   i: integer;   rdt: tdatetime;   buf : string; begin   sc := tstringlist.create;   := 0;   repeat     rdt := tfile.getlastaccesstime(lb.items[i]);     sc.add(formatdatetime('yyyymmddhhmmss', rdt) + ' ' + lb.items[i]);     inc(i);   until (i > (lb.count - 1));   sc.sort;   lb.sorted := false;   lb.items.clear;   := sc.count - 1;   repeat     buf := sc[i];     delete(buf, 1, 15);     lb.items.add(buf);     dec(i);   until (i < 0);   sc.free; end; 

these results seemed work fine me question how improve upon technique? believe have overlooked something.,

there many different ways tackle problem. have shown 1 method. switch virtual list box , store data in data structure kept ordered. sort list in-place.

personally feel little queasy looking @ code creates new list perform sorting. , more queasy use of text representations of time stamp. if you've got large number of items in list virtual mode more efficient.

however, i'll demonstrate flexible way sort list in-place. let's start code answer here: https://stackoverflow.com/a/21702570/505088. sake of being self-contained let's reproduce code here, modified use reference procedures:

type   tcompareindicesfunction = reference function(index1, index2: integer): integer;   texchangeindicesprocedure = reference procedure(index1, index2: integer);  procedure quicksort(count: integer; compare: tcompareindicesfunction;    exchange: texchangeindicesprocedure);    procedure sort(l, r: integer);   var     i, j, p: integer;   begin     repeat       := l;       j := r;       p := (l+r) div 2;       repeat         while compare(i, p)<0 inc(i);          while compare(j, p)>0 dec(j);          if i<=j          begin           if i<>j            begin             exchange(i, j);             //may have moved pivot must remember element             if p=i               p := j             else if p=j               p := i;           end;           inc(i);           dec(j);         end;       until i>j;       if l<j          sort(l, j);        l := i;     until i>=r;   end;  begin   if count>0     sort(0, count-1); end; 

the key idea here sorting algorithm separated data storage. gives flexibility.

next need implement compare , exchange functions. this:

var   compare: tcompareindicesfunction;   exchange: texchangeindicesprocedure;  compare :=    function(index1, index2: integer): integer   var     dt1, dt2: tdatetime;   begin     dt1 := tfile.getlastaccesstime(lb.items[index1]);     dt2 := tfile.getlastaccesstime(lb.items[index2]);     if dt1=dt2 begin       result := 0;     end else if dt2<dt1 begin       result := -1     end else begin       result := 1;     end;   end;  exchange :=    procedure(index1, index2: integer)   begin     lb.items.exchange(index1, index2);   end; 

note i'm comparing numeric value of time stamp feels more pleasing. if i've got order front (i struggle sort compare functions) should obvious how reverse it.

and can sort this:

quicksort(lb.count, compare, exchange); 

this code should placed inside descendlzb can capture list box. furthermore, lb parameter should not var parameter because don't want modify value.

all this:

procedure tbcslbdemoc.descendlzb(lb: tlistbox); var   compare: tcompareindicesfunction;   exchange: texchangeindicesprocedure; begin   compare :=      function(index1, index2: integer): integer     var       dt1, dt2: tdatetime;     begin       dt1 := tfile.getlastaccesstime(lb.items[index1]);       dt2 := tfile.getlastaccesstime(lb.items[index2]);       if dt1=dt2 begin         result := 0;       end else if dt2<dt1 begin         result := -1       end else begin         result := 1;       end;     end;    exchange :=      procedure(index1, index2: integer)     begin       lb.items.exchange(index1, index2);     end;   end;    quicksort(lb.count, compare, exchange); end; 

Comments

Popular posts from this blog

html - Outlook 2010 Anchor (url/address/link) -

javascript - Why does running this loop 9 times take 100x longer than running it 8 times? -

Getting gateway time-out Rails app with Nginx + Puma running on Digital Ocean -