Listview sort

I need to sort a list view by columnclick.

I have 3 columns.
1st column is string
2nd column is date (string)
3rd coulmn is numbers (string)
QC20NAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

cyberkiwiCommented:
Use this idea
http://delphi.about.com/od/adptips2005/qt/qtsortlistview.htm

Store a private field on the form, say listSortCol, then onclick, set the listSortCol to the clicked col index

procedure TForm1.ListView1Compare(Sender: TObject; Item1,
  Item2: TListItem; Data: Integer; var Compare: Integer);
var
  n1, n2: string;
begin
  n1 := Item1.SubItems[listSortCol];
  n2 := Item2.SubItems[listSortCol];
  if n1 > n2 then
    Compare := -1
  else if n1 < n2 then
    Compare := 1
  else
    Compare := 0;
end;

In column header click, set twice to resort
ListView1.SortType := stNone;
ListView1.SortType := stText;
0
Geert GOracle dbaCommented:
i posted a complete utility unit once for listview
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_23629194.html#a22180865

you would need to use the sortcolumns procedure when clicking on the title


0
Emmanuel PASQUIERFreelance Project ManagerCommented:
Excellent Geert ! I take that in my tool box just in case.

I improved a little the compare functions, here they are if you want them (I use a function to treat the case where one or 2 of the strings are empty, in all other compare functions)
function CompareEmptyStr(Str1, Str2: string): integer;
begin
 if Str1='' then 
  begin
   if Str2='' then Result:=0 Else Result:=-1;
  end else
  begin
   if Str2='' then Result:=1 Else Result:=-2;
  end;
end;
 
function CompareInt(Str1, Str2: string): integer;
begin
 Result:=CompareEmptyStr(Str1, Str2);
 if Result=-2 Then 
  try
   Result := StrToInt(Str1) - StrToInt(Str2);
  except
  end; 
end;
 
function CompareFloat(Str1, Str2: string): integer;
var
  F: Double;
begin
 Result:=CompareEmptyStr(Str1, Str2);
 if Result=-2 Then 
  try
   F := StrToFloat(Str1) - StrToFloat(Str2);
   if F>0 Then Result:=1 Else if F<0 Then Result:=-1 Else Result:=0;
  except
  end; 
end;
 
function CompareDatum(Str1, Str2: string): integer;
var
  D: TDateTime;
begin
 Result:=CompareEmptyStr(Str1, Str2);
 if Result=-2 Then 
  try
   D := StrToDateTime(Str1) - StrToDateTime(Str2);
   if D>0 Then Result:=1 Else if D<0 Then Result:=-1 Else Result:=0;
  except
  end; 
end;

Open in new window

0
Cloud Class® Course: CompTIA Healthcare IT Tech

This course will help prep you to earn the CompTIA Healthcare IT Technician certification showing that you have the knowledge and skills needed to succeed in installing, managing, and troubleshooting IT systems in medical and clinical settings.

QC20NAuthor Commented:
Geert_Gruwez:
I get an error:
[DCC Fatal Error] ScreenFunctions.pas(7): F1026 File not found: 'Quickrpt.dcu'

When I compile.
How do I use the SortColumn in the ListView1ColumnClick?
0
Emmanuel PASQUIERFreelance Project ManagerCommented:
Geert unit probably contains much more than what he posted, you don't need most of the units in the uses.


here it is cleaned up a bit
unit lvUtils;

interface

Uses SysUtils, stdctrls, comctrls, checklst, Db, graphics, Controls, Classes, Windows;

function ReplaceListboxItems( Source : TListBox ; Target : TListBox ) : integer; overload;
function ReplaceListboxItems( Source : TCheckListBox ; Target : TListBox ) : integer; overload;
function ReplaceListboxItems( Source : TListBox ; Target : TCheckListBox ) : integer; overload;

function ChangeListviewItemsSequence(ListView : TListview; inStep : integer): boolean;
function ChangeListBoxItemsSequence(ListBox : TListBox; Step : integer): boolean;

procedure SortColumns(Listview: TListview; Column: TListColumn; var OldColumnNumber, SortDirection: integer; CanFocus, ChangeDirection: boolean);
procedure MarkSortedColumn(listview: TListView; oldColumnNumber, newColumnNumber, SortDirection: integer);
procedure Sort(ListView: TListView; SortDirection, Column: integer; CanFocus: boolean);
 
procedure SetColWidths(Listview: TListview);
 
