Changeset 15 for trunk/Packages/Common/UListViewSort.pas

Timestamp:

Mar 22, 2018, 8:31:19 PM (7 years ago)

Author:

chronos

Message:

• Modified: Update Common and CollTranslator packages to fix build under Lazarus 1.8.
• Fixed: Some memory leaks.

File:

• trunk/Packages/Common/UListViewSort.pas (modified) (16 diffs)

trunk/Packages/Common/UListViewSort.pas

@@ -9 +9 @@
 uses
   {$IFDEF Windows}Windows, CommCtrl, {$ENDIF}Classes, Graphics, ComCtrls, SysUtils,
-  Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls;
+  Controls, DateUtils, Dialogs, SpecializedList, Forms, Grids, StdCtrls, ExtCtrls,
+  LclIntf, LMessages, LclType, LResources;
 
 type
@@ -18 +19 @@
   TCompareEvent = function (Item1, Item2: TObject): Integer of object;
   TListFilterEvent = procedure (ListViewSort: TListViewSort) of object;
+
+  { TListViewSort }
 
   TListViewSort = class(TComponent)
@@ -28 +31 @@
     FColumn: Integer;
     FOrder: TSortOrder;
+    FOldListViewWindowProc: TWndMethod;
+    FOnColumnWidthChanged: TNotifyEvent;
+    procedure DoColumnBeginResize(const AColIndex: Integer);
+    procedure DoColumnResized(const AColIndex: Integer);
+    procedure DoColumnResizing(const AColIndex, AWidth: Integer);
     procedure SetListView(const Value: TListView);
     procedure ColumnClick(Sender: TObject; Column: TListColumn);
@@ -40 +48 @@
     procedure SetColumn(const Value: Integer);
     procedure SetOrder(const Value: TSortOrder);
+    {$IFDEF WINDOWS}
+    procedure NewListViewWindowProc(var AMsg: TMessage);
+    {$ENDIF}
   public
     List: TListObject;
@@ -58 +69 @@
     property OnCustomDraw: TLVCustomDrawItemEvent read FOnCustomDraw
       write FOnCustomDraw;
+    property OnColumnWidthChanged: TNotifyEvent read FOnColumnWidthChanged
+      write FOnColumnWidthChanged;
     property Column: Integer read FColumn write SetColumn;
     property Order: TSortOrder read FOrder write SetOrder;
@@ -68 +81 @@
     FOnChange: TNotifyEvent;
     FStringGrid1: TStringGrid;
-    procedure DoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure GridDoOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure GridDoOnResize(Sender: TObject);
   public
     constructor Create(AOwner: TComponent); override;
     procedure UpdateFromListView(ListView: TListView);
     function TextEntered: Boolean;
+    function TextEnteredCount: Integer;
+    function TextEnteredColumn(Index: Integer): Boolean;
     function GetColValue(Index: Integer): string;
     property StringGrid: TStringGrid read FStringGrid1 write FStringGrid1;
@@ -79 +95 @@
     property Align;
     property Anchors;
+    property BorderSpacing;
   end;
 
@@ -93 +110 @@
 { TListViewFilter }
 
