Solved

Shading Column on Explorer - Like WinXP Style.

Posted on 2003-10-24
15
884 Views
Last Modified: 2009-07-29
Working with Windows XP. Windows explorer shades the sorted column on the details view.  I want to implement that functionality on my TListView.  How to I do it?
0
Comment
Question by:Colin_Dawson
  • 5
  • 3
  • 2
  • +2
15 Comments
 
LVL 8

Expert Comment

by:gmayo
ID: 9613439
Probably need to OwnerDraw it, with the appropriate shaded background. Or maybe one of OnCustomDraw, OnCustomDrawItem, OnCustomDrawSubItem, OnAdvancedCustomDraw, OnAdvancedCustomDrawItem, and OnAdvancedCustomDrawSubItem depending on when/how you want to draw it.

Geoff M.
0
 
LVL 4

Author Comment

by:Colin_Dawson
ID: 9613463
Several questions spring to mind about implementing this....

1. What colour should the shading be?
2. If I ownerdraw the First column, how do I get the icons to also have the shading underneath?
0
 
LVL 8

Expert Comment

by:gmayo
ID: 9615892
1. How long is a piece of string? It's entirely up to you. You could use a standard windows colour if you want to be consistent, eg when the user decides to change themes.

2. Depending on the icons, they may have a transparent colour set in their properties. Draw the background and then the icon on top.

Geoff M.
0
 

Expert Comment

by:SoulessZero
ID: 9623208
I don't think you will have to OwnerDraw the shading effect on Report view, coz I'v noticed that in Winzip it also has such shading effect. So it probably maybe XP has include some new API for ListView controls but not documented anywhere...
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 9647641
That style is inherent in the version 6 CommCtl.dll for sorted listview columns. There is no way to turn it on or off AFAIK.

To do it with the LV included w/Delphi, you will have to do a patblt in each ownerdrawn column.
0
 

Expert Comment

by:SoulessZero
ID: 9648466
If Im not use VCL component but only Win32 API call, is there any API function of CommCtl.dll ver6 can implement this? I think there is but not documented...
0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
LVL 4

Author Comment

by:Colin_Dawson
ID: 9660001
I've been doing alot of work on this, and am making some really good progress.
I decided to do all the drawing manually, instead of looking for some possibly non-existant undocumentent API call.

I've got the Listview highlighting the column of choice now, and it seems to work pretty well.  The only thing that I need to work out is how to alter the icons on the listview so that they also have the same backgound as the rest of the column.
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 9674828
Is this how you are doing it:

procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
  if SubItem = iSelectedColumn then
    Sender.Canvas.Brush.Color := RGB(247, 247, 247)
  else
    Sender.Canvas.Brush.Color := RGB(255, 255, 255);
end;

procedure TForm1.ListView1ColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  TListView(Sender).Items.BeginUpdate;
  iSelectedColumn := Column.Index;
  TListView(Sender).Items.EndUpdate;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  iSelectedColumn := 0;
end;

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if iSelectedColumn = 0 then
    Sender.Canvas.Brush.Color := RGB(247, 247, 247)
  else
    Sender.Canvas.Brush.Color := RGB(255, 255, 255);
end;
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 9674831
AFA the Icons are concerned, you have to Draw them with a transparent BG.
0
 
LVL 4

Accepted Solution

by:
Colin_Dawson earned 0 total points
ID: 9675230
That's more or less how I'm shading the column. There's more to it than that though.   Oh heck I'm feeling nice,  Here's how I've do it so far,   hang on to your hat's folks.  I've written my own descentant of TCustomList.  Removed the Sorted property as this is no longer needed. I've added my own custom sorting routine directly into the list and created a new method called PerformSort.  This will sort the column using a best Guess - Trying Number, DateTime, then string  in that order  this should in theory sort about 90% of the data that is placed into the control without needing to write any custom sorting routines.

