Changeset 21 for trunk/Packages/Common/ListViewSort.pas

Timestamp:

Apr 3, 2025, 10:49:00 PM (13 days ago)

Author:

chronos

Message:

• Modified: Updated Common package.

File:

• trunk/Packages/Common/ListViewSort.pas (moved) (moved from trunk/Packages/Common/UListViewSort.pas ) (21 diffs)

trunk/Packages/Common/ListViewSort.pas

@@ -1 @@
-unit UListViewSort;
-
-// Date: 2010-11-03
-
-{$mode delphi}
+unit ListViewSort;
+
+// Date: 2019-05-17
 
 interface
 
 uses
-  {$IFDEF Windows}Windows, CommCtrl, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils,
-  Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls,
-  LclIntf, LMessages, LclType, LResources;
+  {$IFDEF Windows}Windows, CommCtrl, LMessages, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils,
+  Controls, DateUtils, Dialogs, Forms, Grids, StdCtrls, ExtCtrls,
+  LclIntf, LclType, LResources, Generics.Collections, Generics.Defaults;
 
 type
@@ -19 +17 @@
   TCompareEvent = function (Item1, Item2: TObject): Integer of object;
   TListFilterEvent = procedure (ListViewSort: TListViewSort) of object;
+
+  TObjects = TObjectList<TObject>;
 
   { TListViewSort }
@@ -52 +52 @@
     {$ENDIF}
   public
-    List: TListObject;
-    Source: TListObject;
+    Source: TObjects;
+    List: TObjects;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -81 +81 @@
     FOnChange: TNotifyEvent;
     FStringGrid1: TStringGrid;
-    procedure DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
-    procedure DoOnResize(Sender: TObject);
+    procedure DoOnChange;
+    procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure GridDoOnResize(Sender: TObject);
   public
     constructor Create(AOwner: TComponent); override;
@@ -90 +91 @@
     function TextEnteredColumn(Index: Integer): Boolean;
     function GetColValue(Index: Integer): string;
+    procedure Reset;
     property StringGrid: TStringGrid read FStringGrid1 write FStringGrid1;
   published
@@ -98 +100 @@
   end;
 
+  { TListViewEx }
+
+  TListViewEx = class(TWinControl)
+  private
+    FFilter: TListViewFilter;
+    FListView: TListView;
+    FListViewSort: TListViewSort;
+    procedure ResizeHanlder;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    property ListView: TListView read FListView write FListView;
+    property ListViewSort: TListViewSort read FListViewSort write FListViewSort;
+    property Filter: TListViewFilter read FFilter write FFilter;
+    property Visible;
+  end;
+
 procedure Register;
 
@@ -105 +125 @@
 procedure Register;
 begin
-  RegisterComponents('Common', [TListViewSort, TListViewFilter]);
+  RegisterComponents('Common', [TListViewSort, TListViewFilter, TListViewEx]);
+end;
+
+{ TListViewEx }
+
+procedure TListViewEx.ResizeHanlder;
+begin
+end;
+
+constructor TListViewEx.Create(TheOwner: TComponent);
+begin
+  inherited;
+  Filter := TListViewFilter.Create(Self);
+  Filter.Parent := Self;
+  Filter.Align := alBottom;
+  ListView := TListView.Create(Self);
+  ListView.Parent := Self;
+  ListView.Align := alClient;
+  ListViewSort := TListViewSort.Create(Self);
+  ListViewSort.ListView := ListView;
+end;
+
+destructor TListViewEx.Destroy;
+begin
+  inherited;
 end;
 
 { TListViewFilter }
 
-procedure TListViewFilter.DoOnKeyUp(Sender: TObject; var Key: Word;
+procedure TListViewFilter.DoOnChange;
+begin
+  if Assigned(FOnChange) then FOnChange(Self);
+end;
+
+procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word;
   Shift: TShiftState);
 begin
-  if Assigned(FOnChange) then
-    FOnChange(Self);
-end;
-
-procedure TListViewFilter.DoOnResize(Sender: TObject);
+  DoOnChange;
+end;
+
+procedure TListViewFilter.GridDoOnResize(Sender: TObject);
 begin
   FStringGrid1.DefaultRowHeight := FStringGrid1.Height;
@@ -124 +172 @@
 constructor TListViewFilter.Create(AOwner: TComponent);
 begin
-  inherited Create(AOwner);
+  inherited;
   FStringGrid1 := TStringGrid.Create(Self);
   FStringGrid1.Align := alClient;
@@ -135 +183 @@
   FStringGrid1.Options := [goFixedHorzLine, goFixedVertLine, goVertLine,
     goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll];
