home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 2001 September
/
Chip_2001-09_cd1.bin
/
zkuste
/
delphi
/
kolekce
/
d123456
/
DFS.ZIP
/
ExtListView.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2001-06-28
|
102KB
|
3,237 lines
{$I DFS.INC} { Standard defines for all Delphi Free Stuff components }
{.$DEFINE DFS_DEBUG}
{.$DEFINE DFS_TRY_BACKGROUND_IMAGE}
{------------------------------------------------------------------------------}
{ TdfsExtListView v3.72 }
{------------------------------------------------------------------------------}
{ A list view control that enables access to the new style types provieded }
{ by the updated list view control. The updated list view is provided in }
{ the COMCTL32.DLL file that comes with Microsoft's new internet software. }
{ }
{ Copyright 1998-2001, Brad Stowers. All Rights Reserved. }
{ }
{ Copyright: }
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by }
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive }
{ property of the author. }
{ }
{ Distribution Rights: }
{ You are granted a non-exlusive, royalty-free right to produce and distribute }
{ compiled binary files (executables, DLLs, etc.) that are built with any of }
{ the DFS source code unless specifically stated otherwise. }
{ You are further granted permission to redistribute any of the DFS source }
{ code in source code form, provided that the original archive as found on the }
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
{ example, if you create a descendant of TDFSColorButton, you must include in }
{ the distribution package the colorbtn.zip file in the exact form that you }
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip. }
{ }
{ Restrictions: }
{ Without the express written consent of the author, you may not: }
{ * Distribute modified versions of any DFS source code by itself. You must }
{ include the original archive as you found it at the DFS site. }
{ * Sell or lease any portion of DFS source code. You are, of course, free }
{ to sell any of your own original code that works with, enhances, etc. }
{ DFS source code. }
{ * Distribute DFS source code for profit. }
{ }
{ Warranty: }
{ There is absolutely no warranty of any kind whatsoever with any of the DFS }
{ source code (hereafter "software"). The software is provided to you "AS-IS", }
{ and all risks and losses associated with it's use are assumed by you. In no }
{ event shall the author of the softare, Bradley D. Stowers, be held }
{ accountable for any damages or losses that may occur from use or misuse of }
{ the software. }
{ }
{ Support: }
{ Support is provided via the DFS Support Forum, which is a web-based message }
{ system. You can find it at http://www.delphifreestuff.com/discus/ }
{ All DFS source code is provided free of charge. As such, I can not guarantee }
{ any support whatsoever. While I do try to answer all questions that I }
{ receive, and address all problems that are reported to me, you must }
{ understand that I simply can not guarantee that this will always be so. }
{ }
{ Clarifications: }
{ If you need any further information, please feel free to contact me directly.}
{ This agreement can be found online at my site in the "Miscellaneous" section.}
{------------------------------------------------------------------------------}
{ The lateset version of my components are always available on the web at: }
{ http://www.delphifreestuff.com/ }
{ See ELV.txt for notes, known issues, and revision history. }
{------------------------------------------------------------------------------}
{ Date last modified: June 28, 2001 }
{------------------------------------------------------------------------------}
unit ExtListView;
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,
{$IFDEF DFS_COMPILER_4_UP}
ImgList,
{$ENDIF}
StdCtrls, Menus, EnhListView;
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 = 'TdfsExtListView v3.72';
// Setting a subitem image (lvxSubItemImages ExtendStyle) to -1 does not
// properly clear the image for the subitem. The current COMCTL32.DLL
// implementation does not seem to store this value and instead it gets a
// random value assigned to it. The work-around that I have found is to set
// the index to a value that does not exist in the image list. To make this
// a bit easier, I have declared this constant. Assigning this value to
// SubItem_ImageIndex[itemindex] will clear the image from the subitem as long
// as your image list does not have more than 2,147,483,646 images in it. :)
const
ELV_NO_SUBITEM_IMAGE = MAXINT - 1;
// C3 and D4 CommCtrl.pas have almost everything we need
{$IFDEF DFS_CPPB_3_UP}
{$DEFINE DFS_C3D4COMMCTRL}
{$ELSE} {$IFDEF DFS_DELPHI_4_UP}
{$DEFINE DFS_C3D4COMMCTRL}
{$ENDIF} {$ENDIF}
{$IFNDEF DFS_C3D4COMMCTRL}
type
TLVDispInfo = TLVDispInfoA; // Borland forgot this one in D2, D3 & C1s
{$ENDIF}
{$IFNDEF DFS_C3D4COMMCTRL}
const
LVIF_INDENT = $0010;
LVIF_NORECOMPUTE = $0800;
{.$IFDEF DFS_DELPHI_2}
{ These are in COMMCTRL unit
LVCF_FMT = $0001;
LVCF_WIDTH = $0002;
LVCF_TEXT = $0004;
LVCF_SUBITEM = $0008;
}
{.$ENDIF}
LVCF_IMAGE = $0010;
LVCF_ORDER = $0020;
{.$IFDEF DFS_DELPHI_2}
{ These are in COMMCTRL unit
LVCFMT_LEFT = $0000;
LVCFMT_RIGHT = $0001;
LVCFMT_CENTER = $0002;
LVCFMT_JUSTIFYMASK = $0003;
}
{.$ENDIF}
LVCFMT_IMAGE = $0800; // Item displays an image from an image list.
LVCFMT_BITMAP_ON_RIGHT = $1000; // Image appears to right of Text.
LVCFMT_COL_HAS_IMAGES = $8000; // Undocumented.
LVIS_ACTIVATING = $0020;
{$ENDIF}
type
PLVItemEx = ^TLVItemEx;
TLVItemEx = packed record
mask: UINT;
iItem: Integer;
iSubItem: Integer;
state: UINT;
stateMask: UINT;
pszText: PAnsiChar;
cchTextMax: Integer;
iImage: Integer;
lParam: LPARAM;
iIndent: integer;
end;
PLVDispInfoEx = ^TLVDispInfoEx;
TLVDispInfoEx = packed record
hdr: TNMHDR;
item: TLVItemEx;
end;
TLVColumnEx = packed record
mask: UINT;
fmt: Integer;
cx: Integer;
pszText: PAnsiChar;
cchTextMax: Integer;
iSubItem: Integer;
iImage: integer; // New
iOrder: integer; // New
end;
// These functions already exist, and there is no way to override them, so I'll
// just rename them and you can use them as best you can.
function ListView_GetColumnEx(LVWnd: HWND; iCol: Integer;
var pcol: TLVColumnEx): Bool;
function ListView_SetColumnEx(LVWnd: HWnd; iCol: Integer;
const pcol: TLVColumnEx): Bool;
function ListView_InsertColumnEx(LVWnd: HWND; iCol: Integer;
const pcol: TLVColumnEx): Integer;
{$IFNDEF DFS_C3D4COMMCTRL}
const
LVM_GETHEADER = LVM_FIRST + 31;
function ListView_GetHeader(LVWnd: HWnd): HWnd;
{$ENDIF}
{$IFNDEF DFS_COMPILER_3_UP}
const
LVM_SETICONSPACING = LVM_FIRST + 53;
// -1 for cx and cy means we'll use the default (system settings)
// 0 for cx or cy means use the current setting (allows you to change just one
// param)
function ListView_SetIconSpacing(LVWnd: HWnd; cx, cy: integer): DWORD;
const
LVS_EX_GRIDLINES = $00000001; // Report mode only.
LVS_EX_SUBITEMIMAGES = $00000002; // Report mode only.
LVS_EX_CHECKBOXES = $00000004;
LVS_EX_TRACKSELECT = $00000008;
LVS_EX_HEADERDRAGDROP = $00000010; // Report mode only.
LVS_EX_FULLROWSELECT = $00000020; // Report mode only.
LVS_EX_ONECLICKACTIVATE = $00000040;
LVS_EX_TWOCLICKACTIVATE = $00000080;
LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 54; // optional wParam = mask
function ListView_SetExtendedListViewStyle(LVWnd: HWnd; ExStyle: LPARAM): DWORD;
const
LVM_GETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 55;
function ListView_GetExtendedListViewStyle(LVWnd: HWnd): DWORD;
{$ENDIF}
(* These were already defined in everything...
const
LVIR_BOUNDS = 0;
LVIR_ICON = 1;
LVIR_LABEL = 2;
LVIR_SELECTBOUNDS = 3;
*)
{$IFDEF DFS_COMPILER_2}
const
LVM_GETSUBITEMRECT = LVM_FIRST + 56;
function ListView_GetSubItemRect(LVWnd: HWnd; ParentItem, SubItem,
Code: integer; var Rect: TRect): boolean;
const
LVM_SUBITEMHITTEST = LVM_FIRST + 57;
{$ENDIF}
{$IFNDEF DFS_C3D4COMMCTRL}
const
LVS_EX_FLATSB = $00000100;
LVS_EX_REGIONAL = $00000200;
LVS_EX_INFOTIP = $00000400;
LVS_EX_UNDERLINEHOT = $00000800;
LVS_EX_UNDERLINECOLD = $00001000;
LVS_EX_MULTIWORKAREAS = $00002000;
// Pass the LVS_EX_* styles you want to modify in Mask and ExStyle will apply
// only to those. Others will be left in current state. For example, if you
// pass LVS_EX_FULLROWSELECT for Mask and 0 for ExStyle, the
// LVS_EX_FULLROWSELECT style will be cleared, but all other styles will remain
// the same.
function ListView_SetExtendedListViewStyleEx(LVWnd: HWnd; Mask: DWord;
ExStyle: LPARAM): DWORD;
{$ENDIF}
// Should be COMPILER not DELPHI, but can't get Builder 5 to compile it.
{$IFNDEF DFS_CPPB}
{$IFNDEF DFS_DELPHI_7_UP}
const
LVS_EX_LABELTIP = $00004000; // Requires ComCtl32.DLL v5.80
{$ENDIF}
{$ENDIF}
(*
{$IFNDEF DFS_COMPILER_7_UP}
const
LVS_EX_LABELTIP = $00004000; // Requires ComCtl32.DLL v5.80
{$ENDIF}
*)
{$IFNDEF DFS_C3D4COMMCTRL}
// C3 & D4 users don't need this because their COMMCTRL.PAS file has it right
// and they can simply use the existing TLVHitTestInfo and
// ListView_SubItemHitTest()
type
PLVHitTestInfoEx = ^TLVHitTestInfoEx;
TLVHitTestInfoEx = packed record
pt: TPoint;
flags: UINT;
iItem: integer;
iSubItem: integer;
end;
function ListView_SubItemHitTestEx(LVWnd: HWnd;
var HitTestInfo: TLVHitTestInfoEx): integer;
{$ENDIF}
{$IFNDEF DFS_COMPILER_3_UP}
const
LVM_SETCOLUMNORDERARRAY = LVM_FIRST + 58;
function ListView_SetColumnOrderArray(LVWnd: HWnd; Count: integer;
IntArray: PIntArray): boolean;
const
LVM_GETCOLUMNORDERARRAY = LVM_FIRST + 59;
function ListView_GetColumnOrderArray(LVWnd: HWnd; Count: integer;
IntArray: PIntArray): boolean;
const
LVM_SETHOTITEM = LVM_FIRST + 60;
function ListView_SetHotItem(LVWnd: HWnd; Item: integer): integer;
const
LVM_GETHOTITEM = LVM_FIRST + 61;
function ListView_GetHotItem(LVWnd: HWnd): integer;
const
LVM_SETHOTCURSOR = LVM_FIRST + 62;
function ListView_SetHotCursor(LVWnd: HWnd; Cursor: HCursor): HCursor;
const
LVM_GETHOTCURSOR = LVM_FIRST + 63;
function ListView_GetHotCursor(LVWnd: HWnd): HCursor;
const
LVM_APPROXIMATEVIEWRECT = LVM_FIRST + 64;
function ListView_ApproximateViewRect(LVWnd: HWnd; Width, Height,
Count: integer): DWORD;
const
LVM_SETWORKAREA = LVM_FIRST + 65;
function ListView_SetWorkArea(LVWnd: HWnd; const Rect: TRect): boolean;
function ListView_GetCheckState(LVWnd: HWnd; Index: UINT): boolean;
procedure ListView_SetCheckState(LVWnd: HWnd; Index: UINT; Checked: boolean);
{$ENDIF}
{$IFNDEF DFS_C3D4COMMCTRL}
const
LVSICF_NOINVALIDATEALL = $00000001;
LVSICF_NOSCROLL = $00000002;
procedure ListView_SetItemCountEx(LVWnd: HWnd; Items: integer; Flags: DWORD);
{$ENDIF}
{$IFNDEF DFS_COMPILER_3_UP}
const
// New list view style flags.
LVS_OWNERDATA = $1000; // Specifies a "virtual" control.
// New notification messages.
LVN_ODCACHEHINT = LVN_FIRST-13;
LVN_ODFINDITEMA = LVN_FIRST-52;
LVN_ODFINDITEMW = LVN_FIRST-79;
LVN_ODFINDITEM = LVN_ODFINDITEMA;
{$ENDIF}
{$IFNDEF DFS_C3D4COMMCTRL}
const
LVN_ITEMACTIVATE = LVN_FIRST-14;
LVN_ODSTATECHANGED = LVN_FIRST-15;
LVN_MARQUEEBEGIN = LVN_FIRST-56;
{$ENDIF}
{$IFNDEF DFS_COMPILER_3_UP}
type
PNMCacheHint = ^TNMCacheHint;
TNMCacheHint = packed record
hdr: TNMHDR;
iFrom: integer;
iTo: integer;
end;
PNMFindItem = ^TNMFindItem;
TNMFindItem = packed record
hdr: TNMHDR;
iStart: integer;
lvif: TLVFindInfo;
end;
{$ENDIF}
type
PNMODStateChange = ^TNMODStateChange;
TNMODStateChange = packed record
hdr: TNMHDR;
iFrom: integer;
iTo: integer;
uNewState: UINT;
uOldState: UINT;
end;
{$IFNDEF DFS_C3D4COMMCTRL}
const
LVM_GETSELECTIONMARK = (LVM_FIRST + 66);
function ListView_GetSelectionMark(LVWnd: HWnd): integer;
const
LVM_SETSELECTIONMARK = (LVM_FIRST + 67);
function ListView_SetSelectionMark(LVWnd: HWnd; iIndex: integer): integer;
const
LVM_SETHOVERTIME = (LVM_FIRST + 71);
function ListView_SetHoverTime(LVWnd: HWnd; dwHoverTimeMS: DWORD): DWORD;
const
LVM_GETHOVERTIME = (LVM_FIRST + 72);
function ListView_GetHoverTime(LVWnd: HWnd): DWORD;
const
LVM_SETTOOLTIPS = (LVM_FIRST + 74);
function ListView_SetToolTips(LVWnd, NewWnd: HWnd): HWnd;
const
LVM_GETTOOLTIPS = (LVM_FIRST + 78);
function ListView_GetToolTips(LVWnd: HWnd): HWnd;
{$ENDIF}
type
PLVBkImageA = ^TLVBkImageA;
TLVBkImageA = packed record
ulFlags: ULONG; // LVBKIF_*
hbm: HBITMAP;
pszImage: PChar;
cchImageMax: UINT;
xOffsetPercent: integer;
yOffsetPercent: integer;
end;
PLVBkImageW = ^TLVBkImageW;
TLVBkImageW = packed record
ulFlags: ULONG; // LVBKIF_*
hbm: HBITMAP;
pszImage: PWideChar;
cchImageMax: UINT;
xOffsetPercent: integer;
yOffsetPercent: integer;
end;
PLVBkImage = PLVBkImageA;
TLVBkImage = TLVBkImageA;
{$IFNDEF DFS_C3D4COMMCTRL}
const
LVBKIF_SOURCE_NONE = $00000000;
LVBKIF_SOURCE_HBITMAP = $00000001;
LVBKIF_SOURCE_URL = $00000002;
LVBKIF_SOURCE_MASK = $00000003;
LVBKIF_STYLE_NORMAL = $00000000;
LVBKIF_STYLE_TILE = $00000010;
LVBKIF_STYLE_MASK = $00000010;
LVM_SETBKIMAGEA = (LVM_FIRST + 68);
LVM_SETBKIMAGEW = (LVM_FIRST + 138);
LVM_GETBKIMAGEA = (LVM_FIRST + 69);
LVM_GETBKIMAGEW = (LVM_FIRST + 139);
const
LVM_SETBKIMAGE = LVM_SETBKIMAGEA;
function ListView_SetBkImage(LVWnd: HWnd; plvbki: PLVBkImage): BOOL;
const
LVM_GETBKIMAGE = LVM_GETBKIMAGEA;
function ListView_GetBkImage(LVWnd: HWnd; plvbki: PLVBkImage): BOOL;
const
LVN_HOTTRACK = (LVN_FIRST-21);
{$ENDIF}
type
PNMLVGetInfoTipA = ^TNMLVGetInfoTipA;
TNMLVGetInfoTipA = packed record
hdr: TNMHDR;
dwFlags: DWORD;
pszText: PChar;
cchTextMax: integer;
iItem: integer;
iSubItem: integer;
lParam: LPARAM;
end;
PNMLVGetInfoTipW = ^TNMLVGetInfoTipW;
TNMLVGetInfoTipW = packed record
hdr: TNMHDR;
dwFlags: DWORD;
pszText: PWideChar;
cchTextMax: integer;
iItem: integer;
iSubItem: integer;
lParam: LPARAM;
end;
PNMLVGetInfoTip = PNMLVGetInfoTipA;
TNMLVGetInfoTip = TNMLVGetInfoTipA;
{$IFNDEF DFS_C3D4COMMCTRL}
// NMLVGETINFOTIPA.dwFlag values
const
LVGIT_UNFOLDED = $0001;
LVN_GETINFOTIPA = (LVN_FIRST-57);
LVN_GETINFOTIPW = (LVN_FIRST-58);
LVN_GETINFOTIP = LVN_GETINFOTIPA;
{$ENDIF}
type
EELVException = class(Exception);
EELVOldComCtl = class(EELVException);
// New extended style flags converted to set format (RPM = Report Mode Only).
// lvxGridlines: Adds grid lines to seperate items and columns. RPM
// lvxSubItemImages: Allows images to be displayed for subitems. RPM
// lvxCheckboxes: Adds checkboxes to items. Checked items are stored
// internally as selected items.
// lvxTrackSelect: Tracks the mouse and highlights the item it currently
// positioned over by changing it's color. If mouse is left over an
// item for a brief period of time, it will be automatically selected.
// lvxHeaderDragDrop: Allows headers to be dragged to new positions and
// dropped, allowing users to reorder column information.
// lvxFullRowSelect: Allows user to click anywhere on an item to select it,
// highlighting the entire length of the item. Without this style,
// users must click inside the Text of column 0. It is only useful in
// vsReport view style.
// lvxOneClickActivate: Sends an LVN_ITEMACTIVATE notification message to
// the parent when the user clicks an item.
// lvxTwoClickActivate: Sends an LVN_ITEMACTIVATE notification message to
// the parent when the user double clicks an item.
// lvxFlatScrollBar: Enables flat scroll bars in the list view.
// lvxInfoTip: Enables the OnInfoTip event that allows notification and/or
// modification of a tooltip before it is displayed. Only allowed for
// vsIcon ViewStyle.
// lvxUnderlineHot: Causes hot items to be displayed with underlined Text.
// This style is ignored if lvxOneClickActivate or lvxTwoClickActivate
// is not set.
// lvxUnderlineCold: Causes nonhot items to be displayed with underlined
// Text. This style is ignored if lvxOneClickActivate is not set.
// lvxLabelTip: If a partially hidden label in any list view mode lacks
// tooltip text, the list view control will unfold the label. If this
// style is not set, the list view control will unfold partly hidden
// labels only for the large icon mode. Requires ComCtl32.dll v5.80.
TLVExtendedStyle = (lvxGridLines, lvxSubItemImages, lvxCheckboxes,
lvxTrackSelect, lvxHeaderDragDrop, lvxFullRowSelect, lvxOneClickActivate,
lvxTwoClickActivate, lvxFlatScrollBar, lvxInfoTip, lvxUnderlineHot,
lvxUnderlineCold, lvxLabelTip);
// A set of the new style bits.
TLVExtendedStyles = set of TLVExtendedStyle;
TLVItemCountFlag = (lvsicfNoInvalidateAll, lvsicfNoScroll);
TLVItemCountFlags = set of TLVItemCountFlag;
TLVVMMaskItem = (lvifText, lvifImage, lvifParam, lvifState, lvifIndent);
TLVVMMaskItems = set of TLVVMMaskItem;
TLVVMStateMaskItem = (lvisCut, lvisDropHighlighted, lvisFocused, lvisSelected,
lvisOverlayMask);
TLVVMStateMaskItems = set of TLVVMStateMaskItem;
TColumnImageAlign = (ciaLeftOfText, ciaRightOfText);
TLVItemCheckedEvent = procedure (Sender: TObject; ItemIndex: integer;
Checked: boolean) of object;
TLVMarqueeBeginEvent = procedure(Sender: TObject;
var CanBegin: boolean) of object;
TLVItemActivateEvent = TNotifyEvent;
TLVInfoTipEvent = procedure(Sender: TObject; ItemIndex, SubItemIndex: integer;
Current: string; var Additional: string) of object;
TLVHotTrackEvent = procedure(Sender: TObject; var ItemIndex: integer;
SubItemIndex: integer; Location: TPoint;
var AllowSelect: boolean) of object;
TLVVMGetItemInfoEvent = procedure(Sender: TObject; Item, SubItem: integer;
var Mask: TLVVMMaskItems; var Image: integer; var OverlayImage,
StateImage: word; var Param: LPARAM; var State: UINT; var StateMask: UINT;
var Indent: integer; var Text: string) of object;
TLVVMCacheHintEvent = procedure(Sender: TObject;
var HintInfo: TNMCacheHint) of object;
TLVVMFindItemEvent = procedure(Sender: TObject; var FindInfo: TNMFindItem;
var Found: integer) of object;
TLVVMStateChangedEvent = procedure(Sender: TObject;
var StateInfo: TNMODStateChange) of object;
TLVVMCaptionEditedEvent = procedure (Sender: TObject; Item: integer;
Canceled: boolean; const Text: string) of object;
{$IFNDEF DFS_COMPILER_4_UP}
TLVSubItemImageEvent = procedure(Sender: TObject; Item: TListItem; SubItem: Integer;
var ImageIndex: Integer) of object;
{$ENDIF}
TCustomExtListView = class; { forward declaration }
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
// Class for BackgroundImage property
TELVBackgroundImage = class(TPersistent)
private
FOwningListView: TCustomExtListView;
FFilename: string;
FBrushBmp: TBitmap;
FTile: boolean;
FXOffsetPercent: integer;
FYOffsetPercent: integer;
protected
procedure SetFilename(const Val: string);
procedure SetTile(Val: boolean);
procedure SetXOffsetPercent(Val: integer);
procedure SetYOffsetPercent(Val: integer);
procedure ApplyToListView; virtual;
public
constructor Create(AOwner: TCustomExtListView); virtual;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property Filename: string
read FFilename
write SetFilename;
property Tile: boolean
read FTile
write SetTile
default FALSE;
property XOffsetPercent: integer
read FXOffsetPercent
write SetXOffsetPercent
default 0;
property YOffsetPercent: integer
read FYOffsetPercent
write SetYOffsetPercent
default 0;
end;
{$ENDIF}
// Class for saved settings
TdfsExtLVSaveSettings = class(TdfsEnhLVSaveSettings)
private
FSaveColumnOrder: boolean;
public
constructor Create; override;
procedure StoreColumnOrder(ColCount: integer;
const IntArray: array of integer);
procedure ReadColumnOrder(ColCount: integer;
var IntArray: array of integer);
published
property SaveColumnOrder: boolean
read FSaveColumnOrder
write FSaveColumnOrder
default TRUE;
end;
TdfsExtListColumn = class(TCollectionItem)
private
FSmallImageIndex: Integer;
FImageAlignment : TColumnImageAlign;
FAllowResize: boolean;
procedure DoChange;
procedure SetSmallImageIndex(Value: Integer);
procedure SetImageAlignment(Value: TColumnImageAlign);
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property ImageIndex: integer
read FSmallImageIndex
write SetSmallImageIndex
default -1;
property ImageAlignment: TColumnImageAlign
read FImageAlignment
write SetImageAlignment
default ciaRightOfText;
property AllowResize: boolean
read FAllowResize
write FAllowResize
default TRUE;
end;
TdfsExtListColumns = class(TCollection)
private
FListView: TCustomExtListView;
function GetItem(Index: Integer): TdfsExtListColumn;
procedure SetItem(Index: Integer; Value: TdfsExtListColumn);
protected
function GetOwner: TPersistent; {$IFDEF DFS_COMPILER_3_UP} override; {$ENDIF}
procedure Update(Item: TCollectionItem); override;
public
constructor Create(AListView: TCustomExtListView);
procedure Assign(Source: TPersistent); override;
function Add: TdfsExtListColumn;
procedure Refresh;
property ListView: TCustomExtListView
read FListView;
property Items[Index: Integer]: TdfsExtListColumn
read GetItem
write SetItem;
default;
end;
// The new class.
TCustomExtListView = class(TCustomEnhListView)
private
FExtendedStyles: TLVExtendedStyles;
FColumnOrder: PIntArray;
FColumnOrderCount: integer;
FColumnsFormat: TdfsExtListColumns;
FVirtualMode: boolean;
FSaveSettings: TdfsExtLVSaveSettings;
FColumnsFormatChangeLink: TChangeLink;
FSelectionMark: integer;
FHoverTime: Longint;
FRequireComCtlUpdate: boolean;
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
FBackgroundImage: TELVBackgroundImage;
{$ENDIF}
FItemCountEx: integer;
FItemCountExFlags: TLVItemCountFlags;
FRecreateStream: TMemoryStream;
{$IFDEF DFS_COMPILER_4_UP}
FInhibitFeedData: boolean;
{$ENDIF}
FChecked: boolean;
FCheckedListItemIndex: integer;
FOnItemChecked: TLVItemCheckedEvent;
FOnMarqueeBegin: TLVMarqueeBeginEvent;
FOnItemActivate: TLVItemActivateEvent;
FOnHotTrack: TLVHotTrackEvent;
FOnInfoTip: TLVInfoTipEvent;
FOnVMGetItemInfo: TLVVMGetItemInfoEvent;
FOnVMCacheHint: TLVVMCacheHintEvent;
FOnVMFindItem: TLVVMFindItemEvent;
FOnVMStateChanged: TLVVMStateChangedEvent;
FOnVMCaptionEdited: TLVVMCaptionEditedEvent;
// Function to convert from our set type to expected API value.
function SetValueToAPIValue(Styles: TLVExtendedStyles): LPARAM;
function SetValueFromAPIValue(Styles: DWORD): TLVExtendedStyles;
procedure ColumnHeaderImagesChange(Sender: TObject);
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
function GetItemIndent(Index: integer): Integer;
procedure SetItemIndent(Index: integer; Value: Integer);
{$IFDEF DFS_COMPILER_4_UP}
procedure FeedOwnerDataMode(Sender: TObject; Item: TListItem);
{$ENDIF}
protected
// Property method for setting styles.
procedure SetExtendedStyles(Val: TLVExtendedStyles);
function GetExtendedStyles: TLVExtendedStyles;
function GetHeaderHandle: HWnd;
function GetSubItemRect(Item, SubItem: integer; Index: integer): TRect;
procedure SetHotItem(Val: integer);
function GetHotItem: integer;
procedure SetHotCursor(const Val: HCursor);
function GetHotCursor: HCursor;
procedure SetWorkArea(Rect: TRect);
procedure SetCheckState(Index: integer; Checked: boolean);
function GetCheckState(Index: integer): boolean;
procedure SetVirtualMode(Val: boolean);
procedure SetColumnsFormat(Value: TdfsExtListColumns);
function GetSubItemImageIndex(Item, SubItem: integer): integer;
procedure SetSubItemImageIndex(Item, SubItem, Value: integer);
function GetSelectionMark: integer;
procedure SetSelectionMark(Val: integer);
function GetHoverTime: Longint;
procedure SetHoverTime(Val: Longint);
procedure SetRequireComCtlUpdate(Value: boolean);
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
procedure SetBackgroundImage(Value: TELVBackgroundImage);
{$ENDIF}
function GetStateImages: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList; {$ELSE} TImageList; {$ENDIF}
procedure SetStateImages(Value: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList {$ELSE} TImageList {$ENDIF});
function GetSmallImages: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList; {$ELSE} TImageList; {$ENDIF}
procedure SetSmallImages(Value: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList {$ELSE} TImageList {$ENDIF});
function GetShowSortArrows: boolean;
procedure SetShowSortArrows(Value: boolean);
function GetVersion: string; override;
function GetSubItemText(Index, SubItem: integer): string; override;
function ActualColumnIndex(Index: integer): integer; override;
function GetActualColumn(Index: integer): TListColumn; override;
procedure DestroyWnd; override;
procedure RestoreChecks;
procedure SaveChecks;
procedure MeasureItem(var Height: UINT); override;
procedure DrawItem(var Canvas: TCanvas; Index: Integer; Rect: TRect;
State: TOwnerDrawState; var DefaultDrawing,
FullRowSelect: boolean); override;
procedure DrawSubItem(Index, SubItem: Integer; Rect: TRect;
State: TOwnerDrawState; var DefaultDrawing: boolean); override;
procedure DefaultDrawHeader(var Canvas: TCanvas; Index: Integer;
var Rect: TRect; Selected: boolean); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure Loaded; override;
procedure DefaultDrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState; FullRowSelect: boolean); override;
procedure DefaultDrawSubItem(Index, SubItem: integer; Rect: TRect;
State: TOwnerDrawState); override;
// Event method handlers -- fire the events if they exist.
procedure ItemChecked(ItemIndex: integer; Checked: boolean); virtual;
function MarqueeBegin: boolean; virtual;
procedure ItemActivate; virtual;
function HotTrack(var Item: TNMListView): boolean; virtual;
procedure GetInfoTip(InfoTip: PNMLVGetInfoTip); virtual;
procedure VMGetDispInfo(var ItemInfo: TLVItemEx); virtual;
procedure VMCacheHint(var HintInfo: TNMCacheHint); virtual;
function VMFindItem(var FindInfo: TNMFindItem): integer; virtual;
procedure VMStateChanged(var StateInfo: TNMODStateChange); virtual;
procedure VMCaptionEdited(Item: integer; Canceled: boolean; const Text: string);
// These should be redeclared as PUBLIC as needed.
property HeaderHandle: HWnd
read GetHeaderHandle;
property SubItem_BoundsRect[Item: integer; SubItem: integer]: TRect
index LVIR_BOUNDS
read GetSubItemRect;
property SubItem_IconRect[Item: integer; SubItem: integer]: TRect
index LVIR_ICON
read GetSubItemRect;
property SubItem_LabelRect[Item: integer; SubItem: integer]: TRect
index LVIR_LABEL
read GetSubItemRect;
property SubItem_SelectBoundsRect[Item: integer; SubItem: integer]: TRect
index LVIR_SELECTBOUNDS
read GetSubItemRect;
property HotItem: integer
read GetHotItem
write SetHotItem;
property HotCursor: HCursor
read GetHotCursor
write SetHotCursor;
property WorkArea: TRect
write SetWorkArea;
property IsChecked[Index: integer]: boolean
read GetCheckState
write SetCheckState;
property SubItem_ImageIndex[Item: integer; SubItem: integer]: integer
read GetSubItemImageIndex
write SetSubItemImageIndex;
property SelectionMark: integer
read GetSelectionMark
write SetSelectionMark;
property ItemIndent[Index: integer]: integer
read GetItemIndent
write SetItemIndent;
// These should be redeclared as PUBLIC or PUBLISHED as needed
property ExtendedStyles: TLVExtendedStyles
read GetExtendedStyles
write SetExtendedStyles
default [lvxInfoTip];
property VirtualMode: boolean
read FVirtualMode
write SetVirtualMode
default FALSE;
property HoverTime: Longint
read GetHoverTime
write SetHoverTime
default -1;
property RequireComCtlUpdate: boolean
read FRequireComCtlUpdate
write SetRequireComCtlUpdate
default FALSE;
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
property BackgroundImage: TELVBackgroundImage
read FBackgroundImage
write SetBackgroundImage;
{$ENDIF}
// Autosave settings property.
property SaveSettings: TdfsExtLVSaveSettings
read FSaveSettings
write FSaveSettings;
property ColumnsFormat: TdfsExtListColumns
read FColumnsFormat
write SetColumnsFormat;
// Events
property OnItemChecked: TLVItemCheckedEvent
read FOnItemChecked
write FOnItemChecked;
property OnMarqueeBegin: TLVMarqueeBeginEvent
read FOnMarqueeBegin
write FOnMarqueeBegin;
property OnItemActivate: TLVItemActivateEvent
read FOnItemActivate
write FOnItemActivate;
property OnHotTrack: TLVHotTrackEvent
read FOnHotTrack
write FOnHotTrack;
property OnInfoTip: TLVInfoTipEvent
read FOnInfoTip
write FOnInfoTip;
property OnVMGetItemInfo: TLVVMGetItemInfoEvent
read FOnVMGetItemInfo
write FOnVMGetItemInfo;
property OnVMCacheHint: TLVVMCacheHintEvent
read FOnVMCacheHint
write FOnVMCacheHint;
property OnVMFindItem: TLVVMFindItemEvent
read FOnVMFindItem
write FOnVMFindItem;
property OnVMStateChanged: TLVVMStateChangedEvent
read FOnVMStateChanged
write FOnVMStateChanged;
property OnVMCaptionEdited: TLVVMCaptionEditedEvent
read FOnVMCaptionEdited
write FOnVMCaptionEdited;
property ShowSortArrows: boolean
read GetShowSortArrows
write SetShowSortArrows
stored TRUE
default FALSE;
// Redeclare so we can reset checkboxes.
property StateImages: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList {$ELSE} TImageList {$ENDIF}
read GetStateImages
write SetStateImages;
// Redeclare so we can know when it changes and hook into it.
property SmallImages: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList {$ELSE} TImageList {$ENDIF}
read GetSmallImages
write SetSmallImages;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
// Force reset of column image information
procedure UpdateColumnsImages;
procedure UpdateColumnImage(Index: integer);
procedure SetIconSpacing(X, Y: integer);
function GetSubItemAt(X, Y: integer): string;
procedure SetColumnOrder(Count: integer; const IntArray: array of integer);
function GetColumnOrder(Count: integer;
var IntArray: array of integer): boolean;
function ApproximateViewRect(Count: integer;
const Proposed: TPoint): TPoint;
procedure SetItemCountEx(Count: integer; Flags: TLVItemCountFlags);
function StoreSettings: boolean; override;
function WriteSettings: boolean; override;
function LoadSettings: boolean; override;
function ReadSettings: boolean; override;
function CheckComCtlVersion(MajorHi, MajorLo,
MinorHi, MinorLo: word): boolean;
procedure ELV_EditCaption(Item: integer);
function ELV_GetNextItem(StartItem: integer; Direction: TSearchDirection;
States: TItemStates): integer;
procedure ELV_SetItemState(Index: integer; States: TItemStates;
Setting: boolean);
end;
TdfsExtListView = class(TCustomExtListView)
public
property LastColumnClicked;
property CurrentColumnWidth;
property HeaderHandle;
property SubItem_BoundsRect;
property SubItem_IconRect;
property SubItem_LabelRect;
property SubItem_SelectBoundsRect;
property HotItem;
property HotCursor;
property WorkArea;
property IsChecked;
property SubItem_ImageIndex;
property SelectionMark;
property ItemIndent;
property CurrentSortAscending;
published
property Columns;
property ColumnSearch;
property HideSelection;
property ExtendedStyles;
property VirtualMode;
property HoverTime;
property RequireComCtlUpdate;
{$IFDEF BACKGROUND_FIXED}
property BackgroundImage;
{$ENDIF}
property NoColumnResize;
property SaveSettings;
property ColumnsFormat;
// New Events
property OnItemChecked;
property OnMarqueeBegin;
property OnItemActivate;
property OnHotTrack;
property OnInfoTip;
property OnVMGetItemInfo;
property OnVMCacheHint;
property OnVMFindItem;
property OnVMStateChanged;
property OnVMCaptionEdited;
property ShowSortArrows;
// Publish inherited protected properties
property AutoColumnSort;
property AutoSortStyle;
property AutoResort;
property AutoSortAscending;
property ReverseSortArrows;
property Style;
property OnDrawHeader;
property OnMeasureItem;
property OnDrawItem;
property OnDrawSubItem;
property OnAfterDefaultDrawItem;
property OnSortItems;
property OnSortBegin;
property OnSortFinished;
property OnEditCanceled;
property Align;
{$IFDEF DFS_COMPILER_4_UP}
property Anchors;
property BiDiMode;
{$ENDIF}
property BorderStyle;
{$IFDEF DFS_COMPILER_4_UP}
property BorderWidth;
{$ENDIF}
property Color;
property ColumnClick;
{$IFDEF DFS_COMPILER_4_UP}
property Constraints;
{$ENDIF}
property OnClick;
property OnDblClick;
property Ctl3D;
property DragMode;
{$IFDEF DFS_COMPILER_4_UP}
property DragKind;
{$ENDIF}
property ReadOnly
default False;
property Enabled;
property Font;
property IconOptions;
property Items;
property AllocBy;
property MultiSelect;
property OnChange;
property OnChanging;
property OnColumnClick;
property OnDeletion;
property OnEdited;
property OnEditing;
{$IFDEF DFS_COMPILER_4_UP}
property OnEndDock;
{$ENDIF}
property OnEnter;
property OnExit;
property OnInsert;
property OnDragDrop;
property OnDragOver;
property DragCursor;
property OnStartDrag;
property OnEndDrag;
property OnGetImageIndex;
{$IFDEF DFS_COMPILER_5_UP}
property OnGetSubItemImage;
{$ENDIF}
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
{$IFDEF DFS_COMPILER_4_UP}
property OnResize;
property OnSelectItem;
property OnStartDock;
{$ENDIF}
property ParentColor
default False;
property ParentFont;
property ParentShowHint;
{$IFDEF DFS_COMPILER_4_UP}
property ParentBiDiMode;
{$ENDIF}
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;
{ You may find this function useful in install programs and such. Example of
usage is:
if not CheckDLLVersion('COMCTL32.DLL', 4, 70, 0, 0) then ....
which returns TRUE if COMCTL32.DLL is version 4.70.0.0 or higher. }
function CheckDLLVersion(const DLLName: string; MajorHi, MajorLo,
MinorHi, MinorLo: word): boolean;
implementation
uses
{$IFDEF DFS_COMPILER_3_UP}
ActiveX,
{$ELSE}
OLE2, ExtColEd,
{$ENDIF}
Registry;
function ListView_GetColumnEx(LVWnd: HWND; iCol: Integer;
var pcol: TLVColumnEx): bool;
begin
Result := bool(SendMessage(LVWnd, LVM_GETCOLUMN, iCol, LPARAM(@pcol)));
end;
function ListView_SetColumnEx(LVWnd: HWnd; iCol: Integer;
const pcol: TLVColumnEx): Bool;
begin
Result := bool(SendMessage(LVWnd, LVM_SETCOLUMN, iCol, Longint(@pcol)));
end;
function ListView_InsertColumnEx(LVWnd: HWND; iCol: Integer;
const pcol: TLVColumnEx): Integer;
begin
Result := SendMessage(LVWnd, LVM_INSERTCOLUMN, iCol, Longint(@pcol));
end;
function ListView_GetHeader(LVWnd: HWnd): HWnd;
begin
Result := HWnd(SendMessage(LVWnd, LVM_GETHEADER, 0, 0));
end;
function ListView_SetIconSpacing(LVWnd: HWnd; cx, cy: integer): DWORD;
begin
Result := SendMessage(LVWnd, LVM_SETICONSPACING, 0, MAKELONG(cx,cy));
end;
function ListView_SetExtendedListViewStyle(LVWnd: HWnd; ExStyle: LPARAM): DWORD;
begin
Result := SendMessage(LVWnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, ExStyle);
end;
function ListView_GetExtendedListViewStyle(LVWnd: HWnd): DWORD;
begin
Result := SendMessage(LVWnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0);
end;
function ListView_GetSubItemRect(LVWnd: HWnd; ParentItem, SubItem,
Code: integer; var Rect: TRect): boolean;
begin
Rect.Top := SubItem;
Rect.Left := Code;
Result := (SendMessage(LVWnd, LVM_GETSUBITEMRECT, ParentItem,
LPARAM(@Rect)) <> 0);
end;
{$IFNDEF DFS_C3D4COMMCTRL}
// C3 & D4 users don't need this because their COMMCTRL.PAS file has it right
// and they can simply use the existing TLVHitTestInfo and
// ListView_SubItemHitTest
function ListView_SubItemHitTestEx(LVWnd: HWnd;
var HitTestInfo: TLVHitTestInfoEx): integer;
begin
Result := SendMessage(LVWnd, LVM_SUBITEMHITTEST, 0, LPARAM(@HitTestInfo));
end;
{$ENDIF}
function ListView_SetColumnOrderArray(LVWnd: HWnd; Count: integer;
IntArray: PIntArray): boolean;
begin
Result := (SendMessage(LVWnd, LVM_SETCOLUMNORDERARRAY, Count,
LPARAM(IntArray)) <> 0);
end;
function ListView_GetColumnOrderArray(LVWnd: HWnd; Count: integer;
IntArray: PIntArray): boolean;
begin
Result := (SendMessage(LVWnd, LVM_GETCOLUMNORDERARRAY, Count,
LPARAM(IntArray)) <> 0);
end;
function ListView_SetHotItem(LVWnd: HWnd; Item: integer): integer;
begin
Result := SendMessage(LVWnd, LVM_SETHOTITEM, Item, 0);
end;
function ListView_GetHotItem(LVWnd: HWnd): integer;
begin
Result := SendMessage(LVWnd, LVM_GETHOTITEM, 0, 0);
end;
function ListView_SetHotCursor(LVWnd: HWnd; Cursor: HCursor): HCursor;
begin
Result := HCursor(SendMessage(LVWnd, LVM_SETHOTCURSOR, 0, LPARAM(Cursor)));
end;
function ListView_GetHotCursor(LVWnd: HWnd): HCursor;
begin
Result := HCursor(SendMessage(LVWnd, LVM_GETHOTCURSOR, 0, 0));
end;
function ListView_ApproximateViewRect(LVWnd: HWnd; Width, Height,
Count: integer): DWORD;
begin
Result := SendMessage(LVWnd, LVM_APPROXIMATEVIEWRECT, Count,
MAKELPARAM(Width, Height));
end;
function ListView_SetWorkArea(LVWnd: HWnd; const Rect: TRect): boolean;
begin
Result := (SendMessage(LVWnd, LVM_SETWORKAREA, 0, LPARAM(@Rect)) <> 0);
end;
function ListView_GetCheckState(LVWnd: HWnd; Index: UINT): boolean;
begin
Result := (SendMessage(LVWnd, LVM_GETITEMSTATE, Index,
LVIS_STATEIMAGEMASK) SHR 12)-1 <> 0;
end;
procedure ListView_SetCheckState(LVWnd: HWnd; Index: UINT; Checked: boolean);
const
LVIS_UNCHECKED = $1000;
LVIS_CHECKED = $2000;
var
Data: integer;
begin
if Checked then Data := LVIS_CHECKED
else Data := LVIS_UNCHECKED;
ListView_SetItemState(LVWnd, Index, Data, LVIS_STATEIMAGEMASK);
end;
procedure ListView_SetItemCountEx(LVWnd: HWnd; Items: integer; Flags: DWORD);
begin
SendMessage(LVWnd, LVM_SETITEMCOUNT, Items, Flags);
end;
{$IFNDEF DFS_C3D4COMMCTRL}
function ListView_SetExtendedListViewStyleEx(LVWnd: HWnd; Mask: DWord;
ExStyle: LPARAM): DWORD;
begin
Result := SendMessage(LVWnd, LVM_SETEXTENDEDLISTVIEWSTYLE, Mask, ExStyle);
end;
{$ENDIF}
function ListView_GetSelectionMark(LVWnd: HWnd): integer;
begin
Result := SendMessage(LVWnd, LVM_GETSELECTIONMARK, 0, 0);
end;
function ListView_SetSelectionMark(LVWnd: HWnd; iIndex: integer): integer;
begin
Result := SendMessage(LVWnd, LVM_SETSELECTIONMARK, 0, iIndex);
end;
{$IFNDEF DFS_C3D4COMMCTRL}
function ListView_SetHoverTime(LVWnd: HWnd; dwHoverTimeMS: DWORD): DWORD;
begin
Result := SendMessage(LVWnd, LVM_SETHOVERTIME, 0, dwHoverTimeMs);
end;
function ListView_GetHoverTime(LVWnd: HWnd): DWORD;
begin
Result := DWORD(SendMessage(LVWnd, LVM_GETHOVERTIME, 0, 0));
end;
function ListView_SetToolTips(LVWnd, NewWnd: HWnd): HWnd;
begin
Result := SendMessage(LVWnd, LVM_SETTOOLTIPS, NewWnd, 0);
end;
function ListView_GetToolTips(LVWnd: HWnd): HWnd;
begin
Result := SendMessage(LVWnd, LVM_GETTOOLTIPS, 0, 0);
end;
function ListView_SetBkImage(LVWnd: HWnd; plvbki: PLVBkImage): BOOL;
begin
Result := (SendMessage(LVWnd, LVM_SETBKIMAGE, 0, LPARAM(plvbki)) <> 0);
end;
function ListView_GetBkImage(LVWnd: HWnd; plvbki: PLVBkImage): BOOL;
begin
Result := (SendMessage(LVWnd, LVM_GETBKIMAGE, 0, LPARAM(plvbki)) <> 0);
end;
{$ENDIF}
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
constructor TELVBackgroundImage.Create(AOwner: TCustomExtListView);
begin
inherited Create;
FBrushBmp := TBitmap.Create;
FOwningListView := AOwner;
end;
destructor TELVBackgroundImage.Destroy;
begin
FBrushBmp.Free;
inherited Destroy;
end;
procedure TELVBackgroundImage.Assign(Source: TPersistent);
begin
if Source is TELVBackgroundImage then
begin
FFilename := TELVBackgroundImage(Source).Filename;
FTile := TELVBackgroundImage(Source).Tile;
FXOffsetPercent := TELVBackgroundImage(Source).XOffsetPercent;
FYOffsetPercent := TELVBackgroundImage(Source).YOffsetPercent;
ApplyToListView;
end;
end;
procedure TELVBackgroundImage.SetFilename(const Val: string);
begin
if FFilename <> Val then
FFilename := Val;
ApplyToListView;
end;
procedure TELVBackgroundImage.SetTile(Val: boolean);
begin
if FTile <> Val then
FTile := Val;
ApplyToListView;
end;
procedure TELVBackgroundImage.SetXOffsetPercent(Val: integer);
begin
if FXOffsetPercent <> Val then
FXOffsetPercent := Val;
ApplyToListView;
end;
procedure TELVBackgroundImage.SetYOffsetPercent(Val: integer);
begin
if FYOffsetPercent <> Val then
FYOffsetPercent := Val;
ApplyToListView;
end;
procedure TELVBackgroundImage.ApplyToListView;
var
LVBkImg: TLVBkImage;
begin
if assigned(FOwningListView) and FOwningListView.HandleAllocated then
begin
if FFilename <> '' then
LVBkImg.ulFlags := LVBKIF_SOURCE_URL
else
LVBkImg.ulFlags := LVBKIF_SOURCE_NONE;
if FTile then
LVBkImg.ulFlags := LVBkImg.ulFlags or LVBKIF_STYLE_TILE
else
LVBkImg.ulFlags := LVBkImg.ulFlags or LVBKIF_STYLE_NORMAL;
LVBkImg.hbm := 0;
LVBkImg.pszImage := PChar(FFilename);
LVBkImg.cchImageMax := Length(FFilename);
LVBkImg.xOffsetPercent := FXOffsetPercent;
LVBkImg.yOffsetPercent := FYOffsetPercent;
// Transparent
ListView_SettExtBkColor(FOwningListView.Handle, $FFFFFFFF);
ListView_SetBkImage(FOwningListView.Handle, @LVBkImg);
end;
end;
{$ENDIF}
constructor TdfsExtLVSaveSettings.Create;
begin
inherited Create;
FSaveColumnOrder := TRUE;
end;
procedure TdfsExtLVSaveSettings.StoreColumnOrder(ColCount: integer;
const IntArray: array of integer);
var
Reg: TRegIniFile;
x: integer;
s: string;
begin
if ColCount < 1 then exit;
s := '';
for x := 0 to ColCount-1 do
s := s + IntToStr(IntArray[x]) + ',';
SetLength(s, Length(s)-1);
Reg := TRegIniFile.Create(RegistryKey);
try
Reg.WriteString('Columns', 'Order', s);
finally
Reg.Free;
end;
end;
procedure TdfsExtLVSaveSettings.ReadColumnOrder(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(RegistryKey);
try
s := Reg.ReadString('Columns', 'Order', '');
finally
Reg.Free;
end;
if s = '' then
begin
for x := 0 to ColCount-1 do
IntArray[x] := x;
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;
// Override constructor to "zero out" our internal variable.
constructor TCustomExtListView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FItemCountEx := 0;
FItemCountExFlags := [];
FSelectionMark := -1;
FHoverTime := -1;
FExtendedStyles := [lvxInfoTip];
FColumnOrder := NIL;
FColumnOrderCount := 0;
FRequireComCtlUpdate := FALSE;
FSaveSettings := TdfsExtLVSaveSettings.Create;
FColumnsFormatChangeLink := TChangeLink.Create;
FColumnsFormatChangeLink.OnChange := ColumnHeaderImagesChange;
FVirtualMode := FALSE;
FColumnsFormat := TdfsExtListColumns.Create(Self);
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
FBackgroundImage := TELVBackgroundImage.Create(Self);
{$ENDIF}
{$IFDEF DFS_COMPILER_4_UP}
OnData := FeedOwnerDataMode;
{$ENDIF}
end;
destructor TCustomExtListView.Destroy;
begin
FColumnsFormat.Free; { don't think i need this, it has an Owner property }
FColumnsFormatChangeLink.Free;
if FColumnOrder <> NIL then
FreeMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
FRecreateStream.Free;
FRecreateStream := NIL;
inherited Destroy;
FSaveSettings.Free;
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
{ Free after inherited because inherited calls DestroyWnd and it is needed
until after that...}
FBackgroundImage.Free;
{$ENDIF}
end;
procedure TCustomExtListView.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if FVirtualMode then
Params.Style := Params.Style or LVS_OWNERDATA;
end;
procedure TCustomExtListView.CreateWnd;
begin
inherited CreateWnd;
// RestoreChecks;
SetSelectionMark(FSelectionMark);
SetHoverTime(FHoverTime);
SetExtendedStyles(FExtendedStyles);
if VirtualMode and (FItemCountEx > 0) then
SetItemCountEx(FItemCountEx, FItemCountExFlags);
if FColumnOrder <> NIL then
begin
SendMessage(Handle, LVM_SETCOLUMNORDERARRAY, FColumnOrderCount,
LongInt(FColumnOrder));
Refresh;
end;
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
FBackgroundImage.ApplyToListView;
{$ENDIF}
if not (csLoading in ComponentState) then
begin
if (StateImages <> NIL) then
ListView_SetCallbackMask(Handle, ListView_GetCallbackMask(Handle) or
LVIS_STATEIMAGEMASK);
ListView_SetCallbackMask(Handle, ListView_GetCallbackMask(Handle) or
LVIS_OVERLAYMASK);
end;
RestoreChecks;
end;
procedure TCustomExtListView.Loaded;
begin
inherited Loaded;
HandleNeeded;
UpdateColumnsImages;
if StateImages <> NIL then
ListView_SetCallbackMask(Handle, ListView_GetCallbackMask(Handle) or
LVIS_STATEIMAGEMASK);
ListView_SetCallbackMask(Handle, ListView_GetCallbackMask(Handle) or
LVIS_OVERLAYMASK);
end;
// Subitem set to -1 means Caption Text
function TCustomExtListView.GetSubItemText(Index, SubItem: integer): string;
var
x,
ColCount: integer;
ColArray: PIntArray;
begin
// needs to account for modified column order
Result := '';
if Items[Index] = NIL then
exit;
ColCount := Columns.Count;
if (SubItem + 2 > ColCount) then
begin
if SubItem < Items[Index].SubItems.Count then
Result := Items[Index].SubItems[SubItem];
end else begin
GetMem(ColArray, SizeOf(Integer)*ColCount);
try
GetColumnOrder(ColCount, ColArray^);
x := ColArray[SubItem+1];
if x = 0 then
Result := Items[Index].Caption
else
Result := Items[Index].SubItems[x-1];
finally
FreeMem(ColArray);
end;
end;
end;
function TCustomExtListView.GetActualColumn(Index: integer): TListColumn;
var
// x,
ColCount: integer;
ColArray: PIntArray;
begin
// account for modified column order
// 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;
Result := NIL;
ColCount := Columns.Count;
if Index >= ColCount then
exit;
GetMem(ColArray, SizeOf(Integer)*ColCount);
try
GetColumnOrder(ColCount, ColArray^);
Result := Columns[ColArray[Index]];
(* I must have been high
for x := 0 to ColCount-1 do
if ColArray[x] = Index then
begin
Result := Columns[ColArray[x]];
exit;
end;
*)
finally
FreeMem(ColArray);
end;
end;
procedure TCustomExtListView.MeasureItem(var Height: UINT);
begin
inherited MeasureItem(Height);
end;
procedure TCustomExtListView.DrawItem(var Canvas: TCanvas; Index: Integer;
Rect: TRect; State: TOwnerDrawState; var DefaultDrawing,
FullRowSelect: boolean);
begin
{ Default to whatever is in ExtendedStyles settings }
FullRowSelect := lvxFullRowSelect in ExtendedStyles;
inherited DrawItem(Canvas, Index, Rect, State, DefaultDrawing,
FullRowSelect);
end;
procedure TCustomExtListView.DrawSubItem(Index, SubItem: Integer; Rect: TRect;
State: TOwnerDrawState; var DefaultDrawing: boolean);
begin
inherited DrawSubItem(Index, SubItem, Rect, State, DefaultDrawing);
end;
procedure TCustomExtListView.DefaultDrawHeader(var Canvas: TCanvas;
Index: Integer; var Rect: TRect; Selected: boolean);
var
TheColumn: TListColumn;
ExtColumn: TdfsExtListColumn;
ImageOffset: integer;
Offset: integer;
R, CR: TRect;
Bmp: TBitmap;
begin
(******************************************************************************)
(* NOTE: This method is overriden and replaced from the one in TdfsEnhListView. *)
(* That means that if changes are made here, they will also need to be made *)
(* in EnhListView.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];
// TheColumn := ActualColumn[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 (Index < ColumnsFormat.Count) and assigned(SmallImages) and
((ColumnsFormat[Index].ImageIndex >= 0) and
(ColumnsFormat[Index].ImageIndex < SmallImages.Count)) then
ExtColumn := ColumnsFormat[Index]
else
ExtColumn := NIL;
if assigned(ExtColumn) then
begin
case ExtColumn.ImageAlignment of
ciaLeftOfText:
Inc(R.Left, SmallImages.Width + 4);
ciaRightOfText:
Dec(R.Right, SmallImages.Width + 4);
end;
end;
if ShowSortArrows and (LastColumnClicked = Index) and
((AutoColumnSort <> acsNoSort) or (assigned(OnSortItems))) then
begin
if CurrentSortAscending then
Bmp := SortUpBmp
else
Bmp := SortDownBmp;
Dec(R.Right, Bmp.Width + 8);
if R.Right < R.Left then
R.Right := R.Left;
{ How big of a rectangle do we have to work with for the Text? }
CR := R;
DrawTextEx(Canvas.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(Canvas.Handle, PChar(TheColumn.Caption), -1, R,
DRAWTEXTEX_FLAGS or DRAWTEXTEX_ALIGNMENT[TheColumn.Alignment], NIL);
// Draw column image if we have one
if assigned(ExtColumn) then
begin
ImageOffset := (Rect.Bottom - Rect.Top - SmallImages.Height) div 2;
case ExtColumn.ImageAlignment of
ciaLeftOfText:
SmallImages.Draw(Canvas, R.Left - (SmallImages.Width + 4),
R.Top + ImageOffset, ExtColumn.ImageIndex);
ciaRightOfText:
begin
SmallImages.Draw(Canvas, R.Right + 4, R.Top + ImageOffset,
ExtColumn.ImageIndex);
inc(R.Right, SmallImages.Width);
if R.Right > Rect.Right then
R.Right := Rect.Right;
end;
end;
end;
// Draw the sort arrow bitmap
Offset := (Rect.Bottom - Rect.Top - Bmp.Height) div 2;
// 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 else begin
if Selected then
OffsetRect(R, 1, 1);
CR := R;
DrawTextEx(Canvas.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;
DrawTextEx(Canvas.Handle, PChar(TheColumn.Caption), -1, R,
DRAWTEXTEX_FLAGS or DRAWTEXTEX_ALIGNMENT[TheColumn.Alignment], NIL);
// Draw column image if we have one
if assigned(ExtColumn) then
begin
ImageOffset := (Rect.Bottom - Rect.Top - SmallImages.Height) div 2;
case ExtColumn.ImageAlignment of
ciaLeftOfText:
// Only draw if we have enough room
if (R.Left - (SmallImages.Width + 4)) >= Rect.Left then
SmallImages.Draw(Canvas, R.Left - (SmallImages.Width + 4),
R.Top + ImageOffset, ExtColumn.ImageIndex);
ciaRightOfText:
// Only draw if we have enough room
if (R.Right + SmallImages.Width + 4) <= Rect.Right then
SmallImages.Draw(Canvas, R.Right + 4, R.Top + ImageOffset,
ExtColumn.ImageIndex);
end;
end;
end;
end;
end;
const
API_STYLES: array[Low(TLVExtendedStyle)..High(TLVExtendedStyle)] of LPARAM = (
LVS_EX_GRIDLINES, LVS_EX_SUBITEMIMAGES, LVS_EX_CHECKBOXES,
LVS_EX_TRACKSELECT, LVS_EX_HEADERDRAGDROP, LVS_EX_FULLROWSELECT,
LVS_EX_ONECLICKACTIVATE, LVS_EX_TWOCLICKACTIVATE, LVS_EX_FLATSB,
LVS_EX_INFOTIP, LVS_EX_UNDERLINEHOT, LVS_EX_UNDERLINECOLD,
{$IFDEF DFS_DELPHI} LVS_EX_LABELTIP {$ELSE} $00004000 {$ENDIF});
// LVS_EX_REGIONAL, LVS_EX_MULTIWORKAREAS - not implemented
// Function to convert our style set type into the value expected by the API.
function TCustomExtListView.SetValueToAPIValue(Styles: TLVExtendedStyles): LPARAM;
var
x: TLVExtendedStyle;
begin
Result := 0;
{ Check for each possible style. }
for x := Low(TLVExtendedStyle) to High(TLVExtendedStyle) do
{ If the style is set... }
if x in Styles then
{ OR the appropriate value into the result. }
Result := Result OR API_STYLES[x];
end;
// Function to convert from the API values to our style set type.
function TCustomExtListView.SetValueFromAPIValue(Styles: DWORD): TLVExtendedStyles;
var
x: TLVExtendedStyle;
begin
Result := [];
{ Check for each possible style. }
for x := Low(TLVExtendedStyle) to High(TLVExtendedStyle) do
{ If the style is set... }
if (API_STYLES[x] and Styles) <> 0 then
{ OR the appropriate value into the result. }
Result := Result + [x];
end;
// Property method to get the extended style bits.
function TCustomExtListView.GetExtendedStyles: TLVExtendedStyles;
begin
if HandleAllocated then
FExtendedStyles :=
SetValueFromAPIValue(ListView_GetExtendedListViewStyle(Handle));
Result := FExtendedStyles;
end;
// Property method to set new style bits.
procedure TCustomExtListView.SetExtendedStyles(Val: TLVExtendedStyles);
begin
{ Update the window with the new styles. }
if (Val * [lvxUnderlineHot, lvxUnderlineCold] <> []) then
begin
// lvxUnderlineHot and lvxUnderlineCold require lvxOneClickActivate and/or
// lvxTwoClickActivate
if (lvxUnderlineCold in Val) and (not (lvxOneClickActivate in Val)) then
Include(Val, lvxOneClickActivate);
if (lvxUnderlineHot in Val) and
(Val * [lvxOneClickActivate, lvxTwoClickActivate] = []) then
Include(Val, lvxOneClickActivate);
end;
// A real world use of XOR!!! We need to invalidate if subitem images is in
// new value and not in old, or in old value and not in new, but NOT if it is
// set or cleared in both.
if ((lvxSubItemImages in Val) xor (lvxSubItemImages in FExtendedStyles)) and
(HandleAllocated) then
Invalidate;
FExtendedStyles := Val;
if HandleAllocated then
ListView_SetExtendedListViewStyle(Handle, SetValueToAPIValue(Val));
end;
function TCustomExtListView.GetHeaderHandle: HWnd;
begin
if FHeaderHandle <> 0 then
Result := FHeaderHandle
else begin
if HandleAllocated then
Result := ListView_GetHeader(Handle)
else
Result := 0;
end;
end;
procedure TCustomExtListView.SetIconSpacing(X, Y: integer);
begin
// Not sure about how to update the view after changing this. Refresh doesn't
// do the job. Seems the best way to do it is in client code, something like:
(*
SetIconSpacing(X, Y);
// Does strange things if ViewStyle is not set to vsIcon!
if ViewStyle = vsIcon then
begin
SendMessage(Handle, WM_SETREDRAW, 0, 0);
try
ViewStyle := vsSmallIcon;
ViewStyle := vsIcon;
finally
SendMessage(Handle, WM_SETREDRAW, 1, 0);
end;
end;
*)
if HandleAllocated then
if ViewStyle = vsIcon then
ListView_SetIconSpacing(Handle, X, Y);
end;
function TCustomExtListView.GetSubItemRect(Item, SubItem: integer;
Index: integer): TRect;
begin
if HandleAllocated then
ListView_GetSubItemRect(Handle, Item, SubItem, Index, Result);
end;
function TCustomExtListView.GetSubItemAt(X, Y: integer): string;
var
{$IFNDEF DFS_C3D4COMMCTRL}
Info: TLVHitTestInfoEx;
{$ELSE}
Info: TLVHitTestInfo;
{$ENDIF}
begin
Result := '';
if HandleAllocated then
begin
Info.pt := Point(X, Y);
{$IFNDEF DFS_C3D4COMMCTRL}
if ListView_SubItemHitTestEx(Handle, Info) <> -1 then
{$ELSE}
if ListView_SubItemHitTest(Handle, @Info) <> -1 then
{$ENDIF}
begin
if (Info.iItem > -1) and (Items[Info.iItem] <> NIL) then
begin
if Info.iSubItem = 0 then
Result := Items[Info.iItem].Caption
else
Result := Items[Info.iItem].SubItems[Info.iSubItem-1];
end;
end;
end;
end;
procedure TCustomExtListView.SetColumnOrder(Count: integer; const IntArray:
array of integer);
begin
if FColumnOrder <> NIL then
FreeMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
FColumnOrderCount := Count;
GetMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
Move(IntArray, FColumnOrder^, FColumnOrderCount * SizeOf(Integer));
if HandleAllocated then
begin
ListView_SetColumnOrderArray(Handle, Count, @IntArray);
Refresh;
end;
end;
function TCustomExtListView.GetColumnOrder(Count: integer;
var IntArray: array of integer): boolean;
begin
if HandleAllocated then
begin
if Count <> FColumnOrderCount then
begin
FColumnOrderCount := Count;
if FColumnOrder <> NIL then
FreeMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
GetMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
end;
Result := ListView_GetColumnOrderArray(Handle, FColumnOrderCount,
@IntArray);
Move(IntArray, FColumnOrder^, FColumnOrderCount * SizeOf(Integer));
end else begin
if FColumnOrder <> NIL then
begin
Move(FColumnOrder^, IntArray, Count * SizeOf(Integer));
Result := TRUE;
end else
Result := FALSE;
end;
end;
procedure TCustomExtListView.SetHotItem(Val: integer);
begin
if HandleAllocated then
ListView_SetHotItem(Handle, Val);
end;
function TCustomExtListView.GetHotItem: integer;
begin
if HandleAllocated then
Result := ListView_GetHotItem(Handle)
else
Result := -1;
end;
procedure TCustomExtListView.SetHotCursor(const Val: HCursor);
begin
if HandleAllocated then
ListView_SetHotCursor(Handle, Val);
end;
function TCustomExtListView.GetHotCursor: HCursor;
begin
if HandleAllocated then
Result := ListView_GetHotCursor(Handle)
else
Result := 0;
end;
function TCustomExtListView.ApproximateViewRect(Count: integer;
const Proposed: TPoint): TPoint;
var
Res: DWORD;
begin
if HandleAllocated then
begin
Res := ListView_ApproximateViewRect(Handle, Proposed.X, Proposed.Y, Count);
Result := Point(LoWord(Res), HiWord(Res));
end else
Result := Point(-1, -1);
end;
procedure TCustomExtListView.SetWorkArea(Rect: TRect);
begin
if HandleAllocated then
ListView_SetWorkArea(Handle, Rect);
end;
procedure TCustomExtListView.SetCheckState(Index: integer; Checked: boolean);
begin
if HandleAllocated then
ListView_SetCheckState(Handle, Index, Checked);
end;
function TCustomExtListView.GetCheckState(Index: integer): boolean;
begin
if HandleAllocated then
Result := ListView_GetCheckState(Handle, Index)
else
Result := FALSE;
end;
procedure TCustomExtListView.SetItemCountEx(Count: integer; Flags: TLVItemCountFlags);
var
APIFlags: DWORD;
begin
FItemCountEx := Count;
FItemCountExFlags := Flags;
if HandleAllocated then
begin
APIFlags := 0;
if lvsicfNoInvalidateAll in Flags then
APIFlags := LVSICF_NOINVALIDATEALL;
if lvsicfNoScroll in Flags then
APIFlags := APIFlags or LVSICF_NOSCROLL;
ListView_SetItemCountEx(Handle, Count, APIFlags);
end;
end;
procedure TCustomExtListView.SetVirtualMode(Val: boolean);
begin
if Val = FVirtualMode then exit;
FVirtualMode := Val;
if Items <> NIL then
Items.Clear;
{$IFDEF DFS_COMPILER_4_UP}
OwnerData := Val;
{$ELSE}
if HandleAllocated then
begin
RecreateWnd;
HandleNeeded;
end;
{$ENDIF}
end;
function TCustomExtListView.GetItemIndent(Index: integer): Integer;
var
APIItem: TLVItemEx;
begin
HandleNeeded;
{ Which item do they want? }
APIItem.iItem := Index;
{ Indenting is only supported for items, not subitems, by COMCTL32.DLL }
APIItem.iSubItem := 0;
{ Tell it that only the iIndent value is to be set for the item so it }
{ leaves the rest of the stuff alone }
APIItem.mask := LVIF_INDENT;
{ Get it. }
if SendMessage(Handle, LVM_GETITEM, 0, LPARAM(@APIItem)) <> 0 then
Result := APIItem.iIndent
else
Result := -1;
end;
procedure TCustomExtListView.SetItemIndent(Index: integer; Value: Integer);
var
APIItem: TLVItemEx;
begin
HandleNeeded;
{ Which item do they want? }
APIItem.iItem := Index;
{ Indenting is only supported for items, not subitems, by COMCTL32.DLL }
APIItem.iSubItem := 0;
{ Tell it that only the iIndent value is set for the item so it }
{ leaves the rest of the stuff alone }
APIItem.mask := LVIF_INDENT;
APIItem.iIndent := Value;
{ Set it. }
if SendMessage(Handle, LVM_SETITEM, 0, LPARAM(@APIItem)) = 0 then
messagebeep(1);
end;
procedure TCustomExtListView.ItemChecked(ItemIndex: integer; Checked: boolean);
begin
if assigned(FOnItemChecked) then
FOnItemChecked(Self, ItemIndex, Checked);
end;
procedure TCustomExtListView.CNNotify(var Message: TWMNotify);
var
CallInherited: boolean;
RenameText: string;
RenameCanceled: boolean;
begin
if Message.NMHdr = NIL then
begin
inherited;
exit;
end;
with Message.NMHdr^ do
begin
Message.Result := 0;
CallInherited := FALSE;
case code of
LVN_ITEMCHANGING:
begin
inherited;
// make sure we're going to change, and the change involves the state
with PNMListView(Pointer(Message.NMHdr))^ do
if ((uChanged and LVIF_STATE) <> 0) and (Message.Result = 0) then
begin
FCheckedListItemIndex := iItem;
FChecked := IsChecked[iItem];
end;
end;
LVN_ITEMCHANGED:
begin
inherited;
// See if an item's checked state changed
with PNMListView(Pointer(Message.NMHdr))^ do
if ((uChanged and LVIF_STATE) <> 0) and (iItem =
FCheckedListItemIndex) and (FChecked <> IsChecked[iItem]) then
ItemChecked(FCheckedListItemIndex, not FChecked);
end;
// We only want to handle LVN_ENDLABELEDIT when in virtual mode
LVN_ENDLABELEDIT:
if FVirtualMode then
begin
RenameCanceled := PLVDispInfo(pointer(Message.NMHdr))^.item.pszText =
NIL;
if RenameCanceled then
RenameText := ''
else
RenameText := StrPas(
PLVDispInfo(pointer(Message.NMHdr))^.item.pszText);
VMCaptionEdited(PLVDispInfo(pointer(Message.NMHdr))^.item.iItem,
RenameCanceled, RenameText);
end
else
CallInherited := TRUE;
// We only want to handle LVN_GETDISPINFO when in virtual mode
LVN_GETDISPINFO:
if FVirtualMode then
VMGetDispInfo(PLVDispInfoEx(pointer(Message.NMHdr))^.item)
else
CallInherited := TRUE;
LVN_ODCACHEHINT:
VMCacheHint(PNMCacheHint(pointer(Message.NMHdr))^);
LVN_ODSTATECHANGED:
VMStateChanged(PNMODStateChange(pointer(Message.NMHdr))^);
LVN_ODFINDITEM:
Message.Result := VMFindItem(PNMFindItem(pointer(Message.NMHdr))^);
LVN_ITEMACTIVATE:
begin
ItemActivate;
Message.Result := 0;
end;
LVN_MARQUEEBEGIN:
begin
if MarqueeBegin then
Message.Result := 0
else
Message.Result := 1;
end;
LVN_HOTTRACK:
begin
if HotTrack(PNMListView(Message.NMHdr)^) then
Message.Result := 0
else
Message.Result := 1;
end;
LVN_GETINFOTIP:
begin
GetInfoTip(PNMLVGetInfoTip(Message.NMHdr));
SetWindowPos(Handle, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOREDRAW or
SWP_NOSIZE or SWP_NOMOVE);
Message.Result := 1;
end;
else
CallInherited := TRUE;
end;
end;
if CallInherited then
inherited;
end;
procedure TCustomExtListView.WMNotify(var Message: TWMNotify);
var
CallInherited: boolean;
HTI: THDHitTestInfo;
pt: TPoint;
ExtColumn: TdfsExtListColumn;
begin
CallInherited := TRUE;
case Message.NMHdr.code of
// For some reason, the SECOND time you drag a header width, it toasts the
// bitmap. I think it has to do with the TListView class somehow resetting
// the column information, overwriting our information (image info). Anyway,
// catching the condition (begin column header drag) and resetting all the
// extended information for that column fixes it.
HDN_BEGINTRACK, HDN_BEGINTRACKW, // the ...W messages were necessary, why? I do not know.
HDN_DIVIDERDBLCLICK, HDN_DIVIDERDBLCLICKW: // doubleclick also
begin
UpdateColumnImage(PHDNotify(Message.NMHdr).Item); // from above
if HeaderHandle <> 0 then
begin
// get cursor position
GetCursorPos(pt);
// convert to coordinates on header control of the listview
Windows.ScreentoClient(HeaderHandle,pt);
// fill in hittest structure
HTI.flags := HHT_ONHEADER Or HHT_ONDIVIDER;
HTI.point.x := pt.x;
HTI.point.y := pt.y;
// get the header's hit-test info
SendMessage(HeaderHandle, HDM_HITTEST, LongInt(0),LongInt(@HTI));
if (HTI.Item >=0) and (HTI.Item < ColumnsFormat.Count) then
ExtColumn := ColumnsFormat[HTI.Item] // get the extended format
else
ExtColumn := NIL;
if Assigned(ExtColumn) then // found one?
if not ExtColumn.AllowResize then
begin
CallInherited := FALSE; // Do not pass this msg
Message.Result := 1; // Message stopped, do not handle the resize event
end;
end;
end;
{$IFDEF DFS_COMPILER_4_UP}
// Delphi 4 re-orders column information on this notification to adjust for
// column headers that have been moved to new locations. That breaks this
// component since it already adjusts for that, but in a different way.
// Since this is a notification message, we don't need to pass it on to
// inherited unless it needs it for something specific. In this case, the
// only thing this notification is used for is to kick off the order
// adjustment, so we'll just eat the message.
HDN_ENDDRAG:
begin
CallInherited := FALSE; // Don't pass it on!
// Since we aren't letting the default handler have it, we must
// invalidate the area our self so the items get redrawn with the new
// column order applied.
Invalidate;
end;
{$ENDIF}
end;
if CallInherited then
inherited;
end;
function TCustomExtListView.MarqueeBegin: boolean;
begin
Result := TRUE;
if assigned(FOnMarqueeBegin) then
FOnMarqueeBegin(Self, Result);
end;
procedure TCustomExtListView.ItemActivate;
begin
if assigned(FOnItemActivate) then
FOnItemActivate(Self);
end;
function TCustomExtListView.HotTrack(var Item: TNMListView): boolean;
begin
Result := TRUE;
if assigned(FOnHotTrack) then
FOnHotTrack(Self, Item.iItem, Item.iSubItem, Item.ptAction, Result);
end;
procedure TCustomExtListView.GetInfoTip(InfoTip: PNMLVGetInfoTip);
var
Current,
Additional: string;
begin
if assigned(InfoTip) then
begin
if assigned(FOnInfoTip) then
begin
if InfoTip^.dwFlags = LVGIT_UNFOLDED then
Current := string(InfoTip^.pszText)
else
Current := '';
FOnInfoTip(Self, InfoTip^.iItem, InfoTip^.iSubItem, Current, Additional);
if Additional <> '' then
begin
if InfoTip^.dwFlags = LVGIT_UNFOLDED then
StrLCat(InfoTip^.pszText, PChar(Additional), InfoTip^.cchTextMax)
else
StrLCopy(InfoTip^.pszText, PChar(Additional), InfoTip^.cchTextMax);
end;
end
else if not VirtualMode then
begin
if InfoTip^.dwFlags = LVGIT_UNFOLDED then
StrLCat(InfoTip^.pszText, PChar(Items[InfoTip^.iItem].Caption),
InfoTip^.cchTextMax)
else
StrLCopy(InfoTip^.pszText, PChar(Items[InfoTip^.iItem].Caption),
InfoTip^.cchTextMax);
end;
end;
end;
procedure TCustomExtListView.VMGetDispInfo(var ItemInfo: TLVItemEx);
function MaskFlagsToSet(Mask: UINT): TLVVMMaskItems;
begin
Result := [];
if (Mask and LVIF_TEXT) = LVIF_TEXT then
Include(Result, lvifText);
if (Mask and LVIF_IMAGE) = LVIF_IMAGE then
Include(Result, lvifImage);
if (Mask and LVIF_PARAM) = LVIF_PARAM then
Include(Result, lvifParam);
if (Mask and LVIF_STATE) = LVIF_STATE then
Include(Result, lvifState);
if (Mask and LVIF_INDENT) = LVIF_INDENT then
Include(Result, lvifIndent);
end;
function SetToMaskFlags(Mask: TLVVMMaskItems): UINT;
begin
Result := 0;
if lvifText in Mask then
Result := Result or LVIF_TEXT;
if lvifImage in Mask then
Result := Result or LVIF_IMAGE;
if lvifParam in Mask then
Result := Result or LVIF_PARAM;
if lvifState in Mask then
Result := Result or LVIF_STATE;
if lvifIndent in Mask then
Result := Result or LVIF_INDENT;
end;
(* function StateMaskFlagsToSet(Mask: UINT): TLVVMStateMaskItems;
begin
Result := [];
if (Mask and LVIS_CUT) = LVIS_CUT then
Include(Result, lvisCut);
if (Mask and LVIS_DROPHILITED) = LVIS_DROPHILITED then
Include(Result, lvisDropHighlighted);
if (Mask and LVIS_FOCUSED) = LVIS_FOCUSED then
Include(Result, lvisFocused);
if (Mask and LVIS_SELECTED) = LVIS_SELECTED then
Include(Result, lvisSelected);
if (Mask and LVIS_OVERLAYMASK) = LVIS_OVERLAYMASK then
Include(Result, lvisOverlayMask);
end;*)
var
Text: string;
NewState: UINT;
NewStateMask: UINT;
GetMask: TLVVMMaskItems;
OverlayImage, StateImage: word;
begin
if ItemInfo.iItem = -1 then exit; // No way.
Text := '';
NewState := ItemInfo.State;
NewStateMask := ItemInfo.StateMask;
GetMask := MaskFlagsToSet(ItemInfo.Mask);
if assigned(FOnVMGetItemInfo) then
begin
OverlayImage := 0;
StateImage := 0;
with ItemInfo do
FOnVMGetItemInfo(Self, iItem, iSubItem, GetMask,
iImage, OverlayImage, StateImage, lParam, NewState, NewStateMask,
iIndent, Text);
if (ItemInfo.mask and LVIF_TEXT) = LVIF_TEXT then
StrLCopy(ItemInfo.pszText, PChar(Text), ItemInfo.cchTextMax);
ItemInfo.State := NewState;
ItemInfo.State := ItemInfo.State and not UINT(IndexToOverlayMask($FFFF));
ItemInfo.State := ItemInfo.State or UINT(IndexToOverlayMask(OverlayImage));
ItemInfo.State := ItemInfo.State and not UINT(IndexToStateImageMask($FFFF));
ItemInfo.State := ItemInfo.State or UINT(IndexToStateImageMask(StateImage));
ItemInfo.Mask := SetToMaskFlags(GetMask);
ItemInfo.StateMask := NewStateMask;
end;
end;
procedure TCustomExtListView.VMCacheHint(var HintInfo: TNMCacheHint);
begin
if assigned(FOnVMCacheHint) then
FOnVMCacheHint(Self, HintInfo);
end;
function TCustomExtListView.VMFindItem(var FindInfo: TNMFindItem): integer;
begin
Result := -1;
if assigned(FOnVMFindItem) then
FOnVMFindItem(Self, FindInfo, Result);
end;
procedure TCustomExtListView.VMStateChanged(var StateInfo: TNMODStateChange);
begin
if assigned(FOnVMStateChanged) then
FOnVMStateChanged(Self, StateInfo);
end;
procedure TCustomExtListView.VMCaptionEdited(Item: integer; Canceled: boolean;
const Text: string);
begin
if assigned(FOnVMCaptionEdited) then
FOnVMCaptionEdited(Self, Item, Canceled, Text);
end;
function TCustomExtListView.WriteSettings: boolean;
var
x,
ColCount: integer;
ColArray: PIntArray;
begin
Result := TRUE;
ColCount := Columns.Count;
if (FSaveSettings.SaveColumnOrder or FSaveSettings.SaveColumnSizes) and
(ColCount > 0) then
begin
GetMem(ColArray, SizeOf(Integer)*ColCount);
try
if FSaveSettings.SaveColumnOrder then
begin
GetColumnOrder(ColCount, ColArray^);
FSaveSettings.StoreColumnOrder(ColCount, ColArray^);
end;
if FSaveSettings.SaveColumnSizes then
begin
for x := 0 to ColCount-1 do
ColArray[x] := ActualColumn[x].Width;
FSaveSettings.StoreColumnSizes(ColCount, ColArray^);
end;
finally
FreeMem(ColArray);
end;
end;
if FSaveSettings.SaveCurrentSort then
FSaveSettings.StoreCurrentSort(CurrentSortAscending, LastColumnClicked);
if FSaveSettings.SaveViewStyle then
FSaveSettings.StoreViewStyle(ViewStyle);
end;
function TCustomExtListView.StoreSettings: boolean;
begin
// DON'T CALL INHERITED!!!! It has caused me no end of trouble, so I
// just resave the width stuff if I need to rather than call inherited.
if FSaveSettings.AutoSave and
((([csDesigning, csLoading, csReading] * ComponentState) = []) or
(csDestroying in ComponentState)) then
Result := WriteSettings
else
Result := FALSE;
end;
function TCustomExtListView.ReadSettings: boolean;
var
x,
ColCount: integer;
ColArray: PIntArray;
SortCol: integer;
SortAscending: boolean;
begin
Result := TRUE;
ColCount := Columns.Count;
if (FSaveSettings.SaveColumnOrder or FSaveSettings.SaveColumnSizes) and
(ColCount > 0) then
begin
GetMem(ColArray, SizeOf(Integer)*ColCount);
try
if FSaveSettings.SaveColumnOrder then
begin
FSaveSettings.ReadColumnOrder(ColCount, ColArray^);
SetColumnOrder(ColCount, ColArray^);
end;
if FSaveSettings.SaveColumnSizes then
begin
for x := 0 to ColCount-1 do
ColArray[x] := ActualColumn[x].Width;
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;
if FSaveSettings.SaveViewStyle then
ViewStyle := FSaveSettings.ReadViewStyle(ViewStyle);
end;
function TCustomExtListView.LoadSettings: boolean;
begin
if FSaveSettings.AutoSave and (not(csDesigning in ComponentState)) then
Result := ReadSettings
else
Result := FALSE;
end;
function TCustomExtListView.ELV_GetNextItem(StartItem: integer;
Direction: TSearchDirection; States: TItemStates): integer;
var
Flags: Integer;
begin
Result := -1;
if HandleAllocated then
begin
Flags := 0;
case Direction of
sdAbove: Flags := LVNI_ABOVE;
sdBelow: Flags := LVNI_BELOW;
sdLeft: Flags := LVNI_TOLEFT;
sdRight: Flags := LVNI_TORIGHT;
sdAll: Flags := LVNI_ALL;
end;
if isCut in States then Flags := Flags or LVNI_CUT;
if isDropHilited in States then Flags := Flags or LVNI_DROPHILITED;
if isFocused in States then Flags := Flags or LVNI_FOCUSED;
if isSelected in States then Flags := Flags or LVNI_SELECTED;
Result := ListView_GetNextItem(Handle, StartItem, Flags);
end;
end;
procedure TCustomExtListView.ELV_SetItemState(Index: integer;
States: TItemStates; Setting: boolean);
var
NewState,
Flags: UINT;
begin
if HandleAllocated then
begin
Flags := 0;
if isCut in States then Flags := Flags or LVIS_CUT;
if isDropHilited in States then Flags := Flags or LVIS_DROPHILITED;
if isFocused in States then Flags := Flags or LVIS_FOCUSED;
if isSelected in States then Flags := Flags or LVIS_SELECTED;
{$IFDEF DFS_COMPILER_4}
if isActivating in States then Flags := Flags or LVIS_ACTIVATING;
{$ENDIF}
if Setting then
NewState := Flags
else
NewState := 0;
ListView_SetItemState(Handle, Index, NewState, Flags);
end;
end;
procedure TCustomExtListView.ELV_EditCaption(Item: integer);
begin
if HandleAllocated then
ListView_EditLabel(Handle, Item);
end;
procedure TCustomExtListView.ColumnHeaderImagesChange(Sender: TObject);
begin
UpdateColumnsImages; { Images changed }
end;
procedure TCustomExtListView.SetColumnsFormat(Value: TdfsExtListColumns);
begin
FColumnsFormat.Assign(Value);
end;
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
procedure TCustomExtListView.SetBackgroundImage(Value: TELVBackgroundImage);
begin
FBackgroundImage.Assign(Value);
end;
{$ENDIF}
function TCustomExtListView.GetSubItemImageIndex(Item, SubItem: integer): integer;
var
APIItem: TLVItem;
begin
HandleNeeded;
Result := -1; // Assume the worst
{ Which item do they want? }
APIItem.iItem := Item;
{ Subitem index, this is one-based, zero is the caption item }
APIItem.iSubItem := SubItem+1;
{ Tell it that only the iImage value is to be set for the item so it }
{ leaves the rest of the stuff alone }
APIItem.mask := LVIF_IMAGE;
{ Get it. }
if ListView_GetItem(Handle, APIItem) then
Result := APIItem.iImage;
end;
procedure TCustomExtListView.SetSubItemImageIndex(Item, SubItem, Value: integer);
var
APIItem: TLVItem;
begin
HandleNeeded;
{ Which item is it? }
APIItem.iItem := Item;
{ Subitem index, this is one-based, zero is the caption item }
APIItem.iSubItem := SubItem+1;
{ Tell it what image list index to use }
APIItem.iImage := Value;
{ Tell it that only the iImage value is to be set for the item so it }
{ leaves the rest of the stuff in the item alone }
APIItem.mask := LVIF_IMAGE;
{ Set it. }
ListView_SetItem(Handle, APIItem);
end;
function TCustomExtListView.GetStateImages: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList; {$ELSE} TImageList; {$ENDIF}
begin
// Nothing, just get it
Result := inherited StateImages;
end;
procedure TCustomExtListView.SetStateImages(Value: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList {$ELSE} TImageList {$ENDIF});
begin
SaveChecks;
inherited StateImages := Value;
if StateImages <> NIL then
ListView_SetCallbackMask(Handle, ListView_GetCallbackMask(Handle) or
LVIS_STATEIMAGEMASK)
else
ListView_SetCallbackMask(Handle, ListView_GetCallbackMask(Handle) and not
LVIS_STATEIMAGEMASK);
RestoreChecks;
end;
function TCustomExtListView.GetSmallImages: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList; {$ELSE} TImageList; {$ENDIF}
begin
// Nothing, just get it
Result := inherited SmallImages;
end;
procedure TCustomExtListView.SetSmallImages(Value: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList {$ELSE} TImageList {$ENDIF});
begin
// Unlink ourself from old value
if SmallImages <> NIL then
SmallImages.UnregisterChanges(FColumnsFormatChangeLink);
inherited SmallImages := Value;
// Re-link to the new value.
if SmallImages <> NIL then
SmallImages.RegisterChanges(FColumnsFormatChangeLink);
// Force the header to redraw
SetColumnsOwnerDrawFlag(assigned(OnDrawHeader) or ShowSortArrows);
end;
function TCustomExtListView.GetSelectionMark: integer;
begin
if HandleAllocated then
FSelectionMark := ListView_GetSelectionMark(Handle);
Result := FSelectionMark;
end;
procedure TCustomExtListView.SetSelectionMark(Val: integer);
begin
if Val <> FSelectionMark then
FSelectionMark := Val;
// Call even if not changed because handle may not have been allocated
if HandleAllocated then
ListView_SetSelectionMark(Handle, Val);
end;
function TCustomExtListView.GetHoverTime: Longint;
begin
if HandleAllocated then
FHoverTime := Longint(ListView_GetHoverTime(Handle));
Result := FHoverTime;
end;
procedure TCustomExtListView.SetHoverTime(Val: Longint);
begin
if Val <> FHoverTime then
FHoverTime := Val;
// Call even if not changed because handle may not have been allocated last time
if HandleAllocated then
ListView_SetHoverTime(Handle, DWORD(Val));
end;
procedure TCustomExtListView.SetRequireComCtlUpdate(Value: boolean);
begin
FRequireComCtlUpdate := Value;
if FRequireComCtlUpdate and (not (csDesigning in ComponentState)) then
begin
if not CheckComCtlVersion(4, 70, 0, 0) then
raise EELVOldComCtl.Create('COMCTL32.DLL is older than required version');
end;
end;
procedure TCustomExtListView.UpdateColumnsImages;
var
i: Integer;
begin
if not (assigned(OnDrawHeader) or ShowSortArrows) then
if HandleAllocated then
for i := 0 to Columns.Count - 1 do UpdateColumnImage(i);
end;
procedure TCustomExtListView.UpdateColumnImage(Index: integer);
function ValidImages: boolean;
begin
Result := assigned(SmallImages) and (SmallImages.Count > 0);
end;
var
Column: TLVColumnEx;
begin { UpdateColumnImage }
if assigned(OnDrawHeader) or ShowSortArrows then
exit;
if HandleAllocated and (Index > -1) and (Index < FColumnsFormat.Count) and
ValidImages then
begin
FillChar(Column, SizeOf(Column), #0);
ListView_GetColumnEx(Handle, Index, Column);
with Column, FColumnsFormat[Index] do
begin
if (ImageIndex <> -1) then
begin
iImage := ImageIndex;
// Add LVCF_FMT Just to make sure...
mask := mask or LVCF_IMAGE or LVCF_FMT;
fmt := fmt or LVCFMT_IMAGE;
if ImageAlignment = ciaRightOfText then
fmt := fmt or LVCFMT_BITMAP_ON_RIGHT;
end else begin
mask := LVCF_FMT;
fmt := fmt and not LVCFMT_IMAGE and not LVCFMT_BITMAP_ON_RIGHT;
end;
case Columns.Items[Index].Alignment of
taLeftJustify: fmt := fmt or LVCFMT_LEFT;
taCenter: fmt := fmt or LVCFMT_CENTER;
taRightJustify: fmt := fmt or LVCFMT_RIGHT;
end;
end;
ListView_SetColumnEx(Handle, Index, Column);
end;
end;
function TCustomExtListView.CheckComCtlVersion(MajorHi, MajorLo,
MinorHi, MinorLo: word): boolean;
begin
Result := CheckDLLVersion('COMCTL32.DLL', MajorHi, MajorLo, MinorHi, MinorLo);
end;
function TCustomExtListView.GetShowSortArrows: boolean;
begin
Result := inherited ShowSortArrows;
end;
procedure TCustomExtListView.SetShowSortArrows(Value: boolean);
begin
inherited ShowSortArrows := Value;
UpdateColumnsImages;
end;
function TCustomExtListView.ActualColumnIndex(Index: integer): integer;
var
x,
ColCount: integer;
ColArray: PIntArray;
begin
// account for modified column order
// 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;
Result := 0;
ColCount := Columns.Count;
if Index >= ColCount then
exit;
GetMem(ColArray, SizeOf(Integer)*ColCount);
try
GetColumnOrder(ColCount, ColArray^);
for x := 0 to ColCount-1 do
if ColArray[x] = Index then
begin
Result := x;
exit;
end;
finally
FreeMem(ColArray);
end;
end;
function TCustomExtListView.GetVersion: string;
begin
Result := DFS_COMPONENT_VERSION;
end;
procedure TCustomExtListView.DefaultDrawSubItem(Index, SubItem: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Dummy: boolean;
SavedDC: integer;
begin
if VirtualMode then
begin
SavedDC := SaveDC(FCanvas.Handle);
try
if not (csDesigning in ComponentState) then
DrawSubItem(Index, SubItem, Rect, State, Dummy)
else if Index = -1 then
DrawTextEx(FCanvas.Handle, 'Virtual mode', -1, Rect, DRAWTEXTEX_FLAGS or
DRAWTEXTEX_ALIGNMENT[ActualColumn[SubItem+1].Alignment], NIL);
finally
RestoreDC(FCanvas.Handle, SavedDC);
end;
end else
inherited DefaultDrawSubItem(Index, SubItem, Rect, State);
end;
procedure TCustomExtListView.DefaultDrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState; FullRowSelect: boolean);
var
Count: Integer;
SubRect: TRect;
begin
if VirtualMode then
begin
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;
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 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 else
inherited DefaultDrawItem(Index, Rect, State, FullRowSelect);
end;
procedure TCustomExtListView.RestoreChecks;
var
i, q: Integer;
Value: Boolean;
SubItem: integer;
begin
for i := 0 to Items.Count - 1 do
begin
if FRecreateStream <> nil then
begin
FRecreateStream.Read(Value, SizeOf(Value));
IsChecked[i] := Value;
for q := 0 to Columns.Count - 2 do
begin
FRecreateStream.Read(SubItem, SizeOf(SubItem));
SubItem_ImageIndex[i, q] := SubItem;
end;
end
else
begin
IsChecked[i] := False;
for q := 0 to Columns.Count - 2 do
SubItem_ImageIndex[i, q] := ELV_NO_SUBITEM_IMAGE;
end;
end;
FRecreateStream.Free;
FRecreateStream := nil;
end;
procedure TCustomExtListView.SaveChecks;
var
i, q: Integer;
Value: Boolean;
SubItem: integer;
begin
if FRecreateStream = nil then
FRecreateStream := TMemoryStream.Create
else
{$IFDEF DFS_COMPILER_2}
FRecreateStream.Clear;
{$ELSE}
FRecreateStream.Size := 0;
{$ENDIF}
for i := 0 to Items.Count - 1 do
begin
Value := IsChecked[i];
FRecreateStream.Write(Value, SizeOf(Value));
for q := 0 to Columns.Count - 2 do
begin
SubItem := SubItem_ImageIndex[i, q];
FRecreateStream.Write(SubItem, SizeOf(SubItem));
end;
end;
FRecreateStream.Position := 0;
end;
procedure TCustomExtListView.DestroyWnd;
begin
SaveChecks;
inherited;
end;
{$IFDEF DFS_COMPILER_4_UP}
procedure TCustomExtListView.FeedOwnerDataMode(Sender: TObject; Item: TListItem);
var
ItemData: TLVItemEx;
x: integer;
begin
if not FInhibitFeedData then // Try to prevent unnecessary calls
begin
ItemData.iItem := Item.Index;
ItemData.iSubItem := 0;
ItemData.mask := LVIF_TEXT or LVIF_IMAGE or LVIF_PARAM or LVIF_STATE or
LVIF_INDENT;
GetMem(ItemData.pszText, 1024);
try
VMGetDispInfo(ItemData);
Item.Caption := ItemData.pszText;
Item.ImageIndex := ItemData.iImage;
Item.Data := pointer(ItemData.lParam);
Item.Indent := ItemData.iIndent;
ItemData.mask := LVIF_TEXT;
for x := 1 to Columns.Count - 1 do
begin
VMGetDispInfo(ItemData);
Item.SubItems.Add(ItemData.pszText);
end;
finally
FreeMem(ItemData.pszText);
end;
end;
end;
{$ENDIF}
{ TdfsExtListColumn }
constructor TdfsExtListColumn.Create(Collection: TCollection);
begin
inherited Create(Collection);
FSmallImageIndex := -1;
FImageAlignment := ciaRightOfText;
FAllowResize := TRUE;
end;
destructor TdfsExtListColumn.Destroy;
begin
FSmallImageIndex := -1;
FImageAlignment := ciaRightOfText;
inherited Destroy;
end;
procedure TdfsExtListColumn.DoChange;
var
i: Integer;
begin
for i := 0 to Collection.Count-1 do
Changed(i <> Collection.Count);
end;
procedure TdfsExtListColumn.SetSmallImageIndex(Value: Integer);
begin
if FSmallImageIndex <> Value then
begin
FSmallImageIndex := Value;
DoChange;
end;
end;
procedure TdfsExtListColumn.SetImageAlignment(Value: TColumnImageAlign);
begin
if FImageAlignment <> Value then
begin
FImageAlignment := Value;
DoChange;
end;
end;
procedure TdfsExtListColumn.Assign(Source: TPersistent);
var
Column: TdfsExtListColumn;
begin
if Source is TdfsExtListColumn then
begin
Column := TdfsExtListColumn(Source);
ImageIndex := Column.ImageIndex;
ImageAlignment := Column.ImageAlignment;
end else
inherited Assign(Source);
end;
constructor TdfsExtListColumns.Create(AListView: TCustomExtListView);
begin
inherited Create(TdfsExtListColumn);
FListView := AListView;
end;
function TdfsExtListColumns.GetItem(Index: Integer): TdfsExtListColumn;
begin
Result := TdfsExtListColumn(inherited GetItem(Index));
end;
procedure TdfsExtListColumns.SetItem(Index: Integer; Value: TdfsExtListColumn);
begin
inherited SetItem(Index, Value);
end;
function TdfsExtListColumns.Add: TdfsExtListColumn;
begin
Result := TdfsExtListColumn(inherited Add);
end;
function TdfsExtListColumns.GetOwner: TPersistent;
begin
Result := FListView;
end;
procedure TdfsExtListColumns.Update(Item: TCollectionItem);
begin
if ListView <> NIL then
begin
if Item <> NIL then
ListView.UpdateColumnImage(Item.Index)
else
ListView.UpdateColumnsImages;
end;
end;
procedure TdfsExtListColumns.Refresh;
begin
if ListView <> NIL then
ListView.UpdateColumnsImages;
end;
procedure TdfsExtListColumns.Assign(Source: TPersistent);
begin
Clear;
inherited Assign(Source);
end;
function CheckDLLVersion(const DLLName: string; MajorHi, MajorLo,
MinorHi, MinorLo: word): boolean;
var
VerInfoSize: DWORD;
VerInfo: Pointer;
VerValueSize: DWORD;
VerValue: PVSFixedFileInfo;
Dummy: DWORD;
V1, V2, V3, V4: word;
begin
Result := FALSE;
VerInfoSize := GetFileVersionInfoSize(PChar(DLLName), Dummy);
if VerInfoSize = 0 then
exit;
GetMem(VerInfo, VerInfoSize);
if not assigned(VerInfo) then
exit;
try
if GetFileVersionInfo(PChar(DLLName), 0, VerInfoSize, VerInfo) then
begin
if VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize) then
begin
with VerValue^ do
begin
V1 := dwFileVersionMS shr 16;
V2 := dwFileVersionMS and $FFFF;
V3 := dwFileVersionLS shr 16;
V4 := dwFileVersionLS and $FFFF;
end;
{ This would be SO much easier with D4's int64 type... }
if V1 < MajorHi then
Result := FALSE
else if V1 > MajorHi then
Result := TRUE
else begin
if V2 < MajorLo then
Result := FALSE
else if V2 > MajorLo then
Result := TRUE
else begin
if V3 < MinorHi then
Result := FALSE
else if V3 > MinorHi then
Result := TRUE
else begin
if V4 < MinorLo then
Result := FALSE
else if V4 > MinorLo then
Result := TRUE;
end;
end;
end;
end;
end;
finally
FreeMem(VerInfo, VerInfoSize);
end;
end;
initialization
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
// OleInitialize(NIL);
CoInitialize(NIL);
{$ENDIF}
finalization
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
// OleUninitialize;
CoUninitialize;
{$ENDIF}
end.