home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Freelog 11
/
Freelog011.iso
/
BestOf
/
PhoenixMail
/
Source
/
comps
/
EnhListView.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1999-01-06
|
55KB
|
1,815 lines
{*****************************************************************************
*
* Parts of this code were changed by Michael Haller
* E-mail: michael@discountdrive.com
* Homepage: http://www.discountdrive.com/sunrise/
*
* The copyright has the original author of this code.
*
*****************************************************************************}
{$I DFS.INC} { Standard defines for all Delphi Free Stuff components }
// Delphi 2 and C++B 1 have incorrectly declared InsertItem as private.
{$IFDEF DFS_COMPILER_3_UP}
{$DEFINE DFS_FIXED_LIST_VIEW}
{$ENDIF}
{.$DEFINE DFS_DEBUG}
{------------------------------------------------------------------------------}
{ TEnhListView v3.10 }
{------------------------------------------------------------------------------}
{ A list view control that provides enhanced functionality beyond the }
{ standard list view. For example, automatic sorting of simple data types, }
{ owner draw event for vsReport mode, and more. This does NOT require any }
{ special version of COMCTL32.DLL. }
{ Copyright 1998, Brad Stowers. All Rights Reserved. }
{ This component can be freely used and distributed in commercial and private }
{ environments, provied this notice is not modified in any way. }
{------------------------------------------------------------------------------}
{ Feel free to contact me if you have any questions, comments or suggestions }
{ at bstowers@pobox.com. }
{ The lateset version will always be available on the web at: }
{ http://www.pobox.com/~bstowers/delphi/ }
{ See ELV.txt for notes, known issues, and revision history. }
{------------------------------------------------------------------------------}
{ Date last modified: July 22, 1998 }
{------------------------------------------------------------------------------}
// C++Builder 3 requires this if you use run-time packages.
{$IFDEF DFS_CPPB_3_UP}
{$ObjExportAll On}
{$ENDIF}
unit EnhListView;
interface
{$IFNDEF DFS_WIN32}
ERROR! This unit only available for Delphi 2.0 or higher!!!
{$ENDIF}
uses
Windows, Messages, Classes, Controls, ComCtrls, CommCtrl, SysUtils, Graphics,
StdCtrls, Menus, Dialogs, DFSAbout;
const
{ This shuts up C++Builder 3 about the redefiniton being different. There
seems to be no equivalent in C1. Sorry. }
{$IFDEF DFS_CPPB_3_UP}
{$EXTERNALSYM DFS_COMPONENT_VERSION}
{$ENDIF}
DFS_COMPONENT_VERSION = 'TEnhListView v3.10';
DRAWTEXTEX_FLAGS = DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER or
DT_END_ELLIPSIS;
DRAWTEXTEX_ALIGNMENT: array[TAlignment] of UINT = (DT_LEFT, DT_RIGHT,
DT_CENTER);
WM_OWNERDRAWCOLUMNS = WM_USER + 143;
type
TIntArray = array[0..(MaxInt div SizeOf(Integer)-1)] of Integer;
PIntArray = ^TIntArray;
TResizeMethod = (rmFitText, rmFitHeader);
TAutoColumnSort = (acsNoSort, acsSort, acsSortToggle);
TAutoSortStyle = (assSmart, assDefault);
TLVStyle = (lvStandard, lvOwnerDrawFixed);
TLVHDrawItemEvent = procedure(Control: TWinControl; var ACanvas: TCanvas;
Index: Integer; var ARect: TRect; Selected: boolean;
var DefaultDrawing: boolean) of object;
TLVMeasureItemEvent = procedure(Control: TWinControl;
var AHeight: UINT) of object;
TLVDrawItemEvent = procedure(Control: TWinControl; var ACanvas: TCanvas;
Index: Integer; ARect: TRect; State: TOwnerDrawState;
var DefaultDrawing, FullRowSelect: boolean) of object;
TLVDrawSubItemEvent = procedure(Control: TWinControl; var ACanvas: TCanvas;
Index, SubItem: Integer; ARect: TRect; State: TOwnerDrawState;
var DefaultDrawing: boolean) of object;
TLVAfterDrawItemEvent = procedure(Control: TWinControl; var ACanvas: TCanvas;
Index: Integer; ARect: TRect; State: TOwnerDrawState) of object;
TLVSortItemsEvent = procedure(Sender: TObject; Item1, Item2: TListItem;
SortColumn: integer; var CompResult: integer) of object;
TLVSortStatusEvent = procedure(Sender: TObject; SortColumn: integer;
Ascending: boolean) of object;
TLVEditCanceled = procedure(Sender: TObject; Item: TListItem) of object;
// Class for saved settings
TEnhLVSaveSettings = class(TPersistent)
private
FAutoSave: boolean;
FRegistryKey: string;
FSaveColumnSizes: boolean;
FSaveCurrentSort: boolean;
public
constructor Create; virtual;
procedure StoreColumnSizes(ColCount: integer;
const IntArray: array of integer);
procedure ReadColumnSizes(ColCount: integer;
var IntArray: array of integer);
procedure StoreCurrentSort(Ascending: boolean; SortCol: integer);
procedure ReadCurrentSort(var Ascending: boolean; var SortCol: integer);
published
property AutoSave: boolean read FAutoSave write FAutoSave default FALSE;
property RegistryKey: string read FRegistryKey write FRegistryKey;
property SaveColumnSizes: boolean
read FSaveColumnSizes
write FSaveColumnSizes
default TRUE;
property SaveCurrentSort: boolean
read FSaveCurrentSort
write FSaveCurrentSort
default TRUE;
end;
{ The new class }
TCustomEnhListView = class(TCustomListView)
private
FSortDirty: boolean;
FUpdateCount: integer;
FStyle: TLVStyle;
FAutoColumnSort: TAutoColumnSort;
FAutoSortStyle: TAutoSortStyle;
FAutoResort: boolean;
FAutoSortAscending: boolean;
FTmpAutoSortAscending: boolean;
FLastColumnClicked: Integer;
FSaveSettings: TEnhLVSaveSettings;
FShowSortArrows: boolean;
FReverseSortArrows: boolean;
FSortUpBmp,
FSortDownBmp: TBitmap;
FOnSortBegin: TLVSortStatusEvent;
FOnSortFinished: TLVSortStatusEvent;
FOnMeasureItem: TLVMeasureItemEvent;
FOnDrawItem: TLVDrawItemEvent;
FOnDrawSubItem: TLVDrawSubItemEvent;
FOnAfterDefaultDrawItem: TLVAfterDrawItemEvent;
FOnDrawHeader: TLVHDrawItemEvent;
FOnSortItems: TLVSortItemsEvent;
FOnEditCanceled: TLVEditCanceled;
{ Message handlers }
procedure CMSysColorChange(var Message: TWMSysColorChange);
message CM_SYSCOLORCHANGE;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;
procedure WMDrawHeader(var Message: TWMDrawItem); message WM_DRAWITEM;
procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
procedure WMOwnerDrawColumns(var Message: TMessage);
message WM_OWNERDRAWCOLUMNS;
protected
{ USE WITH CARE. This can be NIL }
FCanvas: TCanvas;
FHeaderHandle: HWND;
procedure InvalidateColumnHeader(Index: integer); virtual;
procedure DoSort(ColumnIndex:integer; Descending: boolean); virtual;
procedure SortBegin(ColumnIndex: integer; Ascending: boolean); virtual;
procedure SortFinished(ColumnIndex: integer; Ascending: boolean); virtual;
procedure SortItems(const Item1, Item2: TListItem; SortColumn: integer;
var CompResult: integer); virtual;
procedure MeasureItem(var Height: UINT); virtual;
procedure DefaultDrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState; FullRowSelect: boolean); virtual;
procedure DefaultDrawSubItem(Index, SubItem: integer; Rect: TRect;
State: TOwnerDrawState); virtual;
procedure ProcessDrawItemMsg(Index: Integer;
Rect: TRect; State: TOwnerDrawState; var DefaultDrawing,
FullRowSelect: boolean); virtual;
function ActualColumnIndex(Index: integer): integer; virtual;
function GetActualColumn(Index: integer): TListColumn; virtual;
function GetSubItemText(Index, SubItem: integer): string; virtual;
procedure DrawSubItem(Index, SubItem: Integer; Rect: TRect;
State: TOwnerDrawState; var DefaultDrawing: boolean); virtual;
procedure DrawItem(var Canvas: TCanvas; Index: Integer; Rect: TRect;
State: TOwnerDrawState; var DefaultDrawing,
FullRowSelect: boolean);
{$IFDEF DFS_COMPILER_4_UP} reintroduce; overload; {$ENDIF} virtual;
procedure AfterDrawItem(var Canvas: TCanvas; Index: Integer;
Rect: TRect; State: TOwnerDrawState); virtual;
procedure Edit(const Item: TLVItem); override;
procedure EditCanceled(const Item: TLVItem); virtual;
{ Overriden ancestor methods }
procedure ColClick(Column: TListColumn); override;
{$IFDEF DFS_FIXED_LIST_VIEW}
procedure InsertItem(Item: TListItem); override;
{$ENDIF}
procedure CreateWnd; override;
procedure DestroyWnd; override;
procedure ProcessDrawHeaderMsg(Index: Integer; Rect: TRect;
State: TOwnerDrawState; var DefaultDrawing: boolean); virtual;
procedure DrawHeader(var Canvas: TCanvas; Index: Integer; var Rect: TRect;
Selected: boolean; var DefaultDrawing: boolean); virtual;
procedure DefaultDrawHeader(var Canvas: TCanvas; Index: Integer;
var Rect: TRect; Selected: boolean); virtual;
procedure SetOnDrawHeader(Value: TLVHDrawItemEvent); virtual;
procedure SetColumnsOwnerDrawFlag(OwnerDrawn: boolean); virtual;
procedure CreateSortBmps(var UpBmp, DownBmp: TBitmap); virtual;
{ Property methods }
procedure SetAutoColumnSort(Value: TAutoColumnSort);
procedure SetAutoSortStyle(Value: TAutoSortStyle);
procedure SetCurrentSortAscending(Value: boolean);
procedure SetAutoSortAscending(Value: boolean);
procedure SetStyle(Value: TLVStyle);
procedure SetShowSortArrows(Value: boolean);
procedure SetReverseSortArrows(Value: boolean);
procedure SetLastColumnClicked(Value: integer);
procedure SetAutoResort(Value: boolean);
function GetVersion: TDFSVersion; virtual;
procedure SetVersion(const Val: TDFSVersion);
function GetCurrentColumnWidth(Index: integer): integer;
procedure CreateParams(var Params: TCreateParams); override;
procedure Loaded; override;
{ Should probably remain protected }
property SortUpBmp: TBitmap
read FSortUpBmp;
property SortDownBmp: TBitmap
read FSortDownBmp;
{ Should be made public by descendants as needed }
property LastColumnClicked: Integer
read FLastColumnClicked
write SetLastColumnClicked;
{ Should be published by descendants as needed }
property HeaderHandle: HWnd
read FHeaderHandle;
property AutoColumnSort: TAutoColumnSort
read FAutoColumnSort
write SetAutoColumnSort
default acsNoSort;
property AutoSortStyle: TAutoSortStyle
read FAutoSortStyle
write SetAutoSortStyle
default assSmart;
property AutoResort: boolean
read FAutoResort
write SetAutoResort
default TRUE;
property AutoSortAscending: boolean
read FAutoSortAscending
write SetAutoSortAscending
default TRUE;
property ShowSortArrows: boolean
read FShowSortArrows
write SetShowSortArrows
default FALSE;
property ReverseSortArrows: boolean
read FReverseSortArrows
write SetReverseSortArrows
default FALSE;
property CurrentSortAscending: boolean
read FTmpAutoSortAscending
write SetCurrentSortAscending;
property SaveSettings: TEnhLVSaveSettings
read FSaveSettings
write FSaveSettings;
property Style: TLVStyle
read FStyle
write SetStyle
default lvStandard;
property CurrentColumnWidth[Index: integer]: integer
read GetCurrentColumnWidth;
{ Events }
property OnDrawHeader: TLVHDrawItemEvent
read FOnDrawHeader
write SetOnDrawHeader;
property OnMeasureItem: TLVMeasureItemEvent
read FOnMeasureItem
write FOnMeasureItem;
property OnDrawItem: TLVDrawItemEvent
read FOnDrawItem
write FOnDrawItem;
property OnDrawSubItem: TLVDrawSubItemEvent
read FOnDrawSubItem
write FOnDrawSubItem;
property OnAfterDefaultDrawItem: TLVAfterDrawItemEvent
read FOnAfterDefaultDrawItem
write FOnAfterDefaultDrawItem;
property OnSortItems: TLVSortItemsEvent
read FOnSortItems
write FOnSortItems;
property OnSortBegin: TLVSortStatusEvent
read FOnSortBegin
write FOnSortBegin;
property OnSortFinished: TLVSortStatusEvent
read FOnSortFinished
write FOnSortFinished;
property OnEditCanceled: TLVEditCanceled
read FOnEditCanceled
write FOnEditCanceled;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function StoreSettings: boolean; virtual;
function LoadSettings: boolean; virtual;
procedure DefaultSort(ColumnIndex:integer; Descending: boolean); virtual;
procedure Resort; virtual;
// Use these as replacements for Items.BeginUpdate and EndUpdate. They
// call those methods, but they also inhibit autosorting until after the
// last EndUpdate.
procedure BeginUpdate; virtual;
procedure EndUpdate; virtual;
// Resize all columns.
procedure ResizeColumns(ResizeMethod: TResizeMethod); virtual;
// Accounts for re-ordered columns
property ActualColumn[Index: integer]: TListColumn
read GetActualColumn;
published
property Version: TDFSVersion
read GetVersion
write SetVersion
stored FALSE;
end;
TEnhListView = class(TCustomEnhListView)
public
property HeaderHandle;
property CurrentSortAscending;
property LastColumnClicked;
property CurrentColumnWidth;
published
property AutoColumnSort;
property AutoSortStyle;
property AutoResort;
property AutoSortAscending;
property ReverseSortArrows;
property ShowSortArrows;
property SaveSettings;
property Style;
property OnMeasureItem;
property OnDrawItem;
property OnDrawSubItem;
property OnAfterDefaultDrawItem;
property OnDrawHeader;
property OnSortItems;
property OnSortBegin;
property OnSortFinished;
property OnEditCanceled;
{ Publish TCustomListView inherited protected properties }
property Align;
property BorderStyle;
property Color;
property ColumnClick;
property OnClick;
property OnDblClick;
property Columns;
property Ctl3D;
property DragMode;
property ReadOnly
default False;
property Enabled;
property Font;
property HideSelection;
property IconOptions;
property Items;
property AllocBy;
property MultiSelect;
property OnChange;
property OnChanging;
property OnColumnClick;
property OnDeletion;
property OnEdited;
property OnEditing;
property OnEnter;
property OnExit;
property OnInsert;
property OnDragDrop;
property OnDragOver;
property DragCursor;
property OnStartDrag;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property ParentColor
default False;
property ParentFont;
property ParentShowHint;
property ShowHint;
property PopupMenu;
property ShowColumnHeaders;
property TabOrder;
property TabStop
default True;
property ViewStyle;
property Visible;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property LargeImages;
property SmallImages;
property StateImages;
end;
var
{ Default drawing variables }
DefDraw_TextOffset: integer; // Offset for the text -- 5
DefDraw_ImageOffset: integer; // Offset for image -- 2
implementation
uses
{$IFDEF DFS_COMPILER_4_UP} ImgList, {$ENDIF} Registry;
var
FDirection,
FSortColNum: integer;
function __CustomSortProc1__(Item1, Item2: TListItem; Data: integer): integer;
stdcall;
function IsValidNumber(const S: string; var V: extended): boolean;
var
NumCode: integer;
begin
Val(S, V, NumCode);
Result := (NumCode = 0);
end;
// date conversion will fail if using long format, e.g. '1 January 1994'
function IsValidDateTime(const S: string; var D: TDateTime): boolean;
var
HasDate: boolean;
HasTime: boolean;
begin
HasDate := Pos(DateSeparator, S) > 0;
HasTime := Pos(TimeSeparator, S) > 0;
Result := HasDate or HasTime;
if Result then
begin
try
if HasDate and HasTime then
D := StrToDateTime(S)
else if HasDate then
D := StrToDate(S)
else if HasTime then
D := StrToTime(S);
except
// Something failed to convert...
D := 0;
Result := FALSE;
end;
end;
end; { IsValidDateTime }
var
Str1, Str2: string;
Val1, Val2: extended;
Date1, Date2: TDateTime;
Diff: TDateTime;
begin
if (Item1 = NIL) or (Item2 = NIL) then
begin
// something bad happening, I'm outta here
Result := 0;
exit;
end;
try
if FSortColNum = -1 then
begin
//Str1 := Item1.Caption;
//Str2 := Item2.Caption;
{ Changed by Michael Haller }
if Item1.StateIndex = -1 then begin
Str1 := IntToStr(Item1.ImageIndex);
Str2 := IntToStr(Item2.ImageIndex);
end else begin
Str1 := IntToStr(Item1.StateIndex);
Str2 := IntToStr(Item2.StateIndex);
end;
end else begin
if FSortColNum < Item1.SubItems.Count then
Str1 := Item1.SubItems[FSortColNum]
else
Str1 := '';
if FSortColNum < Item2.SubItems.Count then
Str2 := Item2.SubItems[FSortColNum]
else
Str2 := '';
end;
if TCustomEnhListView(Data).AutoSortStyle = assSmart then
begin
if IsValidDateTime(Str1, Date1) and IsValidDateTime(Str2, Date2) then
begin
Diff := Date1 - Date2;
if Diff < 0.0 then Result := -1
else if Diff > 0.0 then Result := 1
else Result := 0
end else if IsValidNumber(Str1, Val1) and IsValidNumber(Str2, Val2) then
begin
if Val1 < Val2 then Result := -1
else if Val1 > Val2 then Result := 1
else Result := 0
end else
Result := AnsiCompareStr(Str1, Str2);
end else
Result := AnsiCompareStr(Str1, Str2);
Result := FDirection * Result; // Set direction flag.
except
Result := 0; // Something went bad in the comparison. Say they are equal.
end;
end;
function __CustomSortProc2__(Item1, Item2: TListItem; Data: integer): integer;
stdcall;
var
EvRes: integer;
begin
EvRes := 0;
TCustomEnhListView(Data).SortItems(Item1, Item2, FSortColNum, EvRes);
Result := EvRes * FDirection;
end;
constructor TEnhLVSaveSettings.Create;
begin
inherited Create;
FAutoSave := FALSE;
FRegistryKey := '';
FSaveColumnSizes := TRUE;
SaveCurrentSort := TRUE;
end;
procedure TEnhLVSaveSettings.StoreColumnSizes(ColCount: integer;
const IntArray: array of integer);
var
Reg: TRegIniFile;
x: integer;
s: string;
begin
if ColCount < 1 then exit;
s := '';
{ Changed by Michael Haller }
s := '20,';
for x := 1 to ColCount-1 do
s := s + IntToStr(IntArray[x]) + ',';
SetLength(s, Length(s)-1);
Reg := TRegIniFile.Create(FRegistryKey);
try
Reg.WriteString('Columns', 'Sizes', s);
finally
Reg.Free;
end;
end;
procedure TEnhLVSaveSettings.ReadColumnSizes(ColCount: integer;
var IntArray: array of integer);
var
Reg: TRegIniFile;
x,y: integer;
s: string;
begin
if ColCount < 1 then exit;
s := '';
Reg := TRegIniFile.Create(FRegistryKey);
try
s := Reg.ReadString('Columns', 'Sizes', '');
finally
Reg.Free;
end;
if s = '' then
begin
IntArray[0] := -1;
exit;
end;
y := 0;
for x := 0 to ColCount-1 do
begin
try
y := Pos(',', s);
if y = 0 then
y := Length(s)+1;
IntArray[x] := StrToInt(Copy(s, 1, y-1));
except
IntArray[x] := 0;
end;
s := copy(s, y+1, length(s));
if s = '' then break;
end;
end;
procedure TEnhLVSaveSettings.StoreCurrentSort(Ascending: boolean;
SortCol: integer);
var
Reg: TRegIniFile;
begin
Reg := TRegIniFile.Create(FRegistryKey);
try
//Reg.WriteBool('Sort', 'Ascending', Ascending);
{ Changed by Michael Haller }
if Ascending then
Reg.WriteString('Sort', 'Ascending', '1')
else
Reg.WriteString('Sort', 'Ascending', '0');
Reg.WriteInteger('Sort', 'SortCol', SortCol);
finally
Reg.Free;
end;
end;
procedure TEnhLVSaveSettings.ReadCurrentSort(var Ascending: boolean;
var SortCol: integer);
var
Reg: TRegIniFile;
begin
Reg := TRegIniFile.Create(FRegistryKey);
try
Ascending := Reg.ReadBool('Sort', 'Ascending', TRUE);
SortCol := Reg.ReadInteger('Sort', 'SortCol', 0);
finally
Reg.Free;
end;
end;
// Override constructor to "zero out" our internal variable.
constructor TCustomEnhListView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FHeaderHandle := 0;
FSortDirty := FALSE;
FUpdateCount := 1; // inhibit sorting until finished creating.
FSaveSettings := TEnhLVSaveSettings.Create;
FAutoColumnSort := acsNoSort;
FAutoResort := TRUE;
FAutoSortStyle := assSmart;
FAutoSortAscending := TRUE;
FTmpAutoSortAscending := FAutoSortAscending;
FLastColumnClicked := -1;
FCanvas := NIL;
FStyle := lvStandard;
FSortUpBmp := NIL;
FSortDownBmp := NIL;
FShowSortArrows := FALSE;
FReverseSortArrows := FALSE;
end;
destructor TCustomEnhListView.Destroy;
begin
FSortUpBmp.Free;
FSortDownBmp.Free;
FCanvas.Free;
inherited Destroy;
FSaveSettings.Free;
end;
procedure TCustomEnhListView.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if (FStyle = lvOwnerDrawFixed) then
begin
Params.Style := Params.Style or LVS_OWNERDRAWFIXED;
if FCanvas = NIL then
FCanvas := TCanvas.Create;
end else
begin
if (not assigned(FOnDrawHeader)) and (not FShowSortArrows) then
begin
FCanvas.Free;
FCanvas := NIL;
end;
end;
end;
procedure TCustomEnhListView.CreateWnd;
begin
inherited CreateWnd;
// If we are loading object from stream (form file), we have to wait until
// everything is loaded before populating the list. If we are not loading,
// i.e. the component was created dynamically or was just dropped on a form,
// we need to reset the flag now.
if not (csLoading in ComponentState) then
FUpdateCount := 0;
end;
procedure TCustomEnhListView.Loaded;
begin
inherited Loaded;
HandleNeeded;
FUpdateCount := 0;
if (not LoadSettings) or (not SaveSettings.SaveCurrentSort) then
begin
if Columns.Count > 0 then
FLastColumnClicked := 0;
Resort;
end;
// Something flaky going on. Hard to explain, but this clears it up.
PostMessage(Handle, WM_OWNERDRAWCOLUMNS, 0, 0);
end;
procedure TCustomEnhListView.WMDestroy(var Message: TWMDestroy);
begin
StoreSettings;
inherited;
end;
function TCustomEnhListView.StoreSettings: boolean;
var
ColCount: integer;
ColArray: PIntArray;
x: integer;
begin
if FSaveSettings.AutoSave and
(([csDesigning, csLoading, csReading] * ComponentState) = []) then
begin
Result := TRUE;
ColCount := Columns.Count;
if ColCount > 0 then
begin
GetMem(ColArray, SizeOf(Integer)*ColCount);
try
if FSaveSettings.SaveColumnSizes then
begin
for x := 0 to ColCount-1 do
ColArray[x] := ActualColumn[x].Width;
FSaveSettings.StoreColumnSizes(ColCount, ColArray^);
end;
if FSaveSettings.SaveCurrentSort then
FSaveSettings.StoreCurrentSort(CurrentSortAscending, LastColumnClicked);
finally
FreeMem(ColArray);
end;
end;
end else
Result := FALSE;
end;
function TCustomEnhListView.LoadSettings: boolean;
var
ColCount: integer;
ColArray: PIntArray;
x: integer;
SortCol: integer;
SortAscending: boolean;
begin
if FSaveSettings.AutoSave and (not(csDesigning in ComponentState)) then
begin
Result := TRUE;
ColCount := Columns.Count;
if ColCount > 0 then
begin
GetMem(ColArray, SizeOf(Integer)*ColCount);
try
if FSaveSettings.SaveColumnSizes then
begin
FSaveSettings.ReadColumnSizes(ColCount, ColArray^);
if ColArray[0] <> -1 then
for x := 0 to ColCount-1 do
ActualColumn[x].Width := ColArray[x];
end;
finally
FreeMem(ColArray);
end;
end;
if FSaveSettings.SaveCurrentSort then
begin
FSaveSettings.ReadCurrentSort(SortAscending, SortCol);
if SortCol >= Columns.Count then
SortCol := Columns.Count-1;
if SortCol < 0 then
SortCol := 0;
BeginUpdate;
try
CurrentSortAscending := SortAscending;
LastColumnClicked := SortCol;
Resort;
finally
EndUpdate;
end;
end;
end else
Result := FALSE;
end;
procedure TCustomEnhListView.DoSort(ColumnIndex:integer; Descending: boolean);
begin
FSortDirty := FALSE;
LastColumnClicked := ColumnIndex;
SortBegin(ColumnIndex, not Descending);
if Descending then
FDirection := 1
else
FDirection := -1;
FSortColNum := ColumnIndex - 1;
if assigned(FOnSortItems) then
CustomSort(@__CustomSortProc2__, integer(Self))
else
CustomSort(@__CustomSortProc1__, integer(Self));
SortFinished(ColumnIndex, not Descending);
end;
procedure TCustomEnhListView.DefaultSort(ColumnIndex: integer;
Descending: boolean);
begin
// Check if the sort order should be toggled
if FAutoColumnSort = acsSortToggle then
if LastColumnClicked = ColumnIndex then
FTmpAutoSortAscending := not Descending
else
FTmpAutoSortAscending := Descending;
InvalidateColumnHeader(ColumnIndex);
DoSort(ColumnIndex, Descending);
end;
procedure TCustomEnhListView.SortItems(const Item1, Item2: TListItem;
SortColumn: integer; var CompResult: integer);
begin
// The only way to get in here is if FOnSortItems is assigned, so don't bother
// checking for NIL
FonSortItems(Self, Item1, Item2, SortColumn, CompResult);
end;
procedure TCustomEnhListView.SortBegin(ColumnIndex: integer;
Ascending: boolean);
begin
if assigned(FOnSortBegin) then
FOnSortBegin(Self, ColumnIndex, Ascending);
end;
procedure TCustomEnhListView.SortFinished(ColumnIndex: integer;
Ascending: boolean);
begin
if assigned(FOnSortFinished) then
FOnSortFinished(Self, ColumnIndex, Ascending);
end;
procedure TCustomEnhListView.ColClick(Column: TListColumn);
begin
// Check if the sort order should be toggled
if FAutoColumnSort = acsSortToggle then
if LastColumnClicked = Column.Index then
FTmpAutoSortAscending := not FTmpAutoSortAscending
else
FTmpAutoSortAscending := FAutoSortAscending;
inherited ColClick(Column);
if (FAutoColumnSort <> acsNoSort) and (Column.Index < Columns.Count) then
DoSort(Column.Index, FTmpAutoSortAscending);
LastColumnClicked := Column.Index;
end;
{$IFDEF DFS_FIXED_LIST_VIEW}
procedure TCustomEnhListView.InsertItem(Item: TListItem);
begin
inherited InsertItem(Item);
if FAutoResort then
Resort;
end;
{$ENDIF}
procedure TCustomEnhListView.Edit(const Item: TLVItem);
begin
inherited Edit(Item);
if FAutoResort then
Resort;
end;
type
THackListItems = class(TListItems)
end;
procedure TCustomEnhListView.EditCanceled(const Item: TLVItem);
begin
if assigned(FOnEditCanceled) then
with Item do
FOnEditCanceled(Self, THackListItems(Items).GetItem(iItem));
end;
procedure TCustomEnhListView.CNNotify(var Message: TWMNotify);
begin
inherited;
with Message.NMHdr^ do
case code of
{$IFNDEF DFS_FIXED_LIST_VIEW}
LVN_INSERTITEM:
if FAutoResort then
Resort;
{$ENDIF}
LVN_ENDLABELEDIT:
with PLVDispInfo(Pointer(Message.NMHdr))^ do
if (item.pszText = NIL) and (item.IItem <> -1) then
EditCanceled(item);
end;
end;
procedure TCustomEnhListView.SetAutoColumnSort(Value: TAutoColumnSort);
begin
if FAutoColumnSort <> Value then
begin
FAutoColumnSort := Value;
if FAutoColumnSort <> acsNoSort then
Resort;
end;
end;
procedure TCustomEnhListView.SetAutoSortStyle(Value: TAutoSortStyle);
begin
if FAutoSortStyle <> Value then
begin
FAutoSortStyle := Value;
Resort;
end;
end;
procedure TCustomEnhListView.SetAutoResort(Value: boolean);
begin
if FAutoResort <> Value then
FAutoResort := Value;
end;
procedure TCustomEnhListView.SetCurrentSortAscending(Value: boolean);
begin
if FTmpAutoSortAscending <> Value then
begin
FTmpAutoSortAscending := Value;
InvalidateColumnHeader(FLastColumnClicked);
end;
end;
procedure TCustomEnhListView.SetAutoSortAscending(Value: Boolean);
begin
if FAutoSortAscending <> Value then
begin
FAutoSortAscending := Value;
FTmpAutoSortAscending := Value;
end;
end;
procedure TCustomEnhListView.Resort;
begin
FSortDirty := TRUE;
if ((FAutoColumnSort <> acsNoSort) and (LastColumnClicked >= 0) and
(LastColumnClicked < Columns.Count)) or (assigned(FOnSortItems)) then
begin
if FUpdateCount < 1 then
DoSort(LastColumnClicked, FTmpAutoSortAscending);
end;
end;
procedure TCustomEnhListView.BeginUpdate;
begin
Items.BeginUpdate;
inc(FUpdateCount);
end;
procedure TCustomEnhListView.EndUpdate;
begin
dec(FUpdateCount);
if FUpdateCount < 0 then
FUpdateCount := 0; // In case someone gets overly happy with EndUpdate calls
if FUpdateCount = 0 then
begin
// Need to resort?
if FSortDirty then
Resort;
end;
// Call this last so resort happens before screen redraw is re-enabled.
Items.EndUpdate;
end;
procedure TCustomEnhListView.DrawItem(var Canvas: TCanvas; Index: Integer;
Rect: TRect; State: TOwnerDrawState; var DefaultDrawing,
FullRowSelect: boolean);
begin
DefaultDrawing := not assigned(FOnDrawItem);
if assigned(FOnDrawItem) then
FOnDrawItem(Self, Canvas, Index, Rect, State, DefaultDrawing,FullRowSelect);
end;
procedure TCustomEnhListView.AfterDrawItem(var Canvas: TCanvas; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
if assigned(FOnAfterDefaultDrawItem) then
FOnAfterDefaultDrawItem(Self, Canvas, Index, Rect, State);
end;
procedure TCustomEnhListView.CMSysColorChange(var Message: TWMSysColorChange);
begin
// Need to recreate the sort arrow bmps to use the new system colors
if ShowSortArrows then
CreateSortBmps(FSortUpBmp, FSortDownBmp);
inherited;
end;
procedure TCustomEnhListView.CNMeasureItem(var Message: TWMMeasureItem);
begin
inherited;
MeasureItem(Message.MeasureItemStruct.itemHeight);
Message.Result := 1;
end;
procedure TCustomEnhListView.MeasureItem(var Height: UINT);
begin
if assigned(FOnMeasureItem) then
FOnMeasureItem(Self, Height);
end;
procedure TCustomEnhListView.CNDrawItem(var Message: TWMDrawItem);
var
State: TOwnerDrawState;
DoDefaultDrawing: boolean;
FullRowSelect: boolean;
SavedDC: integer;
begin { CNDrawItem }
If FCanvas = NIL then exit;
with Message.DrawItemStruct^ do
begin
State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
SavedDC := SaveDC(hDC);
FCanvas.Handle := hDC;
try
FCanvas.Font := Font;
FCanvas.Brush := Brush;
DoDefaultDrawing := FALSE;
FullRowSelect := FALSE;
ProcessDrawItemMsg(itemID, rcItem, State, DoDefaultDrawing, FullRowSelect);
finally
FCanvas.Handle := 0;
RestoreDC(hDC, SavedDC);
end;
end;
Message.Result := 1;
end;
function TCustomEnhListView.GetActualColumn(Index: integer): TListColumn;
begin
// Delphi 2 and C++B 1 have a bug in TListColumn.GetWidth. It returns zero
// for the width if the handle hasn't been allocated yet instead of returning
// the value of the internal storage variable like Delphi 3 does. I've also
// had some problems similar under Delphi 3, so I'm just always requiring the
// handle to be valid.
HandleNeeded;
if Index >= Columns.Count then
Result := NIL
else
Result := Columns[Index];
end;
function TCustomEnhListView.GetSubItemText(Index, SubItem: integer): string;
begin
if SubItem < 0 then
Result := Items[Index].Caption
else
Result := Items[Index].SubItems[SubItem];
end;
// SubItem is -1 for Caption item
procedure TCustomEnhListView.DrawSubItem(Index, SubItem: Integer; Rect: TRect;
State: TOwnerDrawState; var DefaultDrawing: boolean);
begin
DefaultDrawing := not assigned(FOnDrawSubItem);
if assigned(FOnDrawSubItem) then
FOnDrawSubItem(Self, FCanvas, Index, SubItem, Rect, State, DefaultDrawing);
end;
procedure TCustomEnhListView.DefaultDrawSubItem(Index, SubItem: Integer;
Rect: TRect; State: TOwnerDrawState);
var
DoDefaultDrawing: boolean;
SavedDC: integer;
begin
DoDefaultDrawing := csDesigning in ComponentState;
SavedDC := SaveDC(FCanvas.Handle);
try
if not (csDesigning in ComponentState) then
DrawSubItem(Index, SubItem, Rect, State, DoDefaultDrawing);
if DoDefaultDrawing then
DrawTextEx(FCanvas.Handle, PChar(GetSubItemText(Index, SubItem)), -1, Rect,
DRAWTEXTEX_FLAGS or
DRAWTEXTEX_ALIGNMENT[ActualColumn[SubItem+1].Alignment], NIL);
finally
RestoreDC(FCanvas.Handle, SavedDC);
end;
end;
{$IFDEF DFS_COMPILER_4_UP}
type
THackImageList = class(TCustomImageList);
{$ENDIF}
procedure TCustomEnhListView.DefaultDrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState; FullRowSelect: boolean);
{$IFDEF DFS_COMPILER_4_UP}
const
DrawingStyles: array[TDrawingStyle] of Longint = (ILD_FOCUS, ILD_SELECTED,
ILD_NORMAL, ILD_TRANSPARENT);
Images: array[TImageType] of Longint = (0, ILD_MASK);
{$ENDIF}
var
{$IFDEF DFS_COMPILER_4_UP}
DS: TDrawingStyle;
{$ELSE}
OldStyle: TDrawingStyle;
{$ENDIF}
OldBlend: TColor;
Count: Integer;
SubRect: TRect;
begin
if Items[Index] = NIL then
// something bad happening, I'm outta here
exit;
if Columns.Count > 0 then
begin
if (odSelected in State) then
begin
if Focused then
begin
FCanvas.Brush.Color := clHighlight;
FCanvas.Font.Color := clHighlightText;
end else begin
if not HideSelection then
begin
FCanvas.Brush.Color := clBtnFace;
FCanvas.Font.Color := clBtnText;
end;
end;
end;
SubRect := Rect;
SubRect.Right := Rect.Left + CurrentColumnWidth[0] - 2;
if assigned(SmallImages) then
begin
OldBlend := SmallImages.BlendColor;
SmallImages.BlendColor := clHighlight;
{$IFDEF DFS_COMPILER_4_UP}
{ Changing DrawStyle causes an invalidate, which is very nasty since we
are in the process of repainting here. Continuous flickering.... }
if (odSelected in State) and Focused then
DS := dsSelected
else
DS := dsTransparent;
THackImageList(SmallImages).DoDraw(Items[Index].ImageIndex, FCanvas,
Rect.Left + DefDraw_ImageOffSet, Rect.Top,
DrawingStyles[DS] or Images[SmallImages.ImageType], Enabled);
{$ELSE}
OldStyle := SmallImages.DrawingStyle;
if (odSelected in State) and Focused then
SmallImages.DrawingStyle := dsSelected
else
SmallImages.DrawingStyle := dsTransparent;
SmallImages.Draw(FCanvas, Rect.Left + DefDraw_ImageOffSet, Rect.Top,
Items[Index].ImageIndex);
SmallImages.DrawingStyle := OldStyle;
{$ENDIF}
SmallImages.BlendColor := OldBlend;
if ActualColumn[0].Alignment = taLeftJustify then
Inc(SubRect.Left, DefDraw_TextOffset + SmallImages.Width);
end else begin
if ActualColumn[0].Alignment = taLeftJustify then
Inc(SubRect.Left, DefDraw_TextOffset);
end;
DefaultDrawSubItem(Index, -1, SubRect, State);
// Already done column 0, start at 1.
for Count := 1 to Columns.Count-1 do
begin
{ Restore this through each iteration since they may screw with it in
the OnDrawSubItem event. }
if not FullRowSelect then
begin
FCanvas.Brush.Color := clWindow;
FCanvas.Font.Color := clWindowText;
end;
if Count > Items[Index].SubItems.Count then
continue; // Hidden item
if ActualColumn[Count].Alignment = taLeftJustify then
begin
SubRect.Left := SubRect.Right;
SubRect.Right := SubRect.Left + CurrentColumnWidth[Count];
Inc(SubRect.Left, DefDraw_TextOffset)
end else begin
SubRect.Left := SubRect.Right + DefDraw_TextOffset;
SubRect.Right := SubRect.Left + CurrentColumnWidth[Count];
Dec(SubRect.Right, DefDraw_TextOffset);
end;
DefaultDrawSubItem(Index, Count-1, SubRect, State);
end;
end;
end;
procedure TCustomEnhListView.ProcessDrawItemMsg(Index: Integer; Rect: TRect;
State: TOwnerDrawState; var DefaultDrawing, FullRowSelect: boolean);
var
SubRect: TRect;
begin
DefaultDrawing := csDesigning in ComponentState;
if not (csDesigning in ComponentState) then
DrawItem(FCanvas, Index, Rect, State, DefaultDrawing, FullRowSelect);
if DefaultDrawing then
begin
FCanvas.FillRect(Rect);
if (Index >= 0) then
begin
if (odSelected in State) then
begin
if (not HideSelection) or Focused then
begin
if Focused then
FCanvas.Brush.Color := clHighlight
else
FCanvas.Brush.Color := clBtnFace;
SubRect := Rect;
Inc(SubRect.Left, DefDraw_TextOffset - 2);
if (not FullRowSelect) then
begin
if assigned(Items[Index]) then
SubRect.Right := SubRect.Left +
FCanvas.TextWidth(Items[Index].Caption) + 8;
if assigned(SmallImages) then
OffsetRect(SubRect, SmallImages.Width, 0);
// Don't let it go past first column width
if (Columns.Count > 0) and
(CurrentColumnWidth[0] < SubRect.Right) then
SubRect.Right := CurrentColumnWidth[0];
end else
if assigned(SmallImages) then
Inc(SubRect.Left, SmallImages.Width);
FCanvas.FillRect(SubRect);
end;
end;
DefaultDrawItem(Index, Rect, State, FullRowSelect);
if (odFocused in State) and Focused then
begin
SubRect := Rect;
Inc(SubRect.Left, DefDraw_TextOffset - 2);
if (not FullRowSelect) then
begin
if assigned(Items[Index]) then
SubRect.Right := SubRect.Left +
FCanvas.TextWidth(Items[Index].Caption) + 8;
if assigned(SmallImages) then
OffsetRect(SubRect, SmallImages.Width, 0);
// Don't let it go past first column width
if (Columns.Count > 0) and
(CurrentColumnWidth[0] < SubRect.Right) then
SubRect.Right := CurrentColumnWidth[0];
end else
if assigned(SmallImages) then
Inc(SubRect.Left, SmallImages.Width);
FCanvas.DrawFocusRect(SubRect);
end;
end else
FCanvas.FillRect(Rect);
if (not (csDesigning in ComponentState)) then
AfterDrawItem(FCanvas, Index, Rect, State);
end;
end;
procedure TCustomEnhListView.SetStyle(Value: TLVStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
if HandleAllocated then
RecreateWnd;
end;
end;
procedure TCustomEnhListView.SetReverseSortArrows(Value: boolean);
begin
if Value <> FReverseSortArrows then
begin
FReverseSortArrows := Value;
if ShowSortArrows then
begin
CreateSortBmps(FSortUpBmp, FSortDownBmp);
InvalidateColumnHeader(FLastColumnClicked);
end;
end;
end;
procedure TCustomEnhListView.SetShowSortArrows(Value: boolean);
begin
if Value <> FShowSortArrows then
FShowSortArrows := Value;
FSortUpBmp.Free;
FSortDownBmp.Free;
if FShowSortArrows then
begin
FSortUpBmp := TBitmap.Create;
FSortDownBmp := TBitmap.Create;
CreateSortBmps(FSortUpBmp, FSortDownBmp);
if not (csReading in ComponentState) then
SetColumnsOwnerDrawFlag(TRUE);
end else begin
FSortUpBmp := NIL;
FSortDownBmp := NIL;
if not (csReading in ComponentState) then
SetColumnsOwnerDrawFlag(assigned(FOnDrawHeader))
end;
if HandleAllocated then
Invalidate;
end;
procedure TCustomEnhListView.CreateSortBmps(var UpBmp, DownBmp: TBitmap);
var
HeaderHeight: integer;
MidPoint: integer;
Bmp: TBitmap;
begin
if UpBmp = NIL then
UpBmp := TBitmap.Create;
if DownBmp = NIL then
DownBmp := TBitmap.Create;
UpBmp.Canvas.Font.Assign(Font);
HeaderHeight := UpBmp.Canvas.TextHeight('Wy') - 6;
if HeaderHeight > 0 then
begin
if Odd(HeaderHeight) then
Inc(HeaderHeight);
UpBmp.Width := HeaderHeight;
UpBmp.Height := HeaderHeight;
DownBmp.Width := HeaderHeight;
DownBmp.Height := HeaderHeight;
MidPoint := HeaderHeight div 2;
{ Don't ask about the drawing. I just fooled around until I got
something I liked. }
if FReverseSortArrows then
Bmp := UpBmp
else
Bmp := DownBmp;
with Bmp.Canvas do
begin
{changed by Michael Haller}
Brush.Color := clBtnFace;
FillRect(Rect(0, 0, HeaderHeight, HeaderHeight));
Pen.Color := clBtnHighlight;
MoveTo(MidPoint, HeaderHeight-2);
LineTo(HeaderHeight-1, 0);
Pixels[HeaderHeight-1, 0] := Pen.Color;
Pen.Color := clBtnShadow;
MoveTo(HeaderHeight-2, 0);
LineTo(0, 0);
LineTo(MidPoint-1, HeaderHeight-2);
Pixels[MidPoint-1, HeaderHeight-2] := Pen.Color;
end;
if FReverseSortArrows then
Bmp := DownBmp
else
Bmp := UpBmp;
with Bmp.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(Rect(0, 0, HeaderHeight, HeaderHeight));
Pen.Color := clBtnShadow;
MoveTo(0, HeaderHeight-1);
LineTo(MidPoint-1, 0);
Pen.Color := clBtnHighlight;
MoveTo(MidPoint, 0);
LineTo(HeaderHeight-1, HeaderHeight-1);
LineTo(-1, HeaderHeight-1);
Pixels[MidPoint, 0] := clBtnFace;
end;
end;
end;
procedure TCustomEnhListView.DestroyWnd;
begin
inherited DestroyWnd;
FHeaderHandle := 0;
end;
procedure TCustomEnhListView.DrawHeader(var Canvas: TCanvas; Index: Integer;
var Rect: TRect; Selected: boolean; var DefaultDrawing: boolean);
begin
DefaultDrawing := not assigned(FOnDrawHeader);
if assigned(FOnDrawHeader) then
FOnDrawHeader(Self, Canvas, Index, Rect, Selected, DefaultDrawing);
end;
procedure TCustomEnhListView.WMNotify(var Message: TWMNotify);
const
RECURSE_FLAG: boolean = FALSE;
begin
inherited;
// Best way that I can find to snag the real header handle. Kludgy at best,
// but what else are you gonna do?
// No, the if comparisons are NOT backwards, HDN_xxx values are negative.
if (Message.NMHdr.code < HDN_FIRST) and (Message.NMHdr.code > HDN_LAST) then
if Message.NMHdr.hwndFrom <> FHeaderHandle then
FHeaderHandle := Message.NMHdr.hwndFrom;
// Note the recursion flag. This is needed since the SetColumnsOwnerDrawFlag
// call below will cause some HDN_xxx notification messages.
if RECURSE_FLAG then exit;
// For some reason, the SECOND time you drag a header width, it toasts the
// column index in the draw item message. Also seems to reset owner draw
// info at times, too. Anyway, the best fix I could come up with was to
// always watch for a change in the header handle, and always reset the owner
// draw flag.
case Message.NMHdr.code of
HDN_BEGINTRACK, HDN_ITEMCHANGED:
begin
RECURSE_FLAG := TRUE;
try
SetColumnsOwnerDrawFlag(assigned(FOnDrawHeader) or FShowSortArrows);
finally
RECURSE_FLAG := FALSE;
end;
end;
end;
(* old way. had some performance problems when used in conjunction with
TToolbar97 component. No idea why that would cause it, though.
// For some reason, the SECOND time you drag a header width, it toasts the
// column index in the draw item message. Also seems to reset owner draw
// info at times, too. Anyway, the best fix I could come up with was to
// always watch for a change in the header handle, and always reset the owner
// draw flag. Note the recursion flag. This is needed since the
// SetColumnsOwnerDrawFlag will cause some HDN_xxx notification messages.
// Best way that I can find to snag the real header handle. Kludgy at best,
// but what else are you gonna do?
case Message.NMHdr.code of
HDN_LAST..HDN_FIRST:
begin
if Message.NMHdr.hwndFrom <> FHeaderHandle then
FHeaderHandle := Message.NMHdr^.hwndFrom;
if RECURSE_FLAG or (FUpdateCount > 0) then exit;
RECURSE_FLAG := TRUE;
try
SetColumnsOwnerDrawFlag(assigned(FOnDrawHeader) or FShowSortArrows);
finally
RECURSE_FLAG := FALSE;
end;
end;
end;
*)
end;
procedure TCustomEnhListView.WMDrawHeader(var Message: TWMDrawItem);
var
State: TOwnerDrawState;
DoDefaultDrawing: boolean;
SavedDC: integer;
begin { CNDrawItem }
if FCanvas = NIL then exit;
with Message.DrawItemStruct^ do
begin
Message.Result := 1;
State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
SavedDC := SaveDC(hDC);
FCanvas.Handle := hDC;
try
FCanvas.Font := Font;
FCanvas.Brush := Brush;
DoDefaultDrawing := FALSE;
ProcessDrawHeaderMsg(itemID, rcItem, State, DoDefaultDrawing);
finally
FCanvas.Handle := 0;
RestoreDC(hDC, SavedDC);
end;
end;
end;
procedure TCustomEnhListView.ProcessDrawHeaderMsg(Index: Integer; Rect: TRect;
State: TOwnerDrawState; var DefaultDrawing: boolean);
begin
FCanvas.Font.Assign(Font);
FCanvas.Brush.Assign(Brush);
FCanvas.Brush.Style := bsClear;
FCanvas.Brush.Color := clBtnFace;
DefaultDrawing := csDesigning in ComponentState;
if not (csDesigning in ComponentState) then
DrawHeader(FCanvas, Index, Rect, odSelected in State, DefaultDrawing);
if DefaultDrawing then
DefaultDrawHeader(FCanvas, Index, Rect, odSelected in State);
end;
procedure TCustomEnhListView.DefaultDrawHeader(var Canvas: TCanvas;
Index: Integer; var Rect: TRect; Selected: boolean);
var
TheColumn: TListColumn;
Offset: integer;
R, CR: TRect;
Bmp: TBitmap;
begin
(******************************************************************************)
(* NOTE: This method is overriden and replaced in TExtListView. That means *)
(* that if changes are made here, they will also need to be made in *)
(* ExtListView.pas' DefaultDrawHeader method. *)
(******************************************************************************)
if not Selected then
InflateRect(Rect, -2, -2);
Canvas.FillRect(Rect);
if Selected then
InflateRect(Rect, -2, -2);
if (Index >= 0) and (Index < Columns.Count) then
begin
// Don't use ActualColumn[] here! That's for SubItem foolery, not header.
TheColumn := Columns[Index];
if Selected then
begin
inc(Rect.Top);
inc(Rect.Left);
end;
R := Rect;
case TheColumn.Alignment of
taRightJustify:
Dec(R.Right, 4);
taLeftJustify:
Inc(R.Left, 4);
// taCenter needs no modification
end;
if FShowSortArrows and (LastColumnClicked = Index) and
(AutoColumnSort <> acsNoSort) then
begin
if CurrentSortAscending then
Bmp := FSortUpBmp
else
Bmp := FSortDownBmp;
if TheColumn.Alignment = taRightJustify then
Inc(R.Left, Bmp.Width + 8)
else
Dec(R.Right, Bmp.Width + 8);
{ How big of a rectangle do we have to work with for the text? }
CR := R;
DrawTextEx(FCanvas.Handle, PChar(TheColumn.Caption), -1, CR,
DRAWTEXTEX_FLAGS or DT_CALCRECT or
DRAWTEXTEX_ALIGNMENT[TheColumn.Alignment], NIL);
{ Note that DT_CALCRECT does not adjust for alignment. We must do that }
case TheColumn.Alignment of
taRightJustify:
R.Left := R.Right - (CR.Right - CR.Left);
taCenter:
begin
R.Left := R.Left + (((R.Right - R.Left) - (CR.Right - CR.Left)) div
2);
R.Right := R.Left + (CR.Right - CR.Left);
end;
else // taLeftJustify: doesn't matter, that is what DT_CALCRECT returns
R := CR;
end;
if R.Left < Rect.Left then
R.Left := Rect.Left;
if R.Right > Rect.Right then
R.Right := Rect.Right;
if Selected then
OffsetRect(R, 1, 1);
// Draw the caption in the rect available
DrawTextEx(FCanvas.Handle, PChar(TheColumn.Caption), -1, R,
DRAWTEXTEX_FLAGS or DRAWTEXTEX_ALIGNMENT[TheColumn.Alignment], NIL);
// Draw the sort arrow bitmap
Offset := (Rect.Bottom - Rect.Top - Bmp.Height) div 2;
case TheColumn.Alignment of
taRightJustify:
// Only draw if we have enough room
if (R.Left - Bmp.Width - 8) >= Rect.Left then
Canvas.Draw(R.Left - Bmp.Width - 8, R.Top + Offset, Bmp);
else // taLeftJustify, taCenter
// Only draw if we have enough room
if (R.Right + Bmp.Width + 8) <= Rect.Right then
Canvas.Draw(R.Right + 8, R.Top + Offset, Bmp);
end;
end else begin
if Selected then
OffsetRect(R, 1, 1);
DrawTextEx(FCanvas.Handle, PChar(TheColumn.Caption), -1, R,
DRAWTEXTEX_FLAGS or DRAWTEXTEX_ALIGNMENT[TheColumn.Alignment], NIL);
end;
end;
end;
procedure TCustomEnhListView.SetOnDrawHeader(Value: TLVHDrawItemEvent);
begin
FOnDrawHeader := Value;
SetColumnsOwnerDrawFlag(assigned(FOnDrawHeader) or FShowSortArrows);
end;
procedure TCustomEnhListView.SetColumnsOwnerDrawFlag(OwnerDrawn: boolean);
var
Item: THDItem;
x: integer;
begin
if not HandleAllocated then exit;
for x := 0 to Columns.Count-1 do
begin
Item.Mask := HDI_FORMAT;
if Header_GetItem(HeaderHandle, x, Item) then
begin
if OwnerDrawn then
Item.Fmt := Item.Fmt or HDF_OWNERDRAW
else
Item.Fmt := Item.Fmt and not HDF_OWNERDRAW;
Header_SetItem(HeaderHandle, x, Item);
end;
end;
if OwnerDrawn then
begin
if (FCanvas = NIL) then
FCanvas := TCanvas.Create;
end else begin
if (Style = lvStandard) and (FCanvas <> NIL) then
begin
FCanvas.Free;
FCanvas := NIL;
end;
end;
end;
procedure TCustomEnhListView.SetLastColumnClicked(Value: integer);
var
OldValue: integer;
begin
if Value <> FLastColumnClicked then
begin
OldValue := FLastColumnClicked;
FLastColumnClicked := Value;
// If showing arrows and clicked column changes, we have to get rid of the
// old sorting arrow by causing the header to be repainted.
if FShowSortArrows then
// Can't do this above because FLastColumnClicked is used to paint the
// arrow
InvalidateColumnHeader(OldValue);
end;
end;
function TCustomEnhListView.ActualColumnIndex(Index: integer): integer;
begin
Result := Index;
end;
procedure TCustomEnhListView.InvalidateColumnHeader(Index: integer);
function RealColWidth(i: integer): integer;
{$IFDEF DFS_COMPILER_4_UP}
var
Column: TLVColumn;
{$ENDIF}
begin
{$IFDEF DFS_COMPILER_4_UP}
Column.mask := LVCF_WIDTH;
ListView_GetColumn(Handle, i, Column);
Result := Column.cx;
{$ELSE}
Result := Columns[i].Width;
{$ENDIF}
end;
var
R: TRect;
x: integer;
w: integer;
begin
if (Index < 0) or (Index >= Columns.Count) or (HeaderHandle = 0) then
exit;
w := RealColWidth(Index);
// We have to turn this into the actual column index if drag-drop headers have
// re-arranged stuff in the TExtListView descendant component.
Index := ActualColumnIndex(Index);
Windows.GetClientRect(HeaderHandle, R);
for x := 0 to Columns.Count - 1 do
if ActualColumnIndex(x) < Index then
inc(R.Left, RealColWidth(x));
R.Right := R.Left + w;
// Adjust for shadow
InflateRect(R, -2, -2);
InvalidateRect(HeaderHandle, @R, FALSE);
end;
procedure TCustomEnhListView.WMOwnerDrawColumns(var Message: TMessage);
begin
SetColumnsOwnerDrawFlag(assigned(FOnDrawHeader) or FShowSortArrows);
Update;
end;
function TCustomEnhListView.GetVersion: TDFSVersion;
begin
Result := DFS_COMPONENT_VERSION;
end;
procedure TCustomEnhListView.SetVersion(const Val: TDFSVersion);
begin
{ empty write method, just needed to get it to show up in Object Inspector }
end;
procedure TCustomEnhListView.ResizeColumns(ResizeMethod: TResizeMethod);
var
i: integer;
begin
BeginUpdate;
Columns.BeginUpdate;
try
for i := 0 to Columns.Count - 1 do
if ResizeMethod = rmFitText then
Columns[i].Width := -1
else
Columns[i].Width := -2;
finally
EndUpdate;
Columns.EndUpdate;
end;
end;
function TCustomEnhListView.GetCurrentColumnWidth(Index: integer): integer;
{$IFDEF DFS_COMPILER_4_UP}
var
Column: TLVColumn;
{$ENDIF}
begin
{$IFDEF DFS_COMPILER_4_UP}
if HandleAllocated then
begin
Column.mask := LVCF_WIDTH;
ListView_GetColumn(Handle, ActualColumnIndex(Index), Column);
Result := Column.cx;
end else
Result := ActualColumn[Index].Width;
{$ELSE}
Result := ActualColumn[Index].Width;
{$ENDIF}
end;
initialization
DefDraw_TextOffset := 4;
DefDraw_ImageOffset := 2;
end.