The control is using Windows XP and I've added the up and down arrow, which appears in ComCtl32 Version 6 and above.  The column is sorted in the on Column click.   I've got everything working on the component but the only thing that is missing is the fact that the Icons are being drawn with a background that is the color of the controls background, I need it to be transparent as Eddieshipman says.    The problem is that I don't know of an easy way to do this final enhancement.   Anyway here's the control as I've got it at the moment.

If you try to compile this unit as is, you'll notice that I've got some of my own error handling, take this out.  Also you'll see that the up or down arrow for the sort direction does not get shown.   I decided not to add images to version 5, well, just yet anyway.   I want to be able to add them without modifying the smallimages list. (it'll get messy when I do that.   The images can be activated by setting the iImage variable to the index of your up/down arrow icon.  But you'll get an error if the Smallimages doesn't contain a valid imagelist.  Also ignote the call to XPThemesPossible, just change this to True.

Can someone post up a link to or some code that will correctly draw the icon's background?


Here's the code so far.......


unit CJDCustomListView;

interface

uses
  Windows, Messages, Graphics, Types, Classes, Controls, ComCtrls;

type
  TColumnResizeEvent = procedure(Sender: TCustomListview;
    columnindex: Integer;
    columnwidth: Integer) of object;


  TCJDListView = class(TCustomListView)
  private
    vAllowShading : Boolean;
    vSortColumn : Integer;
    vSortAscending : Boolean;

    vBeginColumnResizeEvent: TColumnResizeEvent;
    vEndColumnResizeEvent: TColumnResizeEvent;
    vColumnResizeEvent: TColumnResizeEvent;

    procedure DoBeginColumnResize(columnindex, columnwidth: Integer); virtual;
    procedure DoEndColumnResize(columnindex, columnwidth: Integer); virtual;
    procedure DoColumnResize(columnindex, columnwidth: Integer); virtual;
    procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY;
    function FindColumnIndex(pHeader: pNMHdr): Integer;
    function FindColumnWidth(pHeader: pNMHdr): Integer;

    Procedure CJDDraw( const ARect: TRect; Var DefaultDraw : Boolean );
    Procedure CJDDrawItem( Item: TListItem; State: TCustomDrawState; Var DefaultDraw : Boolean );
    Procedure CJDDrawSubItem( Item: TListItem; SubItem: Integer; State: TCustomDrawState; Var DefaultDraw : Boolean );
    Procedure SetColumnImage( Const ShowImage : Boolean );
    function CalcSortColumnRect : TRect;
    function GetSortAscending: Boolean;
    function GetSortColumn: Integer;
    procedure SetSortAscending(const Value: Boolean);
    procedure SetSortColumn(const Value: Integer);
  protected
    procedure ColClick(Column: TListColumn); Override;
    function CustomDraw(const ARect: TRect; Stage: TCustomDrawStage): Boolean; Override;
    function CustomDrawItem(Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage): Boolean; Override;
    function CustomDrawSubItem(Item: TListItem; SubItem: Integer; State: TCustomDrawState; Stage: TCustomDrawStage): Boolean; Override;
    procedure CreateWnd; override;
    procedure Loaded; override;

    function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; Override;

    property SortType;
  public
    constructor Create(AOwner: TComponent); override;
    Procedure PerformSort;
//    destructor Destroy; override;
  published
    Property SortColumnIndex : Integer read GetSortColumn Write SetSortColumn;
    Property SortAscending : Boolean read GetSortAscending Write SetSortAscending;

    property OnBeginColumnResize: TColumnResizeEvent read vBeginColumnResizeEvent write vBeginColumnResizeEvent;
    property OnEndColumnResize: TColumnResizeEvent read vEndColumnResizeEvent write vEndColumnResizeEvent;
    property OnColumnResize: TColumnResizeEvent read vColumnResizeEvent write vColumnResizeEvent;

    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 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 OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnSelectItem;
    property OnStartDock;
    property OnStartDrag;
  End;

procedure Register;

implementation

Uses
  SysUtils, CommCtrl, U_Global;

procedure Register;
begin
  Try
    RegisterComponents('Colin', [TCJDListView]);
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