-  FStringGrid1.OnKeyUp := DoOnKeyUp;
-  FStringGrid1.OnResize := DoOnResize;
+  FStringGrid1.OnKeyUp := GridDoOnKeyUp;
+  FStringGrid1.OnResize := GridDoOnResize;
 end;
 
@@ -142 +190 @@
 var
   I: Integer;
+  R: TRect;
 begin
   with FStringGrid1 do begin
-    //Columns.Clear;
     while Columns.Count > ListView.Columns.Count do Columns.Delete(Columns.Count - 1);
     while Columns.Count < ListView.Columns.Count do Columns.Add;
     for I := 0 to ListView.Columns.Count - 1 do begin
       Columns[I].Width := ListView.Columns[I].Width;
+      if Selection.Left = I then begin
+        R := CellRect(I, 0);
+        Editor.Left := R.Left + 2;
+        Editor.Width := R.Width - 4;
+      end;
     end;
   end;
@@ -182 +235 @@
 end;
 
+procedure TListViewFilter.Reset;
+var
+  I: Integer;
+begin
+  with StringGrid do
+  for I := 0 to ColCount - 1 do
+    Cells[I, 0] := '';
+  DoOnChange;
+end;
+
 { TListViewSort }
 
@@ -197 +260 @@
   if AMsg.Msg = WM_NOTIFY then
   begin
-    Code := PHDNotify(vMsgNotify.NMHdr)^.Hdr.Code;
+    Code := NMHDR(PHDNotify(vMsgNotify.NMHdr)^.Hdr).Code;
     case Code of
       HDN_ENDTRACKA, HDN_ENDTRACKW:
@@ -272 +335 @@
 end;
 
+var
+  ListViewSortCompare: TCompareEvent;
+
+function ListViewCompare(constref Item1, Item2: TObject): Integer;
+begin
+  Result := ListViewSortCompare(Item1, Item2);
+end;
+
 procedure TListViewSort.Sort(Compare: TCompareEvent);
 begin
+  // TODO: Because TFLGObjectList compare handler is not class method,
+  // it is necessary to use simple function compare handler with local variable
+  ListViewSortCompare := Compare;
   if (List.Count > 0) then
-    List.Sort(Compare);
+    List.Sort(TComparer<TObject>.Construct(ListViewCompare));
 end;
 
@@ -281 +355 @@
 begin
   if Assigned(FOnFilter) then FOnFilter(Self)
-  else if Assigned(Source) then
-    List.Assign(Source) else
+  else if Assigned(Source) then begin
     List.Clear;
+    List.AddRange(Source);
+  end;
   if ListView.Items.Count <> List.Count then
     ListView.Items.Count := List.Count;
@@ -338 +413 @@
 begin
   inherited;
-  List := TListObject.Create;
+  List := TObjects.Create;
   List.OwnsObjects := False;
 end;
@@ -344 +419 @@
 destructor TListViewSort.Destroy;
 begin
-  List.Free;
+  FreeAndNil(List);
   inherited;
 end;
@@ -353 +428 @@
   TP1: TPoint;
   XBias, YBias: Integer;
-  OldColor: TColor;
+  PenColor: TColor;
+  BrushColor: TColor;
   BiasTop, BiasLeft: Integer;
   Rect1: TRect;
@@ -365 +441 @@
   Item.Left := 0;
   GetCheckBias(XBias, YBias, BiasTop, BiasLeft, ListView);
-  OldColor := ListView.Canvas.Pen.Color;
+  PenColor := ListView.Canvas.Pen.Color;
+  BrushColor := ListView.Canvas.Brush.Color;
   //TP1 := Item.GetPosition;
   lRect := Item.DisplayRect(drBounds); // Windows 7 workaround
@@ -377 +454 @@
   ItemLeft := Item.Left;
   ItemLeft := 23; // Windows 7 workaround
-  
+
   Rect1.Left := ItemLeft - CheckWidth - BiasLeft + 1 + XBias;
   //ShowMessage(IntToStr(Tp1.Y) + ', ' + IntToStr(BiasTop) + ', ' + IntToStr(XBias));
@@ -408 +485 @@
   end;
   //ListView.Canvas.Brush.Color := ListView.Color;
-  ListView.Canvas.Brush.Color := clWindow;
-  ListView.Canvas.Pen.Color := OldColor;
+  ListView.Canvas.Brush.Color := BrushColor;
+  ListView.Canvas.Pen.Color := PenColor;
 end;
 
@@ -476 +553 @@
     FHeaderHandle := ListView_GetHeader(FListView.Handle);
     for I := 0 to FListView.Columns.Count - 1 do begin
+      {$push}{$warn 5057 off}
       FillChar(Item, SizeOf(THDItem), 0);
+      {$pop}
       Item.Mask := HDI_FORMAT;
       Header_GetItem(FHeaderHandle, I, Item);