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
Post a Comment