Function CalcListViewReportSortShadowColor( Const Color : TColor ) : TColor;
Var
  lvRGB : Integer;
  lvRed : Byte;
  lvGreen : Byte;
  lvBlue : Byte;
begin
  Try
    //Decode Windows Colour to Normal RGB
    lvRGB := ColorToRGB( Color );

    //Split the Colour into it's Red, Green and Blue Elements
    lvRed := GetRValue( lvRGB );
    lvGreen := GetGValue( lvRGB );
    lvBlue := GetBValue( lvRGB );

    //Alter the elements to produce the Colour of the ListView shade
    if (lvRed > 240) and (lvGreen > 240) and (lvBlue > 240) Then
    Begin
      Dec( lvRed, 8 );
      Dec( lvGreen, 8 );
      Dec( lvBlue, 8 );
    End
    else
    Begin
      if (lvRed   < 232)
      then lvRed := lvRed + ( lvRed div 10 )
      else lvRed := 255;

      if (lvGreen < 232)
      then lvGreen := lvGreen + ( lvGreen div 10 )
      else lvGreen := 255;

      if (lvBlue  < 232)
      then lvBlue  := lvBlue + ( lvBlue  div 10 )
      else lvBlue  := 255;
    End;

    //Put the Red, Green and blue together to produce the final colour.
    Result := RGB( lvRed, lvGreen, lvBlue );
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
End;

Var
  vSortOrder : Boolean;

function SortByColumn(Item1, Item2: TListItem; Data: integer): integer; stdcall;
Var
  lvSorted : Boolean;
  lvWorkingDateTime : TDateTime;
begin
  Try
    Result := 0;
    Try
      lvSorted := False;
      Try
        //Try a number order sort
        if Data = 0 then
          Result := Round(StrToFloat(Item1.Caption)-StrToFloat(Item2.Caption))
        else
          Result := Round(StrToFloat(Item1.SubItems[Data-1])-StrToFloat(Item2.SubItems[Data-1]));
        lvSorted := True;
      Except
      End;

      If Not lvSorted Then
      Try
        //Try a DateTime & Time Sort
        if Data = 0
        then lvWorkingDateTime := StrToDateTime(Item1.Caption)-StrToDateTime(Item2.Caption)
        else lvWorkingDateTime := StrToDateTime(Item1.SubItems[Data-1])-StrToDateTime(Item2.SubItems[Data-1]);

        If lvWorkingDateTime > 0
        Then Result := 1
        Else If lvWorkingDateTime = 0
             Then Result := 0
             Else Result := -1;
        lvSorted := True;
      Except
      End;

      If Not lvSorted Then
      Try
        //Try a Date Sort
        if Data = 0 then
          Result := Round(StrToDate(Item1.Caption)-StrToDate(Item2.Caption))
        else
          Result := Round(StrToDate(Item1.SubItems[Data-1])-StrToDate(Item2.SubItems[Data-1]));
        lvSorted := True;
      Except
      End;

      If Not lvSorted Then
      Try
        //Try an alpha sort
        if Data = 0 then
          Result := AnsiCompareText(Item1.Caption, Item2.Caption)
        else
          Result := AnsiCompareText(Item1.SubItems[Data-1], Item2.SubItems[Data-1]);
        lvSorted := True;
      Except
      End;

      If not lvSorted Then
        Result := 0;
    Finally
      if Not vSortOrder then
        Result := -Result;
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

{ TCJDListView }

function TCJDListView.CalcSortColumnRect: TRect;
Var
  lvLoop : Integer;
  lvLeft : Integer;
  lvItem : TListItem;