function SortStringUp(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
function SortIntegerUp(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
function SortDateUp(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
function SortFloatUp(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
function SortStringDown(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
function SortIntegerDown(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
function SortDateDown(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
function SortFloatDown(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
 
procedure SelectFirstItem(Listview: TListView);
 
function RecCount(Listview: TListview): integer;
 
implementation
 
function CompareEmptyStr(Str1, Str2: string): integer;
begin
 if Str1='' then 
  begin
   if Str2='' then Result:=0 Else Result:=-1;
  end else
  begin
   if Str2='' then Result:=1 Else Result:=-2;
  end;
end;
 
function CompareInt(Str1, Str2: string): integer;
begin
 Result:=CompareEmptyStr(Str1, Str2);
 if Result=-2 Then 
  try
   Result := StrToInt(Str1) - StrToInt(Str2);
  except
  end; 
end;
 
function CompareFloat(Str1, Str2: string): integer;
var
  F: Double;
begin
 Result:=CompareEmptyStr(Str1, Str2);
 if Result=-2 Then 
  try
   F := StrToFloat(Str1) - StrToFloat(Str2);
   if F>0 Then Result:=1 Else if F<0 Then Result:=-1 Else Result:=0;
  except
  end; 
end;
 
function CompareDatum(Str1, Str2: string): integer;
var
  D: TDateTime;
begin
 Result:=CompareEmptyStr(Str1, Str2);
 if Result=-2 Then 
  try
   D := StrToDateTime(Str1) - StrToDateTime(Str2);
   if D>0 Then Result:=1 Else if D<0 Then Result:=-1 Else Result:=0;
  except
  end; 
end;
 
function SortStringUp(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
begin
  if ParamSort = 0 then
    Result := lstrcmpi(PChar(Item1.Caption), PChar(Item2.Caption))
  else
    Result := lstrcmpi(PChar(Item1.SubItems[ParamSort - 1]), PChar(Item2.SubItems[ParamSort - 1]));
end;
 
function SortIntegerUp(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
begin
  if ParamSort = 0 then
    Result := CompareInt(Item1.Caption, Item2.Caption)
  else
    Result := CompareInt(Item1.SubItems[ParamSort - 1], Item2.SubItems[ParamSort - 1]);
end;
 
function SortFloatUp(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
begin
  if ParamSort = 0 then
    Result := CompareFloat(Item1.Caption, Item2.Caption)
  else
    Result := CompareFloat(Item1.SubItems[ParamSort - 1], Item2.SubItems[ParamSort - 1]);
end;
 
function SortDateUp(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
begin
  if ParamSort = 0 then
    Result := CompareDatum(Item1.Caption, Item2.Caption)
  else
    Result := CompareDatum(Item1.SubItems[ParamSort - 1], Item2.SubItems[ParamSort - 1]);
end;
 
function SortDateDown(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
begin
  if ParamSort = 0 then
    Result := -CompareDatum(Item1.Caption, Item2.Caption)
  else
    Result := -CompareDatum(Item1.SubItems[ParamSort - 1], Item2.SubItems[ParamSort - 1]);
end;
 
function SortIntegerDown(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
begin
  if ParamSort = 0 then
    Result := -CompareInt(Item1.Caption, Item2.Caption)
  else
    Result := -CompareInt(Item1.SubItems[ParamSort - 1], Item2.SubItems[ParamSort - 1]);
end;
 
function SortFloatDown(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
begin
  if ParamSort = 0 then
    Result := -CompareFloat(Item1.Caption, Item2.Caption)
  else
    Result := -CompareFloat(Item1.SubItems[ParamSort - 1], Item2.SubItems[ParamSort - 1]);
end;
 
function SortStringDown(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
begin
  if ParamSort = 0 then
    Result := -lstrcmpi(PChar(TListItem(Item1).Caption), PChar(TListItem(Item2).Caption))
  else
    Result := -lstrcmpi(PChar(TListItem(Item1).SubItems[ParamSort - 1]), PChar(TListItem(Item2).SubItems[ParamSort - 1]));
end;
 
procedure SortColumns(Listview: TListview; Column: TListColumn;
  var OldColumnNumber, SortDirection: integer; CanFocus, ChangeDirection: boolean);
begin
  LockWindowUpdate( Listview.Handle );
  try
    if ChangeDirection then begin
      if oldColumnNumber = Column.Index then begin
        if SortDirection = 1 then
          SortDirection := 0
        else
          SortDirection := 1;
      end
      else begin
        SortDirection := 1;
      end;
    end;
    MarkSortedColumn(Listview, OldColumnNumber, Column.Index, SortDirection);
    OldColumnNumber := Column.Index;
    Sort(Listview, SortDirection, Column.Index, CanFocus);
  finally
    LockWindowUpdate(0);
  end;
end;
 
function ReplaceListboxItems( Source : TListBox ; Target : TListBox ) : Integer;
// Deze functie verplaatst alle items die geselecteerd zijn in de listbox Source naar lbTarget.
// Returnwaarde: Aantal items dat werd verplaatst
var
  i : Integer;
begin
  Result := 0;
  if Source.SelCount > 0 then begin
    i := 0;
    while i < Source.Items.Count do begin
      if Source.Selected[i] then begin
        //Voeg het item toe aan lbTarget.
        Target.Items.AddObject( Source.Items.Strings[i], Source.Items.Objects[i] );
 
        //Tenslotte wissen we het item uit Source.
        Source.Items.Delete( i );
 
        //Er is weer eentje meer gecopieerd
        Inc( Result ) ;
 
        //Er werd een element verwijderd uit de source, we moeten 'i' aanpassen.
        i := i - 1;
 
      end;
      i := i + 1 ;
    end;
    Target.SetFocus;
  end;
end;
 
function ReplaceListboxItems( Source : TListBox ; Target : TCheckListBox ) : Integer;
// Deze functie verplaatst alle items die geselecteerd zijn in de listbox Source naar lbTarget.
// Returnwaarde: Aantal items dat werd verplaatst
var
  i : Integer;
begin
  Result := 0;
  if Source.SelCount > 0 then begin
    i := 0;
    while i < Source.Items.Count do begin
      if Source.Selected[i] then begin
        //Voeg het item toe aan lbTarget.
        Target.Items.AddObject( Source.Items.Strings[i], Source.Items.Objects[i] );
 
        //Tenslotte wissen we het item uit Source.
        Source.Items.Delete( i );
 
        //Er is weer eentje meer gecopieerd
        Inc( Result ) ;
 
        //Er werd een element verwijderd uit de source, we moeten 'i' aanpassen.
        i := i - 1;
 
      end;
      i := i + 1 ;
    end;
  end;
end;
 
function ReplaceListboxItems( Source : TCheckListBox ; Target : TListBox ) : Integer;
// Deze functie verplaatst alle items die geselecteerd zijn in de listbox Source naar lbTarget.
// Returnwaarde: Aantal items dat werd verplaatst
var
  i : Integer;
begin
  Result := 0;
  i := 0;
  while i < Source.Items.Count do begin
    if Source.Selected[i] then begin
      //Voeg het item toe aan lbTarget.
      Target.Items.AddObject( Source.Items.Strings[i], Source.Items.Objects[i] );
 
      //Tenslotte wissen we het item uit Source.
      Source.Items.Delete( i );
 
      //Er is weer eentje meer gecopieerd
      Inc( Result ) ;
 
      //Er werd een element verwijderd uit de source, we moeten 'i' aanpassen.
      i := i - 1;
 
    end;
    i := i + 1 ;
  end;
end;
 
function ChangeListviewItemsSequence(ListView: TListview; inStep: integer): boolean;
var
  CurrentPos : integer;
  FirstPos : integer;
  NewPos : Integer;
  SelectedAmount: Integer;
  i: integer;
begin
  Result := false;
  if inStep < 0 then begin
    with Listview do begin
      FirstPos := ListView.Selected.Index;
      SelectedAmount := ListView.SelCount;
      CurrentPos := ListView.Selected.Index;
      NewPos := CurrentPos + inStep;
      if (CurrentPos >= 0) and (NewPos >= 0)  then begin
        Items.BeginUpdate ;
        try
          for i := 1 to ListView.SelCount do begin
            Items.Insert(NewPos).Assign(Items[CurrentPos]);
            Result := True;
            Items[CurrentPos + 1].Delete;
            CurrentPos := CurrentPos + 1;
            NewPos := CurrentPos + instep;
          end;
        finally
          Selected := nil;
          for i := (FirstPos + inStep) to (FirstPos + inStep + SelectedAmount)-1 do begin
            Selected := Items[i];
          end;
          ItemFocused := Selected ;
          Selected.MakeVisible( false );
          SetFocus;
          Items.EndUpdate ;
        end;
      end;
    end; // with listview do begin
  end
  else begin
    with Listview do begin
      FirstPos := ListView.Selected.Index;
      SelectedAmount := ListView.SelCount;
      CurrentPos := ListView.Selected.Index + SelectedAmount - 1;
      NewPos := CurrentPos + inStep;
      if NewPos < Items.Count then begin
        Items.BeginUpdate ;
        try
          for i := 1 to ListView.SelCount do begin
            Items.Insert(NewPos +1).Assign(Items[CurrentPos]);
            Result := True;
            Items[CurrentPos].Delete;
            CurrentPos := CurrentPos - 1;
            NewPos := CurrentPos + inStep;
          end;
        finally
          Selected := nil;
          for i := (FirstPos + inStep) to (FirstPos + inStep + SelectedAmount)-1 do begin
            Selected := Items[i];
          end;
          ItemFocused := Selected ;
          Selected.MakeVisible( false );
          SetFocus;
          Items.EndUpdate ;
        end;
      end;
    end; // with listview do begin
  end;
end;
 
function ChangeListBoxItemsSequence(ListBox: TListBox; step:integer): boolean;
var i, tempData :integer;
    tempStr: string;
begin
  Result := false;
  if ListBox.SelCount <> ListBox.Items.Count then begin
    with ListBox do begin
      if step < 0 then begin
        for i:= 1 to Items.Count -1 do begin
          if Selected[i] then begin
            tempStr := Items.Strings[i + step];
            tempData:= Integer(Items.Objects[i + step]);
            Items.Strings[i + step] := Items.Strings[i];
            Items.Objects[i + step] := Items.Objects[i];
            Items.Strings[i] := tempStr;
            Items.Objects[i] := TObjectField(tempData);
            Selected[i + step] := true;
            Result := true;
          end;
        end;
      end
      else begin
        for i:= Items.Count - 2 downto 0 do begin
          if Selected[i] then begin
            tempStr := Items.Strings[i + step];
            tempData:= Integer(Items.Objects[i + step]);
            Items.Strings[i + step] := Items.Strings[i];
            Items.Objects[i + step] := Items.Objects[i];
            Items.Strings[i] := tempStr;
            Items.Objects[i] := TObjectField(tempData);
            Selected[i + step] := true;
            Result := True;
          end;
        end;
      end;
    end;
  end;
end;
 
procedure MarkSortedColumn(listview: TListView; oldColumnNumber, newColumnNumber, SortDirection: integer);
var sign: string;
begin
  if SortDirection = 1 then
    sign := '^'
  else
    sign := 'v';
  if (Copy(ListView.Column[oldColumnNumber].Caption, 0, 1) = '^') or
     (Copy(ListView.Column[oldColumnNumber].Caption, 0, 1) = 'v') then
    ListView.Column[oldColumnNumber].Caption := Copy(ListView.Column[oldColumnNumber].Caption, 2, length(ListView.Column[oldColumnNumber].Caption));
  ListView.Column[newColumnNumber].Caption := sign + ' ' + Trim(ListView.Column[newColumnNumber].Caption);
end;
 
procedure Sort(Listview: Tlistview; SortDirection, Column: integer; CanFocus: Boolean);
begin
  if Listview.Columns.Count > 0 then begin
    if SortDirection = 1 then
      case Listview.Columns[Column].Tag of
        0: ListView.CustomSort(@SortIntegerUp, Column);
        1: ListView.CustomSort(@SortFloatDown, Column);
        2: ListView.CustomSort(@SortStringUp, Column);
        3: ListView.CustomSort(@SortDateUp, Column);
      end
    else
      case Listview.Columns[Column].Tag  of
        0: ListView.CustomSort(@SortIntegerDown, Column);
        1: ListView.CustomSort(@SortFloatUp, Column);
        2: ListView.CustomSort(@SortStringDown, Column);
        3: ListView.CustomSort(@SortDateDown, Column);
      end;
 
    with ListView do
      if Selected <> nil then
        Selected.MakeVisible(false);
  end;
  SetColWidths(Listview);
  if CanFocus then
    Listview.SetFocus;
end;
 
procedure SetColWidths(Listview: TListview);
var i, j: integer;
    width: integer;
    OverWidth: integer;
begin
  Listview.Font.Style := [fsBold];  // dit eerst zetten omdat bij bold er meer plaats gevraagd wordt
  width := 0;
  OverWidth := 14;
  // set caption width
  For i := 0 to Listview.Items.Count - 1 do begin
    if Listview.StringWidth( Listview.Items[i].Caption) > width then
     width := Listview.StringWidth( Listview.Items[i].Caption);
    if Listview.SmallImages <> nil then Overwidth := 25;
  end;
  if Listview.StringWidth( Listview.Columns[0].Caption ) < width then
    Listview.Columns[0].Width := width + OverWidth
  else
    Listview.Columns[0].Width := Listview.StringWidth( Listview.Columns[0].Caption ) + OverWidth;
 
  OverWidth := 14;
  // set subitems width
  for i := 0 to Listview.Columns.Count - 2 do begin
    width := 0;
    For j := 0 to Listview.Items.Count - 1 do begin
      if Listview.StringWidth( Listview.Items[j].SubItems[i]) > width then
       width := Listview.StringWidth( Listview.Items[j].SubItems[i])
    end;
    if Listview.StringWidth( Listview.Columns[i + 1].Caption ) < width then
      Listview.Columns[i + 1].Width := width + OverWidth
    else
      Listview.Columns[i + 1].Width := Listview.StringWidth( Listview.Columns[i + 1].Caption ) + OverWidth;
  end;
  Listview.Font.Style := [];
end;
 
procedure SelectFirstItem(Listview: TListview);
begin
  if Listview.Items.Count > 0 then
  begin
    Listview.Items[0].Selected := True;
    Listview.ItemFocused := Listview.Selected;
    if Listview.CanFocus then Listview.SetFocus;
  end;
end;
 
function RecCount(Listview: TListview): integer;
begin
  Result := Listview.Items.Count;
end;
 
end.

Open in new window

0
Emmanuel PASQUIERFreelance Project ManagerCommented:
ah, and don't ever think about accepting this as the answer without giving Geert credits
0
Geert GOracle dbaCommented:
lol, epasquier, trying to share points ?

the unit was a copy paste of what i had
it wasn't "separated" into a single unit yet, and hadn't had any cleanup
just something out of a repository i have access to
0
QC20NAuthor Commented:
I'm little confused.

How do I use the SortColumn procedure?
In wich onEvent do I use ít in?
0
Emmanuel PASQUIERFreelance Project ManagerCommented:
in an onColumnClick event of TListView :

Var
// these are declared in your unit as global or better yet, in your form as private
 OldColumnNumber, SortDirection :Integer;


procedure TForm1.lv1ColumnClick(Sender: TObject; Column: TListColumn);
begin
 SortColumns((Sender As TListview), Column, OldColumnNumber, SortDirection, True, True );
end;
0
QC20NAuthor Commented:
Yes, now it works, but how do I get it to work on the 1st and 2nd column?

Those are string.
The content of the 1st column is names.
The content of the 2nd column is date and the format is xx-xx-xxxx, but the type is string.
0
Emmanuel PASQUIERFreelance Project ManagerCommented:
that should work for all columns. For the second one, your date format will not give the same result with alphabetical order, so you have to sort it using Tdate

I see this, so probably you have to set the Tag of the 2nd column = 3
      case Listview.Columns[Column].Tag of
        0: ListView.CustomSort(@SortIntegerUp, Column);
        1: ListView.CustomSort(@SortFloatDown, Column);
        2: ListView.CustomSort(@SortStringUp, Column);
        3: ListView.CustomSort(@SortDateUp, Column);
and it will work only if StrToDateTime can use the same format as yours to convert the string back to its TDate value.

Geert, you can probably better explain your unit than me, so tell us if I'm wrong or incomplete
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Geert GOracle dbaCommented:
>>better explain ?
looks like your doing fine ... congrats on the sage
why do they give me so much work ??? i wanna get to genius before the next person does ... :)

i'll open an ancient app where this was used ... from 2007. ... uh no 2006
now we are using quantumgrid from devexpress (no more hassle)

i had some 30 listviews on the main form
ntbmain.PageIndex is the current active one

sorry for the dutch bits :)
{
 tag van columnheaders (voor sortering)
        0: integer
        1: float
        2: string
        3: date

 SortDirection
        1 = ascending
        2 = descending
}

in each listview attach OnColumnClick = SortColumn

private section of your form:
  private
    SortColumnIndex: array of integer;
    SortDirection : array of integer;

in formcreate
  SetLength(SortColumnIndex, ntbMain.Pages.Count);
  SetLength(SortDirection, ntbMain.Pages.Count);
 for i:= 0 to ntbMain.Pages.Count -1 do begin
    SortColumnIndex[i] := Dictionary.Read('SortCol' + IntToStr(i), 0, 'integers');
    SortDirection[i] := Dictionary.Read('SortDir' + IntToStr(i), 1, 'integers');
  end;

procedure TfrmMainTools.SortColumn(Sender: TObject; Column: TListColumn);
begin
  SortColumns(TListView(Sender), Column, SortColumnIndex[ntbmain.PageIndex],     SortDirection[ntbmain.PageIndex], True, True);
end;
0
Geert GOracle dbaCommented:
this for sets everything to integer sort

 for i:= 0 to ntbMain.Pages.Count -1 do begin
    SortColumnIndex[i] := Dictionary.Read('SortCol' + IntToStr(i), 0, 'integers');
    SortDirection[i] := Dictionary.Read('SortDir' + IntToStr(i), 1, 'integers');
  end;

if you would want datesort
you would set it to     SortColumnIndex[i] := 3
0
QC20NAuthor Commented:
Hi Guys,

Sorry for the late reply. I really appreciate your effort to explain this to me, but I'm not sure I fully understand it.

epasquier:
Where do I put your example?

Geert Gruwez:
I have put this on the formcreate:
  SetLength(SortColumnIndex, ntbMain.Pages.Count);
  SetLength(SortDirection, ntbMain.Pages.Count);
 for i:= 0 to ntbMain.Pages.Count -1 do begin
    SortColumnIndex[i] := Dictionary.Read('SortCol' + IntToStr(i), 0, 'integers');
    SortDirection[i] := Dictionary.Read('SortDir' + IntToStr(i), 1, 'integers');
  end;

but I get some undeclared identifier errors @ ntbMain.pages.count and Dictionary.read

I have attached my code, for you to see.

I really don't know where to put your examples in.

Please help me.

I don't know if incease points is good, but I have done that.
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, ComObj, ActiveX, ADODB, DB, DateUtils,
  ComCtrls;

type
  TFrmMain = class(TForm)
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    CheckBox1: TCheckBox;
    BitBtn1: TBitBtn;
    Edit1: TEdit;
    ADOConnection1: TADOConnection;
    Label1: TLabel;
    ListView1: TListView;
    StatusBar1: TStatusBar;
    ProgressBar1: TProgressBar;
    RadioButton2: TRadioButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
      const Rect: TRect);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure RadioButton2Click(Sender: TObject);
    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);

  private
     StrListSuccess, strListFailed : TStringlist; OldColumnNumber, SortDirection :Integer; SortColumnIndex: array of integer; SortDirection : array of integer;

  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;
  LastSortedColumn: integer;
  Ascending: boolean;


implementation

uses
   adshlp, activeds_tlb, ldapform, ScreenFunctions;

{$R *.dfm}

procedure TFrmMain.BitBtn1Click(Sender: TObject);
var i, iDays, n : integer; adUsr : IADsUser; strCode, sADsPath, sDays, BossName : string;
  obj : variant; dt: TDateTime; disp : IDISPATCH;
  User : IAdsUser;
  li: IADsLargeInteger;
  x: LARGE_INTEGER;
  time:Double;
  logonDate: TDateTime;
  lpSysTime: TSystemTime;
  ft: TFileTime;
  localft: TFileTime;   //*NEW*
  Query, Query1 : TADOQuery;
  Present: TDateTime;
  Year, Month, Day, Hour, Min, Sec, MSec: Word;
  InActiveCount, MemberCount : integer;
  LastLoginFailed : boolean;
begin
  Listview1.Clear;
  ADUsr := nil;
  InActiveCount := 0;
  MemberCount := 0;
  LastLoginFailed := false;
  Query := TADOQuery.Create(nil);
  Query.Connection := ADOConnection1;
  try
    Query.SQL.Clear;
    Query.SQL.Text := 'SELECT whenChanged, logonCount, samAccountName, distinguishedname, ADsPath, CN FROM '+ Quotedstr('LDAP://OU=USERS,' + edit1.Text) + ' WHERE objectClass='+ Quotedstr('user') + ' ORDER by CN';
    Query.Open;
    ProgressBar1.Max := Query.RecordCount;
    while not Query.Eof do
    begin
      try
        sADsPath := Query.FieldByName('AdsPath').AsString;
        ADsGetObject(sADsPath, IADsUser, adusr);
      except on E:Exception do
      end;
      if adusr <> nil then
      begin
        try
          dt := ADUsr.LastLogin;
        except
          try
            disp := adusr.Get('LastLogonTimeStamp');
          except
            LastLoginFailed := true;
            StrListFailed.Add(Query.FieldByName('cn').AsString);
          end;
          if not LastLoginFailed then
          begin
            li   := disp as IADsLargeInteger;
            ft.dwLowDateTime := li.LowPart;
            ft.dwHighDateTime := li.HighPart;
            if FileTimeToSystemTime(ft, lpSysTime) then
            begin
              Dt := SystemTimeToDateTime(lpSysTime);
            end;
          end;
        end;
        if not LastLoginFailed then
        begin
          if daysBetween(Date, dt) > 45 then
          begin
            if not checkbox1.Checked then
              if not AdUsr.AccountDisabled then
              begin
                AdUsr.AccountDisabled := true;
                AdUsr.Description := 'ROBOT: Have not been used in ' + IntToStr(daysBetween(Date, dt)) + ' days | Disabled at ' + datetostr(now);
                AdUsr.SetInfo;
              end;
              with Listview1.Items.Add do
              begin
                Caption := Query.FieldByName('cn').AsString;
                SubItems.Add(DateToStr(dt));
                SubItems.Add(IntToStr(daysBetween(Date, dt)));
              end;
            Inc(InActiveCount);
            Label1.Caption := 'Count: ' + IntToStr(InActiveCount);
          end;
        end;
      end;
      Inc(MemberCount);
      ProgressBar1.Position := MemberCount;
      LastLoginFailed := false;
      Query.Next;
      Application.ProcessMessages;
    end;
  finally
    ProgressBar1.Position := 0;
    Query.Close;
  end;
end;

function GetCurrentUserName: string;
const
  cnMaxUserNameLen = 254;
var
  sUserName: string;
  dwUserNameLen: DWORD;
begin
  dwUserNameLen := cnMaxUserNameLen - 1;
  SetLength(sUserName, cnMaxUserNameLen);
  GetUserName(PChar(sUserName), dwUserNameLen);
  SetLength(sUserName, dwUserNameLen);
  Result := sUserName;
end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeAndNil(strListSuccess);
  FreeAndNil(strListFailed);
end;

procedure TFrmMain.FormCreate(Sender: TObject);
var atmp, aSite, aCountry : string; ProgressBarStyle: integer;
begin
  strListSuccess := TStringList.Create;
  strListFailed := TStringList.Create;
  aTmp := copy(GetCurrentUserName,1,4);
  aSite := copy(aTmp,3,4);
  aCountry := copy(aTmp,1,2);
  Edit1.OnChange := nil;
  Edit1.Text := 'OU=' + aSite + ',OU=' + aCountry + ',OU=ALFALAVAL,DC=AD,DC=ALFALAVAL,DC=ORG';
  //enable status bar 2nd Panel custom drawing
  StatusBar1.Panels[1].Style := psOwnerDraw;

  //place the progress bar into the status bar
  ProgressBar1.Parent := StatusBar1;

  //remove progress bar border
  ProgressBarStyle := GetWindowLong(ProgressBar1.Handle,
                                    GWL_EXSTYLE);
  ProgressBarStyle := ProgressBarStyle
                      - WS_EX_STATICEDGE;
  SetWindowLong(ProgressBar1.Handle,
                GWL_EXSTYLE,
                ProgressBarStyle);
end;


procedure TFrmMain.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
  SortColumns((Sender As TListview), Column, OldColumnNumber, SortDirection, True, True );
end;

procedure TFrmMain.RadioButton2Click(Sender: TObject);
var I, ButtonSelected : integer; astr : string;
begin
  astr := '';
  for I := 0 to strListFailed.Count - 1 do
    astr := astr + #13#10 + strListFailed[i];
    ShowMessage(astr);
    RadioButton2.Checked := false;
end;

procedure TFrmMain.SpeedButton1Click(Sender: TObject);
var adOU : IADsContainer;
begin
  with TfrmLDAP.Create(self) do
  try
    CoInitialize(nil);
    ADsGetObject('LDAP://OU=Firm,DC=ad,DC=Firm,DC=org', IADsContainer, adOU);
    adOU.Filter := VarArrayOf(['organizationalUnit']);
    OU := adOU;
    showmodal;
  finally
    CoUninitialize;
    free;
  end;
end;

procedure TFrmMain.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  if Panel = StatusBar.Panels[1] then
  with ProgressBar1 do begin
    Top := Rect.Top;
    Left := Rect.Left;
    Width := Rect.Right - Rect.Left - 15;
    Height := Rect.Bottom - Rect.Top;
  end;

end;

end.

Open in new window

0
Geert GOracle dbaCommented:
first thing: how many listviews do you have ?
1 ? seems so from the

second thing: do you put everything in 1 line ?
it is not forbidden to spread across multiple lines
it's easier to read :)

third thing: i didn't adapt the code for your form
i'm a little too busy to chew on every piece of code

fourth thing: sorry about that ranting, it's monday :<

>>Application.ProcessMessages; ???
change to :ProgressBar1.Update
will work faster

>>I have put this on the formcreate:
uh ???

>>private
>>  SortDirection :Integer;
>>  SortDirection : array of integer;
2 times declared with different type ???

change the private declaration to
  private
    StrListSuccess, strListFailed : TStringlist;
    SortDirection :Integer;
    SortColumnIndex: integer;

procedure TFrmMain.FormCreate(Sender: TObject);
var atmp, aSite, aCountry : string; ProgressBarStyle: integer;
begin
  strListSuccess := TStringList.Create;
  strListFailed := TStringList.Create;
  aTmp := copy(GetCurrentUserName,1,4);
  aSite := copy(aTmp,3,4);
  aCountry := copy(aTmp,1,2);
  Edit1.OnChange := nil;
  Edit1.Text := 'OU=' + aSite + ',OU=' + aCountry + ',OU=ALFALAVAL,DC=AD,DC=ALFALAVAL,DC=ORG';
  //enable status bar 2nd Panel custom drawing
  StatusBar1.Panels[1].Style := psOwnerDraw;

  //place the progress bar into the status bar
  ProgressBar1.Parent := StatusBar1;

  //remove progress bar border
  ProgressBarStyle := GetWindowLong(ProgressBar1.Handle,
                                    GWL_EXSTYLE);
  ProgressBarStyle := ProgressBarStyle
                      - WS_EX_STATICEDGE;
  SetWindowLong(ProgressBar1.Handle,
                GWL_EXSTYLE,
                ProgressBarStyle);
  SortColumnIndex := 0;
  SortDirection := 1;
end;


procedure TFrmMain.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
  SortColumns((Sender As TListview), Column, SortColumnIndex, SortDirection, True, True );
end;


i know it's not allways easy to adapt somebody else's code to your own
the ideas behind the other's code is sometimes very obscure :)
0
QC20NAuthor Commented:
"first thing: how many listviews do you have ?
1 ? seems so from the "

Yes, I only have 1 listview

"second thing: do you put everything in 1 line ?
it is not forbidden to spread across multiple lines
it's easier to read :)"

Not sure, what you mean, but I have 3 columns in the listview.

"third thing: i didn't adapt the code for your form
i'm a little too busy to chew on every piece of code "

Yes, I understand that, but I was also hoping that I could "decode" it by myself.

"fourth thing: sorry about that ranting, it's monday :<"

No problem. :)

About the Application.ProcessMessages change to ProgressBar1.update the result of that is that, when I press the button it will be "pressed down" until the code has run throug to the Query.Eof has ended. The same is also with the listview. I can't see anything in the listview until the Query.Eof is done.

">>private
>>  SortDirection :Integer;
>>  SortDirection : array of integer;
2 times declared with different type ???"

My mistake.
>>Application.ProcessMessages; ???
change to :ProgressBar1.Update
will work faster
0
Geert GOracle dbaCommented:
>>
About the Application.ProcessMessages change to ProgressBar1.update the result of that is that, when I press the button it will be "pressed down" until the code has run throug to the Query.Eof has ended. The same is also with the listview. I can't see anything in the listview until the Query.Eof is done.

yeah, if you want an interactive system then you need to think about loading your data with a thread
if you want the data as fast as possible then you don't use threads but wait on the code to finish

if you want a little of both (first 20 rows) to show immediately and want an interactive system
then you need threads too

it does get a little complicated then :(
0
QC20NAuthor Commented:
Hi guys,

I found this as a solution for me.

http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_24049249.html?sfQueryTermInfo=1+listview+sort

I'm not sure how I can reward you with points anyway, now you have done some work on this.

Maybe a little off topic question.

How do I add a little triangle on the sorted column?
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.