ソート矢印つきListview - Delphi 2007

ソート矢印つきのListrViewです。実行結果は下図の通り。 カラムリサイズ時にカラムの状態が初期化されてしまう現象に対しては、MakeObjectInstanceを使用してカラムヘッダのイベント通知をキャプチャして再セットすることで回避しています。

 unit iPentecListView;

 interface

 uses
   SysUtils, Classes, Controls, ComCtrls,Commctrl,Windows,Messages;

 type
   TiPentecListView = class(TCustomListView)
   private
     FSortInvert:boolean;
     FSelectedColumn:integer;
     FOnColumnClickAfter: TLVColumnClickEvent;
     HHeader:THandle;

     { Private 宣言 }
   protected
     FOldHDWndProc: TFNWndProc;
     FNewHDWndProc: TFNWndProc; 

     NewAppWndProc:Pointer;
     procedure ColClick(Column: TListColumn); override;

     procedure SetColumnImage(Column: Integer; Down: Boolean);
     procedure RemoveImage(Index: Integer);
     procedure SetImage(Index: Integer; Direction: Boolean);
     { Protected 宣言 }
   public
     constructor Create(AOwner:TComponent);override;
     destructor destroy;override;
     procedure Loaded;override;

     property SelectedColumn:integer read FSelectedColumn;
     property SortInvert:boolean read FSortInvert;

     procedure AppWndProc(var Msg: TMessage); virtual;
     //function AppWndProc(var Msg: TMessage):Longint;virtual;

     { Public 宣言 }
   published
     property OnColumnClickAfter: TLVColumnClickEvent read FOnColumnClickAfter write FOnColumnClickAfter;

     property Action;
     property Align;
     property AllocBy;
     property Anchors;
     property BevelEdges;
     property BevelInner;
     property BevelOuter;
     property BevelKind default bkNone;
     property BevelWidth;
     property BiDiMode;
     property BorderStyle;
     property BorderWidth;
     property Checkboxes;
     property Color;
     property Columns;
     property ColumnClick;
     property Constraints;
     property Ctl3D;
     property DragCursor;
     property DragKind;
     property DragMode;
     property Enabled;
     property Font;
     property FlatScrollBars;
     property FullDrag;
     property GridLines;
     property HideSelection;
     property HotTrack;
     property HotTrackStyles;
     property HoverTime;
     property IconOptions;
     property Items;
     property LargeImages;
     property MultiSelect;
     property OwnerData;
     property OwnerDraw;
     property ReadOnly default False;
     property RowSelect;
     property ParentBiDiMode;
     property ParentColor default False;
     property ParentFont;
     property ParentShowHint;
     property PopupMenu;
     property ShowColumnHeaders;
     property ShowWorkAreas;
     property ShowHint;
     property SmallImages;
     property SortType;
     property StateImages;
     property TabOrder;
     property TabStop default True;
     property ViewStyle;
     property Visible;
     property OnAdvancedCustomDraw;
     property OnAdvancedCustomDrawItem;
     property OnAdvancedCustomDrawSubItem;
     property OnChange;
     property OnChanging;
     property OnClick;
     property OnColumnClick;
     property OnColumnDragged;
     property OnColumnRightClick;
     property OnCompare;
     property OnContextPopup;
     property OnCustomDraw;
     property OnCustomDrawItem;
     property OnCustomDrawSubItem;
     property OnData;
     property OnDataFind;
     property OnDataHint;
     property OnDataStateChange;
     property OnDblClick;
     property OnDeletion;
     property OnDrawItem;
     property OnEdited;
     property OnEditing;
     property OnEndDock;
     property OnEndDrag;
     property OnEnter;
     property OnExit;
     property OnGetImageIndex;
     property OnGetSubItemImage;
     property OnDragDrop;
     property OnDragOver;
     property OnInfoTip;
     property OnInsert;
     property OnKeyDown;
     property OnKeyPress;
     property OnKeyUp;
     property OnMouseActivate;
     property OnMouseDown;
     property OnMouseEnter;
     property OnMouseLeave;
     property OnMouseMove;
     property OnMouseUp;
     property OnResize;
     property OnSelectItem;
     property OnStartDock;
     property OnStartDrag;
     { Published 宣言 }
   end;

 procedure Register;

 implementation

 procedure Register;
 begin
   RegisterComponents(''iPentec Component'', [TiPentecListView]);
 end;

 constructor TiPentecListView.Create(AOwner:TComponent);
 begin
   inherited;
   SetViewStyle(vsReport);
   FSortInvert:=False;
   FSelectedColumn:=-1;
 end;

 destructor TiPentecListView.destroy;
 begin
   SetWindowLong( HHeader, GWL_WNDPROC, Longint(FOldHDWndProc));
   FreeObjectInstance(NewAppWndProc);
   inherited;
 end;


 procedure TiPentecListView.Loaded;
 begin
   inherited;
   // WndProcのインスタンスを作成
   NewAppWndProc := MakeObjectInstance(AppWndProc);

   HHeader := ListView_GetHeader(self.Handle);
   //HeaderのMessageを処理
   FOldHDWndProc := TFNWndProc( GetWindowLong(HHeader, GWL_WNDPROC));
   FNewHDWndProc := TFNWndProc( SetWindowLong( HHeader,GWL_WNDPROC,Longint(NewAppWndProc)));
 end;

 procedure TiPentecListView.AppWndProc(var Msg: TMessage);
 var
   DownFlag:boolean;
 begin
   Msg.Result := CallWindowProc( FNewHDWndProc, 0, Msg.Msg, Msg.wParam, Msg.lParam );

   //HeaderのMessage処理 Columnの幅変更時の描画処理
   case Msg.Msg of
     WM_CAPTURECHANGED:begin
       SetColumnImage(FSelectedColumn,FSortInvert);
     end;
   end;
 end;

 procedure TiPentecListView.ColClick(Column: TListColumn);
 begin
   inherited;

   if Column.Index = FSelectedColumn then begin
     FSortInvert:=not FSortInvert;
   end else begin
     FSortInvert:=False;
   end;

   FSelectedColumn:=Column.Index;
   SetColumnImage(Column.Index,FSortInvert);
 
   if Assigned(FOnColumnClickAfter) then begin
     FOnColumnClickAfter(Self,Column);
   end;
 end;


 procedure TiPentecListView.SetColumnImage(Column: Integer; Down: Boolean);
 var
   n: Integer;
 begin
   for n:=0 to Columns.Count - 1 do RemoveImage(n);  // remove icons
   SetImage(Column, not Down);                       // set the "arrow icon"
 end;

 procedure TiPentecListView.RemoveImage(Index: Integer);
 var
   Header: THandle;
   HDItem: THDItem;
 begin
   Header := ListView_GetHeader(Handle);  // Get the ListView Header Handle
   FillChar(HDItem, SizeOf(HDItem), 0);
   //HDItem.Mask := HDI_BITMAP or HDI_IMAGE or HDI_FORMAT;
   HDItem.Mask := HDI_FORMAT;
   Header_GetItem(Header, Index, HDItem);    // current status secure
   HDItem.fmt := HDItem.fmt and not HDF_SORTUP and not HDF_SORTDOWN
     and not HDF_BITMAP_ON_RIGHT and not HDF_IMAGE;  // arrow delete

   Header_SetItem(Header, Index, HDItem);// changes use
 end;

 procedure TiPentecListView.SetImage(Index: Integer; Direction: Boolean);
 var
   Header: THandle;
   HDItem: THDItem;
 begin
   Header := ListView_GetHeader(Handle);  // Get the ListView Header Handle
   FillChar(HDItem, SizeOf(HDItem), 0);
   HDItem.Mask := HDI_BITMAP or HDI_IMAGE or HDI_FORMAT;
   Header_GetItem(Header, Index, HDItem);  // current status secure
   HDItem.fmt := HDItem.fmt and not HDF_SORTUP and not HDF_SORTDOWN
     and not HDF_IMAGE or HDF_BITMAP_ON_RIGHT;  // arrow is to appear right

   // set direction
   if Direction = true then //sdUp then
     HDItem.fmt := HDItem.fmt or HDF_SORTUP
   else
     HDItem.fmt := HDItem.fmt or HDF_SORTDOWN;
    
   Header_SetItem(Header, Index, HDItem);  // changes use
 end;
 end.