begin
  Try
    //Work out the width of the colum to draw.
    lvLeft := 0;
    For lvLoop := 0 to Pred( Columns.Count ) Do
    Begin
      If vSortColumn = lvLoop then
      Begin
        Result.Left := lvLeft;
{        If lvLoop = 0 Then
        Begin
          If SmallImages <> nil Then
            Inc( Result.Left, SmallImages.Width );
        End;}
        Result.Right := lvLeft + Column[ lvLoop ].Width;
        Break;
      End;
      Inc( lvLeft, Column[ lvLoop ].Width );
    End;

    //Work out the bottom of the column
    Result.Bottom := ClientRect.Bottom;

    //Work out the top of the column to draw.

    If Items.Count = 0
    Then Result.Top := ClientRect.Top
    Else Begin
           lvItem := Items[ Pred( Items.Count ) ];
           Result.Top := lvItem.DisplayRect( drBounds ).Bottom;
         End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.CJDDraw(const ARect: TRect; Var DefaultDraw : Boolean);
begin
  Try
    If Not ( csDesigning in ComponentState ) Then
    Begin
      If ( ViewStyle = vsReport ) and vAllowShading Then
      Begin
        Canvas.Brush.Color := CalcListViewReportSortShadowColor( Color );
        Canvas.Brush.Style := bsSolid;
        Canvas.FillRect( CalcSortColumnRect );
        Canvas.Brush.Style := bsClear;
      End;
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.CJDDrawItem(Item: TListItem;
  State: TCustomDrawState; Var DefaultDraw : Boolean);
begin
  Try
    If Not ( csDesigning in ComponentState ) Then
    Begin
      If ( ViewStyle = vsReport ) and vAllowShading Then
      Begin
        Canvas.Brush.Style := bsClear;
        If vSortColumn = 0 Then
        Begin
          If Not ( cdsFocused In State) Then
          Begin
            Canvas.Brush.Color := CalcListViewReportSortShadowColor( Color );
            Canvas.Brush.Style := bsSolid;
          End;
        End;
      End;
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.CJDDrawSubItem(Item: TListItem; SubItem: Integer;
  State: TCustomDrawState; Var DefaultDraw : Boolean);
begin
  Try
    If Not ( csDesigning in ComponentState ) Then
    Begin
      If ( ViewStyle = vsReport ) and vAllowShading Then
      Begin
        Canvas.Brush.Style := bsClear;
        If SubItem = vSortColumn Then
        Begin
          If Not (cdsFocused  In State) Then
          Begin
            Canvas.Brush.Color := CalcListViewReportSortShadowColor( Color );
            Canvas.Brush.Style := bsSolid;
          End;
        End;
      End;
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.ColClick(Column: TListColumn);
begin
  Try
    If Not ( csDesigning in ComponentState ) Then
    Begin
      Items.BeginUpdate;
      Try
        SetColumnImage( False );
        if Column.Index = vSortColumn then
          vSortAscending := not vSortAscending
        else begin
          vSortColumn := Column.Index;
        end;
        PerformSort;
        SetColumnImage( True );
      Finally
        Items.EndUpdate;
      End;
    End;
    inherited;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

constructor TCJDListView.Create(AOwner: TComponent);
begin
  Try
    inherited Create( AOwner );
    ViewStyle := vsReport;
    vSortColumn := 0;
    vSortAscending := True;
    vAllowShading := XPThemesPossible;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.CreateWnd;
var
  wnd: HWND;
begin
  Try
    inherited;
    If Not ( csDesigning in ComponentState ) Then
    Begin
      wnd := GetWindow(Handle, GW_CHILD);
      SetWindowLong(wnd, GWL_STYLE,
        GetWindowLong(wnd, GWL_STYLE) and not HDS_FULLDRAG);
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

function TCJDListView.CustomDraw(const ARect: TRect;
  Stage: TCustomDrawStage): Boolean;
begin
  Try
    If ViewStyle = vsReport Then
    Begin
      Result := True;
      if (Stage = cdPrePaint) and Assigned(OnCustomDraw) then OnCustomDraw(Self, ARect, Result);
      if Assigned(OnAdvancedCustomDraw) then OnAdvancedCustomDraw(Self, ARect, Stage, Result);
      If Result Then
        CJDDraw( ARect, Result );
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

