////////////////////////////////////////////////////////////////////////////////
//
// Name: TlplListView
// Creator: C. Aaangel
// Description: This listview descendant will automaticly do column sorting
//              without you having to write in any kind of sorting code.
// Version: 1.1
//
// Copyright (C) 2005 - 2008, C. Aaangel
////////////////////////////////////////////////////////////////////////////////
//
// Release
//  1.1 - Added Dynamic Column System
//  1.0 - Initial Release
//
////////////////////////////////////////////////////////////////////////////////
// Last minute notes
//
// * Sorting can also be done as either Float or datetime, which normally gives
//   an incorrect value when using COMPARETEXT.
//   Set these as true to have the listview check if they are of that type
//   * SortAsDateTime
//   * SortAsFloat
// * You can link columnclick to sort in another column, use full if you are
//   displaying size in "xxx MB." and "xxx KB.", then you add the byte value
//   in an unlisted (invisible to user) column and link the sorting to that one
//   * Just run AddLinkedColumn(ClickedColumn, ColumnToBeSortedBy)
////////////////////////////////////////////////////////////////////////////////
unit lplListView;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, DynCol, Filter;

type
  TlplListView = class;
  TOnColumnSort = Procedure(Sender: TlplListview; ColumnToSort: Integer; Descending: Boolean) of object;
  TlplListView = class(TListView)
  private
    FSortAsFloat: Boolean;
    FSortAsDateTime: Boolean;
    FSortByImageGroup: Boolean;
    FOnColumnSort: TOnColumnSort;
    FSortAsInteger: Boolean;
    function DoCompare(S1: String; I1: Integer; S2: String; I2: Integer): Integer;
    procedure SetSortColumn(const Value: Integer);
    procedure SortedListViewCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure SortedListViewColumnClick(Sender: TObject; Column: TListColumn);
    procedure SetSortAsDateTime(const Value: Boolean);
    procedure SetSortAsFloat(const Value: Boolean);
    function IsDateTime(Str: String; Var DateTime: TDateTime): Boolean;
    function IsFloat(Str: String; Var Float: Real): Boolean;
    procedure SetSortByImageGroup(const Value: Boolean);
    procedure SetOnColumnSort(const Value: TOnColumnSort);
    procedure SetSortAsInteger(const Value: Boolean);
  protected
    property SortType;
  public
    Descent: Boolean;
    LastSort: Integer;
    FSortColumn: Integer;
    ColumnInfoList: TColumnInfoList;
    procedure BuildColumns;
    procedure AddToList(ItemIndex: Integer; AtColumn: String; Str: String); overload;
    procedure AddToList(ItemName: String; AtColumn: String; Str: String); overload;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ClearLinkedColumns;
    procedure AddLinkedColumn(Column, LinkedTo: Integer);
  published
    { Published declarations }
    LinkedColumns: TStrings;
    LinkedImageGroups: TStrings;
    property SortColumn: Integer read FSortColumn write SetSortColumn;
    property SortAsFloat: Boolean read FSortAsFloat write SetSortAsFloat;
    property SortAsDateTime: Boolean read FSortAsDateTime write SetSortAsDateTime;
    property SortByImageGroup: Boolean read FSortByImageGroup write SetSortByImageGroup;
    property SortByInteger: Boolean read FSortAsInteger write SetSortAsInteger;
    Property OnColumnSort: TOnColumnSort read FOnColumnSort write SetOnColumnSort;
    procedure Update; override;
    function AlphaSort: Boolean;
  end;

  TSortedListView = Class(TlplListview);

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('LPL Tools', [TlplListView]);
end;