-procedure TListViewFilter.DoOnKeyUp(Sender: TObject; var Key: Word;
+procedure TListViewFilter.GridDoOnKeyUp(Sender: TObject; var Key: Word;
   Shift: TShiftState);
 begin
   if Assigned(FOnChange) then
     FOnChange(Self);
+end;
+
+procedure TListViewFilter.GridDoOnResize(Sender: TObject);
+begin
+  FStringGrid1.DefaultRowHeight := FStringGrid1.Height;
 end;
 
@@ -113 +135 @@
   FStringGrid1.Options := [goFixedHorzLine, goFixedVertLine, goVertLine,
     goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll];
-  FStringGrid1.OnKeyUp := DoOnKeyUp;
+  FStringGrid1.OnKeyUp := GridDoOnKeyUp;
+  FStringGrid1.OnResize := GridDoOnResize;
 end;
 
@@ -119 +142 @@
 var
   I: Integer;
-  NewColumn: TGridColumn;
 begin
   with FStringGrid1 do begin
-    Columns.Clear;
+    Options := Options - [goEditing, goAlwaysShowEditor];
+    //Columns.Clear;
     while Columns.Count > ListView.Columns.Count do Columns.Delete(Columns.Count - 1);
-    while Columns.Count < ListView.Columns.Count do NewColumn := Columns.Add;
+    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;
     end;
+    Options := Options + [goEditing, goAlwaysShowEditor];
   end;
 end;
 
 function TListViewFilter.TextEntered: Boolean;
+begin
+  Result := TextEnteredCount > 0;
+end;
+
+function TListViewFilter.TextEnteredCount: Integer;
 var
   I: Integer;
 begin
-  Result := False;
+  Result := 0;
   for I := 0 to FStringGrid1.ColCount - 1 do begin
     if FStringGrid1.Cells[I, 0] <> '' then begin
-      Result := True;
-      Break;
+      Inc(Result);
     end;
   end;
+end;
+
+function TListViewFilter.TextEnteredColumn(Index: Integer): Boolean;
+begin
+  Result := FStringGrid1.Cells[Index, 0] <> '';
 end;
 
@@ -153 +186 @@
 { TListViewSort }
 
+{$IFDEF WINDOWS}
+procedure TListViewSort.NewListViewWindowProc(var AMsg: TMessage);
+var
+  vColWidth: Integer;
+  vMsgNotify: TLMNotify absolute AMsg;
+  Code: Integer;
+begin
+  // call the old WindowProc of ListView
+  FOldListViewWindowProc(AMsg);
+
+  // Currently we care only with WM_NOTIFY message
+  if AMsg.Msg = WM_NOTIFY then
+  begin
+    Code := NMHDR(PHDNotify(vMsgNotify.NMHdr)^.Hdr).Code;
+    case Code of
+      HDN_ENDTRACKA, HDN_ENDTRACKW:
+        DoColumnResized(PHDNotify(vMsgNotify.NMHdr)^.Item);
+
+      HDN_BEGINTRACKA, HDN_BEGINTRACKW:
+        DoColumnBeginResize(PHDNotify(vMsgNotify.NMHdr)^.Item);
+
+      HDN_TRACKA, HDN_TRACKW:
+        begin
+          vColWidth := -1;
+          if (PHDNotify(vMsgNotify.NMHdr)^.PItem<>nil)
+             and (PHDNotify(vMsgNotify.NMHdr)^.PItem^.Mask and HDI_WIDTH <> 0)
+          then
+            vColWidth := PHDNotify(vMsgNotify.NMHdr)^.PItem^.cxy;
+
+          DoColumnResizing(PHDNotify(vMsgNotify.NMHdr)^.Item, vColWidth);
+        end;
+    end;
+  end;
+end;
+{$ENDIF}
+
+procedure TListViewSort.DoColumnBeginResize(const AColIndex: Integer);
+begin
+end;
+
+procedure TListViewSort.DoColumnResizing(const AColIndex, AWidth: Integer);
+begin
+end;
+
+procedure TListViewSort.DoColumnResized(const AColIndex: Integer);
+begin
+  if Assigned(FOnColumnWidthChanged) then
+    FOnColumnWidthChanged(Self);
+end;
 
 procedure TListViewSort.ColumnClick(Sender: TObject; Column: TListColumn);
@@ -179 +261 @@
 procedure TListViewSort.SetListView(const Value: TListView);
 begin
+  if FListView = Value then Exit;
+  if Assigned(FListView) then
+    ListView.WindowProc := FOldListViewWindowProc;
   FListView := Value;
   FListView.OnColumnClick := ColumnClick;
   FListView.OnCustomDrawItem := ListViewCustomDrawItem;
   FListView.OnClick := ListViewClick;
+  FOldListViewWindowProc := FListView.WindowProc;
+  {$IFDEF WINDOWS}
+  FListView.WindowProc := NewListViewWindowProc;
+  {$ENDIF}
 end;
 
@@ -199 +288 @@
   if ListView.Items.Count <> List.Count then
     ListView.Items.Count := List.Count;
-  if Assigned(FOnCompareItem) then Sort(FOnCompareItem);
+  if Assigned(FOnCompareItem) and (Order <> soNone) then Sort(FOnCompareItem);
   //ListView.Items[-1]; // Workaround for not show first row if selected
   ListView.Refresh;
@@ -266 +355 @@
   TP1: TPoint;
   XBias, YBias: Integer;
-  OldColor: TColor;
+  PenColor: TColor;
+  BrushColor: TColor;
   BiasTop, BiasLeft: Integer;
   Rect1: TRect;
@@ -278 +368 @@
   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
@@ -321 +412 @@
   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;