function TCJDListView.CustomDrawItem(Item: TListItem;
  State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;
begin
  Try
    If ViewStyle = vsReport Then
    Begin
      Result := True;
      if (Stage = cdPrePaint) and Assigned(OnCustomDrawItem) then OnCustomDrawItem(Self, Item, State, Result);
      if Assigned(OnAdvancedCustomDrawItem) then OnAdvancedCustomDrawItem(Self, Item, State, Stage, Result);
      If Result Then
        CJDDrawItem( Item, State, Result );
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

function TCJDListView.CustomDrawSubItem(Item: TListItem; SubItem: Integer;
  State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;
begin
  Try
    If ViewStyle = vsReport Then
    Begin
      Result := True;
      if (Stage = cdPrePaint) and Assigned(OnCustomDrawSubItem) then
        OnCustomDrawSubItem(Self, Item, SubItem, State, Result);
      if Assigned(OnAdvancedCustomDrawSubItem) then
        OnAdvancedCustomDrawSubItem(Self, Item, SubItem, State, Stage, Result);
      If Result Then
        CJDDrawSubItem( Item, SubItem, State, Result );
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.DoBeginColumnResize(columnindex,
  columnwidth: Integer);
begin
  Try
    If Not ( csDesigning in ComponentState ) Then
    Begin
      if Assigned(vBeginColumnResizeEvent) then
        vBeginColumnResizeEvent(Self, columnindex, columnwidth);
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.DoColumnResize(columnindex, columnwidth: Integer);
begin
  Try
    If Not ( csDesigning in ComponentState ) Then
    Begin
      if Assigned(vColumnResizeEvent) then
        vColumnResizeEvent(Self, columnindex, columnwidth);
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.DoEndColumnResize(columnindex,
  columnwidth: Integer);
begin
  Try
    If Not ( csDesigning in ComponentState ) Then
    Begin
      SetColumnImage( True );
      if Assigned(vEndColumnResizeEvent) then
        vEndColumnResizeEvent(Self, columnindex, columnwidth);
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

function TCJDListView.FindColumnIndex(pHeader: pNMHdr): Integer;
var
  hwndHeader: HWND;
  iteminfo: THdItem;
  ItemIndex: Integer;
  buf: array [0..128] of Char;
begin
  Try
    Result := -1;
    hwndHeader := pHeader^.hwndFrom;
    ItemIndex := pHDNotify(pHeader)^.Item;
    FillChar(iteminfo, SizeOf(iteminfo), 0);
    iteminfo.Mask := HDI_TEXT;
    iteminfo.pszText := buf;
    iteminfo.cchTextMax := SizeOf(buf) - 1;
    Header_GetItem(hwndHeader, ItemIndex, iteminfo);
    if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then
      Result := ItemIndex
    else
    begin
      for ItemIndex := 0 to Columns.Count - 1 do
        if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then
        begin
          Result := ItemIndex;
          Break;
        end;
    end;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

function TCJDListView.FindColumnWidth(pHeader: pNMHdr): Integer;
begin
  Try
    Result := -1;
    if Assigned(PHDNotify(pHeader)^.pItem) and
      ((PHDNotify(pHeader)^.pItem^.mask and HDI_WIDTH) <> 0) then
      Result := PHDNotify(pHeader)^.pItem^.cxy;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

function TCJDListView.GetSortAscending: Boolean;
begin
  Try
    Result := vSortAscending;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

function TCJDListView.GetSortColumn: Integer;
begin
  Try
    Result := vSortColumn;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

function TCJDListView.IsCustomDrawn(Target: TCustomDrawTarget;
  Stage: TCustomDrawStage): Boolean;
begin
  Try
    { List view doesn't support erase notifications }
    If ViewStyle = vsReport Then
    Begin
      Result := True;
    End
    Else Result := Inherited IsCustomDrawn( Target, Stage );
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.Loaded;
begin
  Try
    Inherited Loaded;
    If Not ( csDesigning in ComponentState ) Then
    Begin
      If ViewStyle = vsReport Then
        SetColumnImage( True );
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.PerformSort;
begin
  Try
    vSortOrder := vSortAscending;
    CustomSort(@SortByColumn, vSortColumn);
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.SetColumnImage( Const ShowImage : Boolean );
Const
  HDF_SORTDOWN = $200;
  HDF_SORTUP = $400;

  LVM_SETSELECTEDCOLUMN = LVM_FIRST + 140;
var
  Align,hHeader: integer;
  HD: HD_ITEM;
begin
  Try
    hHeader := SendMessage( Handle, LVM_GETHEADER, 0, 0);
    with HD do
    begin
      case Columns[vSortColumn].Alignment of
        taLeftJustify:  Align := HDF_LEFT;
        taCenter:       Align := HDF_CENTER;
        taRightJustify: Align := HDF_RIGHT;
      else
        Align := HDF_LEFT;
      end;

      mask := HDI_IMAGE or HDI_FORMAT;

      pszText := PChar(Columns[vSortColumn].Caption);

      if ShowImage then
      begin
        fmt := HDF_STRING {or HDF_IMAGE or HDF_BITMAP_ON_RIGHT};

        If vAllowShading Then
        Begin
          If vSortAscending
          Then begin
                 fmt := fmt or HDF_SORTUP;
                 //iImage := 0;
               end
          Else begin
                 fmt := fmt or HDF_SORTDOWN;
                 //iImage := 1;
               end;
        End;
      end
      else
      begin
        fmt := HDF_STRING or Align;
        //iImage := 0;
      end;
    end;

    SendMessage(hHeader, HDM_SETITEM, vSortColumn, Integer(@HD));
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.SetSortAscending(const Value: Boolean);
begin
  Try
    If vSortAscending <> Value Then
    Begin
      If Not ( csLoading in ComponentState ) Then
        SetColumnImage( False );

      vSortAscending := Value;

      If Not ( csLoading in ComponentState ) Then
      Begin
        SetColumnImage( True );
        PerformSort;
      End;
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.SetSortColumn(const Value: Integer);
begin
  Try
    If vSortColumn <> Value Then
    Begin
      If Not ( csLoading in ComponentState ) Then
        SetColumnImage( False );
      vSortColumn := Value;
      If Not ( csLoading in ComponentState ) Then
      Begin
        SetColumnImage( True );
        PerformSort;
      End;
    End;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

procedure TCJDListView.WMNotify(var Msg: TWMNotify);
begin
  Try
    //It's important that the inherited code is executed FIRST!
    Inherited;
    //The trapped message will note take effect if you do it before calling the inherited version.
    case Msg.NMHdr^.code of
      HDN_ENDTRACK:
        DoEndColumnResize(FindColumnIndex(Msg.NMHdr), FindColumnWidth(Msg.NMHdr));
      HDN_BEGINTRACK:
        DoBeginColumnResize(FindColumnIndex(Msg.NMHdr), FindColumnWidth(Msg.NMHdr));
      HDN_TRACK:
        DoColumnResize(FindColumnIndex(Msg.NMHdr), FindColumnWidth(Msg.NMHdr));
    end;
  Except
    On E : EAbort Do
      Raise;  //I don't care about EAborts.
    On E : CJDException Do
      Raise;  //Reraise the original Exception
    On E : Exception Do
      Raise CJDException.Create( E.Message, 'Original class:' + E.ClassName ) at ExceptAddr;
  End;
end;

end.
0
 
LVL 4

Author Comment

by:Colin_Dawson
ID: 12290557
I object to that.  In my last comment on this, I posted an entire component which shows exactly how to implement the shading.  Also as a complete freebie, it shows how to sort on any column without needed to write special code for each column.

To that end, I submit that this did answer the question more than properly and correctly.   You only need to cut and paste to has a complete component with all the work done.
0
 
LVL 4

Author Comment

by:Colin_Dawson
ID: 12290570
LOL,  I just noticed that I asked the question in the first place.  whoops.   I still think that I should get the points though ;-)
0
 
LVL 1

Expert Comment

by:Computer101
ID: 12328378
PAQed, with points refunded (125)

Computer101
E-E Admin
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Suggested Solutions

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now