Function CountFilt(From: String; Seperator: String = '\'; CaseSensitive: Boolean = True): Integer;
var
 Res, IC: Integer;
Begin
 Res := 0;
 If Not CaseSensitive Then begin
  From := Uppercase(From);
  Seperator := Uppercase(Seperator);
 end;
 If Length(From) > 0 Then begin
  Res := 1;
  For IC := 1 to length(From) do begin
   If Copy(From, IC, Length(Seperator)) = Seperator Then Inc(Res);
  End;
 End;
 Result := Res;
End;

Function GetFilt(From: String; Number: Integer; Seperator: String = '\'; CaseSensitive: Boolean = True): String;
Var
 LastRecorded, CStart, CSlut, ATF, IC: Integer;
 TFrom: String;
 Res: String;
Begin
 Res := '';
 If Not CaseSensitive Then TFrom := Uppercase(From)
  else TFrom := From;
 If Not CaseSensitive Then Seperator := Uppercase(Seperator);
 If Number > CountFilt(TFrom, Seperator, CaseSensitive) Then Begin
  Result := Res;
  Exit;
 End;
 If Length(TFrom) > 0 Then begin
  If (Copy(TFrom, 1, Length(Seperator)) = Seperator) And (Number = 1) Then Begin
   Result := Res;
   Exit;
  End;
  CStart := 0;
  CSlut := 0;
  ATF := 1;
  LastRecorded := 0;
  If Number = 1 Then CStart := 1;
  For IC := 1 to length(TFrom) do begin
   LastRecorded := IC;
   If Copy(TFrom, IC, Length(Seperator)) = Seperator Then begin
    Inc(ATF);
    If ATF = Number Then CStart := IC + Length(Seperator);
    If ATF = Number + 1 Then CSlut := IC - 1 ;
   End;
  end;
  If (CStart <> 0) And (CSlut = 0) Then CSlut := LastRecorded;
  Res := Copy(From, CStart, CSlut - CStart + 1);
 End;
 Result := Res;
End;

{ TlplListView }

procedure TlplListView.AddLinkedColumn(Column, LinkedTo: Integer);
begin
 LinkedColumns.Add(IntToStr(Column) + '=' + IntToStr(LinkedTo));
end;

procedure TlplListView.AddToList(ItemIndex: Integer; AtColumn,
  Str: String);
begin
 ColumnInfoList.AddToList(Self, ItemIndex, AtColumn, Str);
end;

procedure TlplListView.AddToList(ItemName, AtColumn, Str: String);
begin
 ColumnInfoList.AddToList(Self, ItemName, AtColumn, Str);
end;

function TlplListView.AlphaSort: Boolean;
begin
 Result := False;

 If assigned(FOnColumnSort) then begin
  fOnColumnSort(self, SortColumn, Descent);
 end;
 If SortColumn = -1 then exit;
 inherited alphasort;
end;

procedure TlplListView.BuildColumns;
begin
 ColumnInfoList.BuildColumns(Self);
end;

procedure TlplListView.ClearLinkedColumns;
begin
 LinkedColumns.Clear;
end;

constructor TlplListView.Create(AOwner: TComponent);
begin
  inherited;
  Self.SortType := stNone;
  ColumnInfoList := TColumnInfoList.Create;
  LinkedColumns := TStringList.Create;
  LinkedImageGroups := TStringList.Create;
  SortColumn := -1;
  OnColumnClick := SortedListViewColumnClick;
  OnCompare := SortedListViewCompare;
end;

destructor TlplListView.Destroy;
begin
  FreeAndNil(ColumnInfoList);
  FreeAndNil(LinkedColumns);
  FreeAndNil(LinkedImageGroups);
  inherited;
end;

function TlplListView.DoCompare(S1: String; I1: Integer; S2: String; I2: Integer): Integer;
Var
 Handled: Boolean;
 DT1, DT2: TDateTime;
 FL1, FL2: Real;
 SI1, SI2, I, B1, B2: Integer;
 S: String;
begin
 Result := 0;
 SI1 := 0; SI2 := 0;
 B1 := I1;
 B2 := I2;
 If SortByImageGroup then begin
  If LinkedImageGroups.count > 0 then begin
   For I := 0 to LinkedImageGroups.Count - 1 do begin
    If StrToInt(GetFilt(LinkedImageGroups[I], 1, '=')) = B1 then begin
     B1 := StrToInt(GetFilt(LinkedImageGroups[I], 2, '='));
    end;
    If StrToInt(GetFilt(LinkedImageGroups[I], 1, '=')) = B2 then begin
     B2 := StrToInt(GetFilt(LinkedImageGroups[I], 2, '='));
    end;
   end;
  end;
 End;
 If (not(SortByImageGroup)) or (B1 = B2) then begin
  Handled := False;
  If SortAsFloat then begin
   If IsFloat(S1, FL1) then begin
    If IsFloat(S2, FL2) then begin
     Handled := true;
     Result := round(FL1 - FL2);
    end;
   end;
  end;
  If SortByInteger Then Begin
   HAndled := true;
   S := Filter.DelLastFilt(S1, '.');
   Try
    SI1 := StrToInt(S);
   except
    on EConvertError do begin
     HAndled := false;
    end;
   end;
   If Handled then begin
    S := Filter.DelLastFilt(S2, '.');
    Try
     SI2 := StrToInt(S);
    Except
     on Econverterror do begin
      HAndled := false;
     end;
    end;
   end;
   If HAndled then begin
    Result := SI1 - SI2;
   end;
  End;
  If SortAsDateTime Then begin
   If IsDateTime(S1, DT1) then begin
    If IsDateTime(S2, DT2) then begin
     Handled := true;
     Result := round(DT1 - DT2);
    end;
   end;
  end;
  If Not Handled Then begin
   Result := CompareText(S1, S2);
  end;
 end;
 If (SortByImageGroup) and (B1 <> B2) then begin
  Result := I1 - I2;
 end;
end;

function TlplListView.IsDateTime(Str: String;
  var DateTime: TDateTime): Boolean;
begin
 Try
  DateTime := StrToDateTime(Str);
  Result := true;
 except
  on EConvertError do Result := false;
 end;
end;

function TlplListView.IsFloat(Str: String; var Float: real): Boolean;
begin
 Try
  Float := StrToFloat(Str);
  Result := true;
 except
  on EConvertError do Result := false;
 end;
end;

procedure TlplListView.SetOnColumnSort(const Value: TOnColumnSort);
begin
  FOnColumnSort := Value;
end;

procedure TlplListView.SetSortAsDateTime(const Value: Boolean);
begin
  FSortAsDateTime := Value;
end;

procedure TlplListView.SetSortAsFloat(const Value: Boolean);
begin
  FSortAsFloat := Value;
end;

procedure TlplListView.SetSortAsInteger(const Value: Boolean);
begin
  FSortAsInteger := Value;
end;

procedure TlplListView.SetSortByImageGroup(const Value: Boolean);
begin
  FSortByImageGroup := Value;
end;

procedure TlplListView.SetSortColumn(const Value: Integer);
begin
  FSortColumn := Value;
  If LastSort = SortColumn then Descent := Not Descent
   else Descent := True;
  LastSort := Value;
  AlphaSort;
end;

procedure TlplListView.SortedListViewColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  SortColumn := Column.Index;
end;

procedure TlplListView.SortedListViewCompare(Sender: TObject;
  Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
Var
 TempSort: Integer;
 I: Integer;
begin
  TempSort := SortColumn;
  If LinkedColumns.Count > 0 then begin
   For I := 0 to LinkedColumns.Count - 1 do begin
    If StrToInt(GetFilt(LinkedColumns[I], 1, '=')) = TempSort then begin
     TempSort := StrToInt(GetFilt(LinkedColumns[I], 2, '='));
     break;
    end;
   end;
  end;
  if TempSort = 0 then
    Compare := DoCompare(Item1.Caption, Item1.ImageIndex, Item2.Caption, Item2.ImageIndex)
  else
  begin
   If (TempSort > Item1.SubItems.Count) or (TempSort > Item2.SubItems.Count) then Compare := 0
    else Compare := DoCompare(Item1.SubItems[TempSort - 1], Item1.ImageIndex, Item2.SubItems[TempSort - 1], Item2.ImageIndex);
  end;
  If Not Descent then Compare := Compare * (-1);
end;

procedure TlplListView.Update;
begin
 inherited;
 AlphaSort;
end;

end.
