home *** CD-ROM | disk | FTP | other *** search
/ Freelog 11 / Freelog011.iso / BestOf / PhoenixMail / Source / comps / ExtListView.pas < prev    next >
Pascal/Delphi Source File  |  1998-12-04  |  81KB  |  2,697 lines

  1. {*****************************************************************************
  2.  *
  3.  *  Parts of this code were changed by Michael Haller
  4.  *  E-mail:     michael@discountdrive.com
  5.  *  Homepage:   http://www.discountdrive.com/sunrise/
  6.  *
  7.  *  The copyright has the original author of this code.
  8.  *
  9.  *****************************************************************************}
  10.  
  11.  
  12.  
  13. {$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }
  14.  
  15. {.$DEFINE DFS_DEBUG}
  16. {.$DEFINE DFS_TRY_BACKGROUND_IMAGE}
  17. {.$DEFINE DFS_TRY_INFOTIP}
  18.  
  19. {------------------------------------------------------------------------------}
  20. { TExtListView v3.10                                                           }
  21. {------------------------------------------------------------------------------}
  22. { A list view control that enables access to the new style types provieded     }
  23. { by the updated list view control.  The updated list view is provided in      }
  24. { the COMCTL32.DLL file that comes with Microsoft's new internet software.     }
  25. { Copyright 1998, Brad Stowers.  All Rights Reserved.                          }
  26. { This component can be freely used and distributed in commercial and private  }
  27. { environments, provied this notice is not modified in any way.                }
  28. {------------------------------------------------------------------------------}
  29. { Feel free to contact me if you have any questions, comments or suggestions   }
  30. { at bstowers@pobox.com.                                                       }
  31. { The lateset version will always be available on the web at:                  }
  32. {   http://www.pobox.com/~bstowers/delphi/                                     }
  33. { See ELV.txt for notes, known issues, and revision history.                   }
  34. {------------------------------------------------------------------------------}
  35. { Date last modified:  July 22, 1998                                           }
  36. {------------------------------------------------------------------------------}
  37.  
  38.  
  39. // C++Builder 3 requires this if you use run-time packages.
  40. {$IFDEF DFS_CPPB_3_UP}
  41.   {$ObjExportAll On}
  42. {$ENDIF}
  43.  
  44. unit ExtListView;
  45.  
  46. interface
  47.  
  48. {$IFNDEF DFS_WIN32}
  49.   ERROR!  This unit only available for Delphi 2.0 or higher!!!
  50. {$ENDIF}
  51.  
  52. uses
  53.   Windows, Messages, Classes, Controls, ComCtrls, CommCtrl, SysUtils, Graphics,
  54. {$IFDEF DFS_COMPILER_4_UP}
  55.   ImgList,
  56. {$ENDIF}
  57.   StdCtrls, Menus, EnhListView, Dialogs, DFSAbout, Forms, IniFiles;
  58.  
  59. const
  60.   { This shuts up C++Builder 3 about the redefiniton being different. There
  61.     seems to be no equivalent in C1.  Sorry. }
  62.   {$IFDEF DFS_CPPB_3_UP}
  63.   {$EXTERNALSYM DFS_COMPONENT_VERSION}
  64.   {$ENDIF}
  65.   DFS_COMPONENT_VERSION = 'TExtListView v3.10';
  66.  
  67. // Setting a subitem image (lvxSubItemImages ExtendStyle) to -1 does not
  68. // properly clear the image for the subitem.  The current COMCTL32.DLL
  69. // implementation does not seem to store this value and instead it gets a
  70. // random value assigned to it.  The work-around that I have found is to set
  71. // the index to a value that does not exist in the image list.  To make this
  72. // a bit easier, I have declared this constant.  Assigning this value to
  73. // SubItem_ImageIndex[itemindex] will clear the image from the subitem as long
  74. // as your image list does not have more than 2,147,483,646 images in it. :)
  75. const
  76.   ELV_NO_SUBITEM_IMAGE    = MAXINT - 1;
  77.  
  78.  
  79. // C3 and D4 CommCtrl.pas have almost everything we need
  80. {$IFDEF DFS_CPPB_3_UP}
  81.   {$DEFINE DFS_C3D4COMMCTRL}
  82. {$ELSE} {$IFDEF DFS_DELPHI_4_UP}
  83.   {$DEFINE DFS_C3D4COMMCTRL}
  84. {$ENDIF} {$ENDIF}
  85.  
  86. {$IFNDEF DFS_C3D4COMMCTRL}
  87. type
  88.   TLVDispInfo = TLVDispInfoA; // Borland forgot this one in D2, D3 & C1s
  89. {$ENDIF}
  90.  
  91. {$IFNDEF DFS_C3D4COMMCTRL}
  92. const
  93.   LVIF_INDENT             = $0010;
  94.   LVIF_NORECOMPUTE        = $0800;
  95.  
  96. {.$IFDEF DFS_DELPHI_2}
  97. { These are in COMMCTRL unit
  98.   LVCF_FMT                = $0001;
  99.   LVCF_WIDTH              = $0002;
  100.   LVCF_TEXT               = $0004;
  101.   LVCF_SUBITEM            = $0008;
  102. }
  103. {.$ENDIF}
  104.   LVCF_IMAGE              = $0010;
  105.   LVCF_ORDER              = $0020;
  106.  
  107. {.$IFDEF DFS_DELPHI_2}
  108. { These are in COMMCTRL unit
  109.   LVCFMT_LEFT             = $0000;
  110.   LVCFMT_RIGHT            = $0001;
  111.   LVCFMT_CENTER           = $0002;
  112.   LVCFMT_JUSTIFYMASK      = $0003;
  113. }
  114. {.$ENDIF}
  115.   LVCFMT_IMAGE            = $0800; // Item displays an image from an image list.
  116.   LVCFMT_BITMAP_ON_RIGHT  = $1000; // Image appears to right of text.
  117.   LVCFMT_COL_HAS_IMAGES   = $8000; // Undocumented.
  118.  
  119.   LVIS_ACTIVATING         = $0020;
  120. {$ENDIF}
  121.  
  122. type
  123.   PLVItemEx = ^TLVItemEx;
  124.   TLVItemEx = packed record
  125.     mask: UINT;
  126.     iItem: Integer;
  127.     iSubItem: Integer;
  128.     state: UINT;
  129.     stateMask: UINT;
  130.     pszText: PAnsiChar;
  131.     cchTextMax: Integer;
  132.     iImage: Integer;
  133.     lParam: LPARAM;
  134.     iIndent: integer;
  135.   end;
  136.  
  137.   PLVDispInfoEx = ^TLVDispInfoEx;
  138.   TLVDispInfoEx = packed record
  139.     hdr:   TNMHDR;
  140.     item:  TLVItemEx;
  141.   end;
  142.  
  143.   TLVColumnEx = packed record
  144.     mask: UINT;
  145.     fmt: Integer;
  146.     cx: Integer;
  147.     pszText: PAnsiChar;
  148.     cchTextMax: Integer;
  149.     iSubItem: Integer;
  150.     iImage: integer; // New
  151.     iOrder: integer; // New
  152.   end;
  153.  
  154.  
  155. // These functions already exist, and there is no way to override them, so I'll
  156. // just rename them and you can use them as best you can.
  157. function ListView_GetColumnEx(LVWnd: HWND; iCol: Integer;
  158.    var pcol: TLVColumnEx): Bool;
  159. function ListView_SetColumnEx(LVWnd: HWnd; iCol: Integer;
  160.    const pcol: TLVColumnEx): Bool;
  161. function ListView_InsertColumnEx(LVWnd: HWND; iCol: Integer;
  162.    const pcol: TLVColumnEx): Integer;
  163.  
  164.  
  165. {$IFNDEF DFS_C3D4COMMCTRL}
  166. const
  167.   LVM_GETHEADER           = LVM_FIRST + 31;
  168.  
  169. function ListView_GetHeader(LVWnd: HWnd): HWnd;
  170. {$ENDIF}
  171.  
  172.  
  173. {$IFNDEF DFS_COMPILER_3_UP}
  174. const
  175.   LVM_SETICONSPACING      = LVM_FIRST + 53;
  176.  
  177.  
  178. // -1 for cx and cy means we'll use the default (system settings)
  179. // 0 for cx or cy means use the current setting (allows you to change just one
  180. // param)
  181. function ListView_SetIconSpacing(LVWnd: HWnd; cx, cy: integer): DWORD;
  182.  
  183. const
  184.   LVS_EX_GRIDLINES             = $00000001;  // Report mode only.
  185.   LVS_EX_SUBITEMIMAGES         = $00000002;  // Report mode only.
  186.   LVS_EX_CHECKBOXES            = $00000004;
  187.   LVS_EX_TRACKSELECT           = $00000008;
  188.   LVS_EX_HEADERDRAGDROP        = $00000010;  // Report mode only.
  189.   LVS_EX_FULLROWSELECT         = $00000020;  // Report mode only.
  190.   LVS_EX_ONECLICKACTIVATE      = $00000040;
  191.   LVS_EX_TWOCLICKACTIVATE      = $00000080;
  192.  
  193.   LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 54; // optional wParam = mask
  194.  
  195. function ListView_SetExtendedListViewStyle(LVWnd: HWnd; ExStyle: LPARAM): DWORD;
  196.  
  197. const
  198.   LVM_GETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 55;
  199.  
  200. function ListView_GetExtendedListViewStyle(LVWnd: HWnd): DWORD;
  201.  
  202. {$ENDIF}
  203.  
  204. (* These were already defined in everything...
  205. const
  206.   LVIR_BOUNDS             = 0;
  207.   LVIR_ICON               = 1;
  208.   LVIR_LABEL              = 2;
  209.   LVIR_SELECTBOUNDS       = 3;
  210. *)
  211.  
  212. {$IFDEF DFS_COMPILER_2}
  213. const
  214.   LVM_GETSUBITEMRECT      = LVM_FIRST + 56;
  215.  
  216. function ListView_GetSubItemRect(LVWnd: HWnd; ParentItem, SubItem,
  217.    Code: integer; var Rect: TRect): boolean;
  218.  
  219. const
  220.   LVM_SUBITEMHITTEST      = LVM_FIRST + 57;
  221. {$ENDIF}
  222.  
  223. {$IFNDEF DFS_C3D4COMMCTRL}
  224. const
  225.   LVS_EX_FLATSB           = $00000100;
  226.   LVS_EX_REGIONAL         = $00000200;
  227.   LVS_EX_INFOTIP          = $00000400;
  228.   LVS_EX_UNDERLINEHOT     = $00000800;
  229.   LVS_EX_UNDERLINECOLD    = $00001000;
  230.   LVS_EX_MULTIWORKAREAS   = $00002000;
  231.  
  232. // Pass the LVS_EX_* styles you want to modify in Mask and ExStyle will apply
  233. // only to those.  Others will be left in current state.  For example, if you
  234. // pass LVS_EX_FULLROWSELECT for Mask and 0 for ExStyle, the
  235. // LVS_EX_FULLROWSELECT style will be cleared, but all other styles will remain
  236. // the same.
  237. function ListView_SetExtendedListViewStyleEx(LVWnd: HWnd; Mask: DWord;
  238.    ExStyle: LPARAM): DWORD;
  239. {$ENDIF}
  240.  
  241. {$IFNDEF DFS_C3D4COMMCTRL}
  242.   // C3 & D4 users don't need this because their COMMCTRL.PAS file has it right
  243.   // and they can simply use the existing TLVHitTestInfo and
  244.   // ListView_SubItemHitTest()
  245. type
  246.   PLVHitTestInfoEx = ^TLVHitTestInfoEx;
  247.   TLVHitTestInfoEx = packed record
  248.     pt: TPoint;
  249.     flags: UINT;
  250.     iItem: integer;
  251.     iSubItem: integer;
  252.   end;
  253.  
  254. function ListView_SubItemHitTestEx(LVWnd: HWnd;
  255.    var HitTestInfo: TLVHitTestInfoEx): integer;
  256. {$ENDIF}
  257.  
  258. {$IFNDEF DFS_COMPILER_3_UP}
  259. const
  260.   LVM_SETCOLUMNORDERARRAY = LVM_FIRST + 58;
  261.  
  262. function ListView_SetColumnOrderArray(LVWnd: HWnd; Count: integer;
  263.    IntArray: PIntArray): boolean;
  264.  
  265. const
  266.   LVM_GETCOLUMNORDERARRAY = LVM_FIRST + 59;
  267.  
  268. function ListView_GetColumnOrderArray(LVWnd: HWnd; Count: integer;
  269.    IntArray: PIntArray): boolean;
  270.  
  271. const
  272.   LVM_SETHOTITEM  = LVM_FIRST + 60;
  273.  
  274. function ListView_SetHotItem(LVWnd: HWnd; Item: integer): integer;
  275.  
  276. const
  277.   LVM_GETHOTITEM  = LVM_FIRST + 61;
  278.  
  279. function ListView_GetHotItem(LVWnd: HWnd): integer;
  280.  
  281. const
  282.   LVM_SETHOTCURSOR  = LVM_FIRST + 62;
  283.  
  284. function ListView_SetHotCursor(LVWnd: HWnd; Cursor: HCursor): HCursor;
  285.  
  286. const
  287.   LVM_GETHOTCURSOR  = LVM_FIRST + 63;
  288.  
  289. function ListView_GetHotCursor(LVWnd: HWnd): HCursor;
  290.  
  291. const
  292.   LVM_APPROXIMATEVIEWRECT = LVM_FIRST + 64;
  293.  
  294. function ListView_ApproximateViewRect(LVWnd: HWnd; Width, Height,
  295.    Count: integer): DWORD;
  296.  
  297. const
  298.   LVM_SETWORKAREA         = LVM_FIRST + 65;
  299.  
  300. function ListView_SetWorkArea(LVWnd: HWnd; const Rect: TRect): boolean;
  301.  
  302. function ListView_GetCheckState(LVWnd: HWnd; Index: UINT): boolean;
  303.  
  304. procedure ListView_SetCheckState(LVWnd: HWnd; Index: UINT; Checked: boolean);
  305. {$ENDIF}
  306.  
  307. {$IFNDEF DFS_C3D4COMMCTRL}
  308. const
  309.   LVSICF_NOINVALIDATEALL  = $00000001;
  310.   LVSICF_NOSCROLL         = $00000002;
  311.  
  312. procedure ListView_SetItemCountEx(LVWnd: HWnd; Items: integer; Flags: DWORD);
  313. {$ENDIF}
  314.  
  315. {$IFNDEF DFS_COMPILER_3_UP}
  316. const
  317.   // New list view style flags.
  318.   LVS_OWNERDATA                = $1000; // Specifies a "virtual" control.
  319.  
  320.   // New notification messages.
  321.   LVN_ODCACHEHINT              = LVN_FIRST-13;
  322.   LVN_ODFINDITEMA              = LVN_FIRST-52;
  323.   LVN_ODFINDITEMW              = LVN_FIRST-79;
  324.   LVN_ODFINDITEM               = LVN_ODFINDITEMA;
  325. {$ENDIF}
  326.  
  327. {$IFNDEF DFS_C3D4COMMCTRL}
  328. const
  329.   LVN_ITEMACTIVATE             = LVN_FIRST-14;
  330.   LVN_ODSTATECHANGED           = LVN_FIRST-15;
  331.   LVN_MARQUEEBEGIN             = LVN_FIRST-56;
  332. {$ENDIF}
  333.  
  334. {$IFNDEF DFS_COMPILER_3_UP}
  335. type
  336.   PNMCacheHint = ^TNMCacheHint;
  337.   TNMCacheHint = packed record
  338.     hdr:       TNMHDR;
  339.     iFrom:     integer;
  340.     iTo:       integer;
  341.   end;
  342.  
  343.   PNMFindItem = ^TNMFindItem;
  344.   TNMFindItem = packed record
  345.     hdr:       TNMHDR;
  346.     iStart:    integer;
  347.     lvif:      TLVFindInfo;
  348.   end;
  349. {$ENDIF}
  350.  
  351. type
  352.   PNMODStateChange = ^TNMODStateChange;
  353.   TNMODStateChange = packed record
  354.     hdr:       TNMHDR;
  355.     iFrom:     integer;
  356.     iTo:       integer;
  357.     uNewState: UINT;
  358.     uOldState: UINT;
  359.   end;
  360.  
  361.  
  362. {$IFNDEF DFS_C3D4COMMCTRL}
  363. const
  364.   LVM_GETSELECTIONMARK = (LVM_FIRST + 66);
  365.  
  366. function ListView_GetSelectionMark(LVWnd: HWnd): integer;
  367.  
  368. const
  369.   LVM_SETSELECTIONMARK = (LVM_FIRST + 67);
  370.  
  371. function ListView_SetSelectionMark(LVWnd: HWnd; iIndex: integer): integer;
  372.  
  373. const
  374.   LVM_SETHOVERTIME = (LVM_FIRST + 71);
  375.  
  376. function ListView_SetHoverTime(LVWnd: HWnd; dwHoverTimeMS: DWORD): DWORD;
  377.  
  378. const
  379.   LVM_GETHOVERTIME = (LVM_FIRST + 72);
  380.  
  381. function ListView_GetHoverTime(LVWnd: HWnd): DWORD;
  382.  
  383. const
  384.   LVM_SETTOOLTIPS = (LVM_FIRST + 74);
  385.  
  386. function ListView_SetToolTips(LVWnd, NewWnd: HWnd): HWnd;
  387.  
  388. const
  389.   LVM_GETTOOLTIPS = (LVM_FIRST + 78);
  390.  
  391. function ListView_GetToolTips(LVWnd: HWnd): HWnd;
  392. {$ENDIF}
  393.  
  394. type
  395.   PLVBkImageA = ^TLVBkImageA;
  396.   TLVBkImageA = packed record
  397.     ulFlags: ULONG;              // LVBKIF_*
  398.     hbm: HBITMAP;
  399.     pszImage: PChar;
  400.     cchImageMax: UINT;
  401.     xOffsetPercent: integer;
  402.     yOffsetPercent: integer;
  403.   end;
  404.  
  405.   PLVBkImageW = ^TLVBkImageW;
  406.   TLVBkImageW = packed record
  407.     ulFlags: ULONG;              // LVBKIF_*
  408.     hbm: HBITMAP;
  409.     pszImage: PWideChar;
  410.     cchImageMax: UINT;
  411.     xOffsetPercent: integer;
  412.     yOffsetPercent: integer;
  413.   end;
  414.  
  415.   PLVBkImage = PLVBkImageA;
  416.   TLVBkImage = TLVBkImageA;
  417.  
  418. {$IFNDEF DFS_C3D4COMMCTRL}
  419. const
  420.   LVBKIF_SOURCE_NONE      = $00000000;
  421.   LVBKIF_SOURCE_HBITMAP   = $00000001;
  422.   LVBKIF_SOURCE_URL       = $00000002;
  423.   LVBKIF_SOURCE_MASK      = $00000003;
  424.   LVBKIF_STYLE_NORMAL     = $00000000;
  425.   LVBKIF_STYLE_TILE       = $00000010;
  426.   LVBKIF_STYLE_MASK       = $00000010;
  427.  
  428.   LVM_SETBKIMAGEA         = (LVM_FIRST + 68);
  429.   LVM_SETBKIMAGEW         = (LVM_FIRST + 138);
  430.   LVM_GETBKIMAGEA         = (LVM_FIRST + 69);
  431.   LVM_GETBKIMAGEW         = (LVM_FIRST + 139);
  432.  
  433. const
  434.   LVM_SETBKIMAGE          = LVM_SETBKIMAGEA;
  435.  
  436. function ListView_SetBkImage(LVWnd: HWnd; plvbki: PLVBkImage): BOOL;
  437.  
  438. const
  439.   LVM_GETBKIMAGE          = LVM_GETBKIMAGEA;
  440.  
  441. function ListView_GetBkImage(LVWnd: HWnd; plvbki: PLVBkImage): BOOL;
  442.  
  443. const
  444.   LVN_HOTTRACK            = (LVN_FIRST-21);
  445. {$ENDIF}
  446.  
  447. type
  448.   PNMLVGetInfoTipA = ^TNMLVGetInfoTipA;
  449.   TNMLVGetInfoTipA = packed record
  450.     hdr: TNMHDR;
  451.     dwFlags: DWORD;
  452.     pszText: PChar;
  453.     cchTextMax: integer;
  454.     iItem: integer;
  455.     iSubItem: integer;
  456.     lParam: LPARAM;
  457.   end;
  458.  
  459.   PNMLVGetInfoTipW = ^TNMLVGetInfoTipW;
  460.   TNMLVGetInfoTipW = packed record
  461.     hdr: TNMHDR;
  462.     dwFlags: DWORD;
  463.     pszText: PWideChar;
  464.     cchTextMax: integer;
  465.     iItem: integer;
  466.     iSubItem: integer;
  467.     lParam: LPARAM;
  468.   end;
  469.  
  470.   PNMLVGetInfoTip = PNMLVGetInfoTipA;
  471.   TNMLVGetInfoTip = TNMLVGetInfoTipA;
  472.                           
  473. {$IFNDEF DFS_C3D4COMMCTRL}
  474. // NMLVGETINFOTIPA.dwFlag values
  475. const
  476.   LVGIT_UNFOLDED          = $0001;
  477.  
  478.   LVN_GETINFOTIPA         = (LVN_FIRST-57);
  479.   LVN_GETINFOTIPW         = (LVN_FIRST-58);
  480.   LVN_GETINFOTIP          = LVN_GETINFOTIPA;
  481. {$ENDIF}
  482.  
  483. type
  484.   EELVException = class(Exception);
  485.   EELVOldComCtl = class(EELVException);
  486.  
  487.   // New extended style flags converted to set format (RPM = Report Mode Only).
  488.   //  lvxGridlines: Adds grid lines to seperate items and columns. RPM
  489.   //  lvxSubItemImages: Allows images to be displayed for subitems. RPM
  490.   //  lvxCheckboxes: Adds checkboxes to items.  Checked items are stored
  491.   //      internally as selected items.
  492.   //  lvxTrackSelect: Tracks the mouse and highlights the item it currently
  493.   //      positioned over by changing it's color.  If mouse is left over an
  494.   //      item for a brief period of time, it will be automatically selected.
  495.   //  lvxHeaderDragDrop: Allows headers to be dragged to new positions and
  496.   //      dropped, allowing users to reorder column information.
  497.   //  lvxFullRowSelect: Allows user to click anywhere on an item to select it,
  498.   //      highlighting the entire length of the item.  Without this style,
  499.   //      users must click inside the text of column 0.  It is only useful in
  500.   //      vsReport view style.
  501.   //  lvxOneClickActivate: Sends an LVN_ITEMACTIVATE notification message to
  502.   //      the parent when the user clicks an item.
  503.   //  lvxTwoClickActivate: Sends an LVN_ITEMACTIVATE notification message to
  504.   //      the parent when the user double clicks an item.
  505.   //  lvxFlatScrollBar: Enables flat scroll bars in the list view.
  506.   //  lvxInfoTip: Enables the OnInfoTip event that allows notification and/or
  507.   //      modification of a tooltip before it is displayed.  Only allowed for
  508.   //      vsIcon ViewStyle.
  509.   //  lvxUnderlineHot: Causes hot items to be displayed with underlined text.
  510.   //      This style is ignored if lvxOneClickActivate or lvxTwoClickActivate
  511.   //      is not set.
  512.   //  lvxUnderlineCold: Causes nonhot items to be displayed with underlined
  513.   //      text. This style is ignored if lvxOneClickActivate is not set.
  514.   TLVExtendedStyle = (lvxGridLines, lvxSubItemImages, lvxCheckboxes,
  515.      lvxTrackSelect, lvxHeaderDragDrop, lvxFullRowSelect, lvxOneClickActivate,
  516.      lvxTwoClickActivate, lvxFlatScrollBar,
  517.      {$IFDEF DFS_TRY_INFOTIP} lvxInfoTip, {$ENDIF}
  518.      lvxUnderlineHot, lvxUnderlineCold);
  519.  
  520.   // A set of the new style bits.
  521.   TLVExtendedStyles = set of TLVExtendedStyle;
  522.  
  523.   TLVItemCountFlag = (lvsicfNoInvalidateAll, lvsicfNoScroll);
  524.   TLVItemCountFlags = set of TLVItemCountFlag;
  525.  
  526.   TLVVMMaskItem = (lvifText, lvifImage, lvifParam, lvifState, lvifIndent);
  527.   TLVVMMaskItems = set of TLVVMMaskItem;
  528.  
  529.   TColumnImageAlign = (ciaLeftOfText, ciaRightOfText);
  530.  
  531.   TLVMarqueeBeginEvent = procedure(Sender: TObject;
  532.      var CanBegin: boolean) of object;
  533.   TLVItemActivateEvent = TNotifyEvent;
  534.   TLVInfoTipEvent = procedure(Sender: TObject; ItemIndex: integer;
  535.      Current: string; var Additional: string) of object;
  536.   TLVHotTrackEvent = procedure(Sender: TObject; var ItemIndex: integer;
  537.      SubItemIndex: integer; Location: TPoint;
  538.      var AllowSelect: boolean) of object;
  539.   TLVVMGetItemInfoEvent = procedure(Sender: TObject; Item, SubItem: integer;
  540.      Mask: TLVVMMaskItems; var Image: integer; var Param: LPARAM;
  541.      var State: UINT; var Indent: integer; var Text: string) of object;
  542.   TLVVMCacheHintEvent = procedure(Sender: TObject;
  543.      var HintInfo: TNMCacheHint) of object;
  544.   TLVVMFindItemEvent = procedure(Sender: TObject; var FindInfo: TNMFindItem;
  545.      var Found: integer) of object;
  546.   TLVVMStateChangedEvent = procedure(Sender: TObject;
  547.      var StateInfo: TNMODStateChange) of object;
  548.  
  549.  
  550.   TExtListView = class; { forward declaration }
  551.  
  552.  
  553.   // Class for BackgroundImage property
  554.   TELVBackgroundImage = class(TPersistent)
  555.   private
  556.     FOwningListView: TExtListView;
  557.     FFilename: string;
  558.     FTile: boolean;
  559.     FXOffsetPercent: integer;
  560.     FYOffsetPercent: integer;
  561.   protected
  562.     procedure SetFilename(const Val: string);
  563.     procedure SetTile(Val: boolean);
  564.     procedure SetXOffsetPercent(Val: integer);
  565.     procedure SetYOffsetPercent(Val: integer);
  566.  
  567.     procedure ApplyToListView; virtual;
  568.   public
  569.     constructor Create(AOwner: TExtListView); virtual;
  570.     procedure Assign(Source: TPersistent); override;
  571.   published
  572.     property Filename: string
  573.        read FFilename
  574.        write SetFilename;
  575.     property Tile: boolean
  576.        read FTile
  577.        write SetTile
  578.        default FALSE;
  579.     property XOffsetPercent: integer
  580.        read FXOffsetPercent
  581.        write SetXOffsetPercent
  582.        default 0;
  583.     property YOffsetPercent: integer
  584.        read FYOffsetPercent
  585.        write SetYOffsetPercent
  586.        default 0;
  587.   end;
  588.  
  589.  
  590.   // Class for saved settings
  591.   TExtLVSaveSettings = class(TEnhLVSaveSettings)
  592.   private
  593.     FSaveColumnOrder: boolean;
  594.   public
  595.     constructor Create; override;
  596.     procedure StoreColumnOrder(ColCount: integer;
  597.        const IntArray: array of integer);
  598.     procedure ReadColumnOrder(ColCount: integer;
  599.        var IntArray: array of integer);
  600.   published
  601.     property SaveColumnOrder: boolean
  602.        read FSaveColumnOrder
  603.        write FSaveColumnOrder
  604.        default TRUE;
  605.   end;
  606.  
  607.   
  608.   TExtListColumn = class(TCollectionItem)
  609.   private
  610.     FSmallImageIndex: Integer;
  611.     FImageAlignment : TColumnImageAlign;
  612.     procedure DoChange;
  613.     procedure SetSmallImageIndex(Value: Integer);
  614.     procedure SetImageAlignment(Value: TColumnImageAlign);
  615.   public
  616.     constructor Create(Collection: TCollection); override;
  617.     destructor Destroy; override;
  618.     procedure Assign(Source: TPersistent); override;
  619.   published
  620.     property ImageIndex: integer
  621.        read FSmallImageIndex
  622.        write SetSmallImageIndex
  623.        default -1;
  624.     property ImageAlignment: TColumnImageAlign
  625.        read FImageAlignment
  626.        write SetImageAlignment
  627.        default ciaRightOfText;
  628.   end;
  629.  
  630.   TExtListColumns = class(TCollection)
  631.   private
  632.     FOwner: TExtListView;
  633.     function GetItem(Index: Integer): TExtListColumn;
  634.     procedure SetItem(Index: Integer; Value: TExtListColumn);
  635.   protected
  636.     function GetOwner: TPersistent; {$IFDEF DFS_COMPILER_3_UP} override; {$ENDIF}
  637.     procedure Update(Item: TCollectionItem); override;
  638.   public
  639.     constructor Create(AOwner: TExtListView);
  640.     procedure Assign(Source: TPersistent); override;
  641.     function Add: TExtListColumn;
  642.     procedure Refresh;
  643.     property Owner: TExtListView
  644.        read FOwner;
  645.     property Items[Index: Integer]: TExtListColumn
  646.        read GetItem
  647.        write SetItem;
  648.        default;
  649.   end;
  650.  
  651.   // The new class.
  652.   TExtListView = class(TCustomEnhListView)
  653.   private
  654.     FExtendedStyles: TLVExtendedStyles;
  655.     FColumnOrder: PIntArray;
  656.     FColumnOrderCount: integer;
  657.     FColumnsFormat: TExtListColumns;
  658.     FVirtualMode: boolean;
  659.     FSaveSettings: TExtLVSaveSettings;
  660.     FColumnsFormatChangeLink: TChangeLink;
  661.     FSelectionMark: integer;
  662.     FHoverTime: DWORD;
  663.     FRequireComCtlUpdate: boolean;
  664. {$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  665.     FBackgroundImage: TELVBackgroundImage;
  666. {$ENDIF}
  667.     FItemCountEx: integer;
  668.     FItemCountExFlags: TLVItemCountFlags;
  669.  
  670.     FOnMarqueeBegin: TLVMarqueeBeginEvent;
  671.     FOnItemActivate: TLVItemActivateEvent;
  672.     FOnHotTrack: TLVHotTrackEvent;
  673. {$IFDEF DFS_TRY_INFOTIP}
  674.     FOnInfoTip: TLVInfoTipEvent;
  675. {$ENDIF}
  676.     FOnVMGetItemInfo: TLVVMGetItemInfoEvent;
  677.     FOnVMCacheHint: TLVVMCacheHintEvent;
  678.     FOnVMFindItem: TLVVMFindItemEvent;
  679.     FOnVMStateChanged: TLVVMStateChangedEvent;
  680.  
  681.     // Function to convert from our set type to expected API value.
  682.     function SetValueToAPIValue(Styles: TLVExtendedStyles): LPARAM;
  683.     function SetValueFromAPIValue(Styles: DWORD): TLVExtendedStyles;
  684.  
  685.     procedure ColumnHeaderImagesChange(Sender: TObject);
  686.  
  687.     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  688.     procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
  689.     function GetItemIndent(Index: integer): Integer;
  690.     procedure SetItemIndent(Index: integer; Value: Integer);
  691.   protected
  692.     // Property method for setting styles.
  693.     procedure SetExtendedStyles(Val: TLVExtendedStyles);
  694.     function GetExtendedStyles: TLVExtendedStyles;
  695.     function GetHeaderHandle: HWnd;
  696.     function GetSubItemRect(Item, SubItem: integer; Index: integer): TRect;
  697.     procedure SetHotItem(Val: integer);
  698.     function GetHotItem: integer;
  699.     procedure SetHotCursor(const Val: HCursor);
  700.     function GetHotCursor: HCursor;
  701.     procedure SetWorkArea(Rect: TRect);
  702.     procedure SetCheckState(Index: integer; Checked: boolean);
  703.     function GetCheckState(Index: integer): boolean;
  704.     procedure SetVirtualMode(Val: boolean);
  705.     procedure SetColumnsFormat(Value: TExtListColumns);
  706.     function GetSubItemImageIndex(Item, SubItem: integer): integer;
  707.     procedure SetSubItemImageIndex(Item, SubItem, Value: integer);
  708.     function GetSelectionMark: integer;
  709.     procedure SetSelectionMark(Val: integer);
  710.     function GetHoverTime: DWORD;
  711.     procedure SetHoverTime(Val: DWORD);
  712.     procedure SetRequireComCtlUpdate(Value: boolean);
  713. {$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  714.     procedure SetBackgroundImage(Value: TELVBackgroundImage);
  715. {$ENDIF}
  716.     function GetSmallImages: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList; {$ELSE} TImageList; {$ENDIF}
  717.     procedure SetSmallImages(Value: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList {$ELSE} TImageList {$ENDIF});
  718.     function GetShowSortArrows: boolean;
  719.     procedure SetShowSortArrows(Value: boolean);
  720.     function GetVersion: TDFSVersion; override;
  721.     function GetSubItemText(Index, SubItem: integer): string; override;
  722.     function ActualColumnIndex(Index: integer): integer; override;
  723.     function GetActualColumn(Index: integer): TListColumn; override;
  724.     procedure DrawItem(var Canvas: TCanvas; Index: Integer; Rect: TRect;
  725.        State: TOwnerDrawState; var DefaultDrawing,
  726.        FullRowSelect: boolean); override;
  727.     procedure DefaultDrawHeader(var Canvas: TCanvas; Index: Integer;
  728.        var Rect: TRect; Selected: boolean); override;
  729.     procedure CreateParams(var Params: TCreateParams); override;
  730.     procedure CreateWnd; override;
  731.     procedure Loaded; override;
  732.     // Event method handlers -- fire the events if they exist.
  733.     function MarqueeBegin: boolean; virtual;
  734.     procedure ItemActivate; virtual;
  735.     function HotTrack(var Item: TNMListView): boolean; virtual;
  736. {$IFDEF DFS_TRY_INFOTIP}
  737.     procedure GetInfoTip(InfoTip: PNMLVGetInfoTip); virtual;
  738. {$ENDIF}    
  739.  
  740.     procedure VMGetDispInfo(var ItemInfo: TLVItemEx); virtual;
  741.     procedure VMCacheHint(var HintInfo: TNMCacheHint); virtual;
  742.     function VMFindItem(var FindInfo: TNMFindItem): integer; virtual;
  743.     procedure VMStateChanged(var StateInfo: TNMODStateChange); virtual;
  744.   public
  745.     constructor Create(AOwner: TComponent); override;
  746.     destructor Destroy; override;
  747.  
  748.     //Michael Haller:
  749.     procedure WriteSettingsToIniFile(Value: String; IniFile: TIniFile);
  750.     procedure ReadSettingsFromIniFile(Value: String; IniFile: TIniFile);
  751.  
  752.     // Force reset of column image information
  753.     procedure UpdateColumnsImages;
  754.     procedure UpdateColumnImage(Index: integer);
  755.  
  756.     procedure SetIconSpacing(X, Y: integer);
  757.     function GetSubItemAt(X, Y: integer): string;
  758.     procedure SetColumnOrder(Count: integer; const IntArray: array of integer);
  759.     function GetColumnOrder(Count: integer;
  760.        var IntArray: array of integer): boolean;
  761.     function ApproximateViewRect(Count: integer;
  762.        const Proposed: TPoint): TPoint;
  763.     procedure SetItemCountEx(Count: integer; Flags: TLVItemCountFlags);
  764.     function StoreSettings: boolean; override;
  765.     function LoadSettings: boolean; override;
  766.     function CheckComCtlVersion(MajorHi, MajorLo,
  767.        MinorHi, MinorLo: word): boolean;
  768.  
  769.     function ELV_GetNextItem(StartItem: integer; Direction: TSearchDirection;
  770.        States: TItemStates): integer;
  771.  
  772.     property LastColumnClicked;
  773.     property CurrentColumnWidth;
  774.     property HeaderHandle: HWnd
  775.        read GetHeaderHandle;
  776.     property SubItem_BoundsRect[Item: integer; SubItem: integer]: TRect
  777.        index LVIR_BOUNDS
  778.        read GetSubItemRect;
  779.     property SubItem_IconRect[Item: integer; SubItem: integer]: TRect
  780.        index LVIR_ICON
  781.        read GetSubItemRect;
  782.     property SubItem_LabelRect[Item: integer; SubItem: integer]: TRect
  783.        index LVIR_LABEL
  784.        read GetSubItemRect;
  785.     property SubItem_SelectBoundsRect[Item: integer; SubItem: integer]: TRect
  786.        index LVIR_SELECTBOUNDS
  787.        read GetSubItemRect;
  788.     property HotItem: integer
  789.        read GetHotItem
  790.        write SetHotItem;
  791.     property HotCursor: HCursor
  792.        read GetHotCursor
  793.        write SetHotCursor;
  794.     property WorkArea: TRect
  795.        write SetWorkArea;
  796.     property IsChecked[Index: integer]: boolean
  797.        read GetCheckState write SetCheckState;
  798.     property SubItem_ImageIndex[Item: integer; SubItem: integer]: integer
  799.        read GetSubItemImageIndex
  800.        write SetSubItemImageIndex;
  801.     property SelectionMark: integer
  802.        read GetSelectionMark
  803.        write SetSelectionMark;
  804.     property ItemIndent[Index: integer]: integer
  805.        read GetItemIndent write SetItemIndent;
  806.  
  807.     property CurrentSortAscending;
  808.   published
  809.     property Columns;
  810.     property HideSelection;
  811.  
  812.     // Property for new styles.
  813.     property ExtendedStyles: TLVExtendedStyles
  814.        read GetExtendedStyles
  815.        write SetExtendedStyles
  816.        default [];
  817.     property VirtualMode: boolean
  818.        read FVirtualMode
  819.        write SetVirtualMode
  820.        default FALSE;
  821.     property HoverTime: DWORD
  822.        read GetHoverTime
  823.        write SetHoverTime
  824.        default $FFFFFFFF;
  825.     property RequireComCtlUpdate: boolean
  826.        read FRequireComCtlUpdate
  827.        write SetRequireComCtlUpdate
  828.        default FALSE;
  829. {$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  830.     property BackgroundImage: TELVBackgroundImage
  831.        read FBackgroundImage
  832.        write SetBackgroundImage;
  833. {$ENDIF}
  834.  
  835.     // Autosave settings property.
  836.     property SaveSettings: TExtLVSaveSettings
  837.        read FSaveSettings
  838.        write FSaveSettings;
  839.  
  840.     property ColumnsFormat: TExtListColumns
  841.        read FColumnsFormat
  842.        write SetColumnsFormat;
  843.  
  844.     // Events
  845.     property OnMarqueeBegin: TLVMarqueeBeginEvent
  846.        read FOnMarqueeBegin
  847.        write FOnMarqueeBegin;
  848.     property OnItemActivate: TLVItemActivateEvent
  849.        read FOnItemActivate
  850.        write FOnItemActivate;
  851.     property OnHotTrack: TLVHotTrackEvent
  852.        read FOnHotTrack
  853.        write FOnHotTrack;
  854. {$IFDEF DFS_TRY_INFOTIP}
  855.     property OnInfoTip: TLVInfoTipEvent
  856.        read FOnInfoTip
  857.        write FOnInfoTip;
  858. {$ENDIF}
  859.     property OnVMGetItemInfo: TLVVMGetItemInfoEvent
  860.        read FOnVMGetItemInfo
  861.        write FOnVMGetItemInfo;
  862.     property OnVMCacheHint: TLVVMCacheHintEvent
  863.        read FOnVMCacheHint
  864.        write FOnVMCacheHint;
  865.     property OnVMFindItem: TLVVMFindItemEvent
  866.        read FOnVMFindItem
  867.        write FOnVMFindItem;
  868.     property OnVMStateChanged: TLVVMStateChangedEvent
  869.        read FOnVMStateChanged
  870.        write FOnVMStateChanged;
  871.  
  872.     // Redeclare so we can know when it changes and hook into it.
  873.     property SmallImages: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList {$ELSE} TImageList {$ENDIF}
  874.        read GetSmallImages
  875.        write SetSmallImages;
  876.     property ShowSortArrows: boolean
  877.        read GetShowSortArrows
  878.        write SetShowSortArrows
  879.        stored TRUE
  880.        default FALSE;
  881.  
  882.     // Publish inherited protected properties
  883.     property AutoColumnSort;
  884.     property AutoSortStyle;
  885.     property AutoResort;
  886.     property AutoSortAscending;
  887.     property ReverseSortArrows;
  888.     property Style;
  889.  
  890.     property OnDrawHeader;
  891.     property OnMeasureItem;
  892.     property OnDrawItem;
  893.     property OnDrawSubItem;
  894.     property OnAfterDefaultDrawItem;
  895.     property OnSortItems;
  896.     property OnSortBegin;
  897.     property OnSortFinished;
  898.     property OnEditCanceled;
  899.  
  900.  
  901.     property Align;
  902.     property BorderStyle;
  903.     property Color;
  904.     property ColumnClick;
  905.     property OnClick;
  906.     property OnDblClick;
  907.     property Ctl3D;
  908.     property DragMode;
  909.     property ReadOnly
  910.        default False;
  911.     property Enabled;
  912.     property Font;
  913.     property IconOptions;
  914.     property Items;
  915.     property AllocBy;
  916.     property MultiSelect;
  917.     property OnChange;
  918.     property OnChanging;
  919.     property OnColumnClick;
  920.     property OnDeletion;
  921.     property OnEdited;
  922.     property OnEditing;
  923.     property OnEnter;
  924.     property OnExit;
  925.     property OnInsert;
  926.     property OnDragDrop;
  927.     property OnDragOver;
  928.     property DragCursor;
  929.     property OnStartDrag;
  930.     property OnEndDrag;
  931.     property OnMouseDown;
  932.     property OnMouseMove;
  933.     property OnMouseUp;
  934.     property ParentColor
  935.        default False;
  936.     property ParentFont;
  937.     property ParentShowHint;
  938.     property ShowHint;
  939.     property PopupMenu;
  940.     property ShowColumnHeaders;
  941.     property TabOrder;
  942.     property TabStop
  943.        default True;
  944.     property ViewStyle;
  945.     property Visible;
  946.     property OnKeyDown;
  947.     property OnKeyPress;
  948.     property OnKeyUp;
  949.     property LargeImages;
  950.     property StateImages;
  951.   end;
  952.  
  953.  
  954. { You may find this function useful in install programs and such.  Example of
  955.   usage is:
  956.      if not CheckDLLVersion('COMCTL32.DLL', 4, 70, 0, 0) then ....
  957.   which returns TRUE if COMCTL32.DLL is version 4.70.0.0 or higher. }
  958. function CheckDLLVersion(const DLLName: string; MajorHi, MajorLo,
  959.    MinorHi, MinorLo: word): boolean;
  960.  
  961.  
  962. implementation
  963.  
  964. uses
  965. {$IFDEF DFS_COMPILER_3_UP}
  966.   ActiveX,
  967. {$ELSE}
  968.   OLE2, ExtColEd,
  969. {$ENDIF}
  970.   Registry;
  971.  
  972. procedure TExtListView.WriteSettingsToIniFile(Value: String; IniFile: TIniFile);
  973. var
  974.   x: integer;
  975.   s: string;
  976. begin
  977.   //Don't save the size of the first column
  978.   if Columns.Count < 1 then Exit;
  979.   for x := 1 to Columns.Count-1 do
  980.     s := s + IntToStr(ActualColumn[x].Width) + ',';
  981.   SetLength(s, Length(s)-1);
  982.   IniFile.WriteString(Value, 'ColumnSizes', s);
  983.   //sorting
  984.   IniFile.WriteBool(Value, 'Sort', CurrentSortAscending);
  985.   IniFile.WriteInteger(Value, 'SortCol', LastColumnClicked);
  986. end;
  987.  
  988.  
  989. procedure TExtlistView.ReadSettingsFromIniFile(Value: String; IniFile: TIniFile);
  990. var
  991.   x,y: integer;
  992.   s: string;
  993. begin
  994.   //Don't change the size of the first column
  995.   if Columns.Count < 1 then Exit;
  996.   s := IniFile.ReadString(Value, 'ColumnSizes', '');
  997.   if s = '' then Exit;
  998.   y := 0;
  999.   for x := 1 to Columns.Count-1 do begin
  1000.     try
  1001.       y := Pos(',', s);
  1002.       if y = 0 then y := Length(s)+1;
  1003.       ActualColumn[x].Width := StrToInt(Copy(s, 1, y-1));
  1004.     except
  1005.       ActualColumn[x].Width := 0;
  1006.     end;
  1007.     s := copy(s, y+1, length(s));
  1008.     if s = '' then break;
  1009.   end;
  1010.   //sorting
  1011.   try
  1012.     CurrentSortAscending := IniFile.ReadBool(Value, 'Sort', TRUE);
  1013.     LastColumnClicked := IniFile.ReadInteger(Value, 'SortCol', 0);
  1014.     if LastColumnClicked >= Columns.Count then LastColumnClicked := Columns.Count-1;
  1015.     if LastColumnClicked < 0 then LastColumnClicked := 0;
  1016.     BeginUpdate;
  1017.     Resort;
  1018.     EndUpdate;
  1019.   except
  1020.     EndUpdate;
  1021.   end;
  1022. end;
  1023.  
  1024.  
  1025. function ListView_GetColumnEx(LVWnd: HWND; iCol: Integer;
  1026.    var pcol: TLVColumnEx): bool;
  1027. begin
  1028.   Result := bool(SendMessage(LVWnd, LVM_GETCOLUMN, iCol, LPARAM(@pcol)));
  1029. end;
  1030.  
  1031. function ListView_SetColumnEx(LVWnd: HWnd; iCol: Integer;
  1032.    const pcol: TLVColumnEx): Bool;
  1033. begin
  1034.   Result := bool(SendMessage(LVWnd, LVM_SETCOLUMN, iCol, Longint(@pcol)));
  1035. end;
  1036.  
  1037. function ListView_InsertColumnEx(LVWnd: HWND; iCol: Integer;
  1038.                                  const pcol: TLVColumnEx): Integer;
  1039. begin
  1040.   Result := SendMessage(LVWnd, LVM_INSERTCOLUMN, iCol, Longint(@pcol));
  1041. end;
  1042.  
  1043. function ListView_GetHeader(LVWnd: HWnd): HWnd;
  1044. begin
  1045.   Result := HWnd(SendMessage(LVWnd, LVM_GETHEADER, 0, 0));
  1046. end;
  1047.  
  1048. function ListView_SetIconSpacing(LVWnd: HWnd; cx, cy: integer): DWORD;
  1049. begin
  1050.   Result := SendMessage(LVWnd, LVM_SETICONSPACING, 0, MAKELONG(cx,cy));
  1051. end;
  1052.  
  1053. function ListView_SetExtendedListViewStyle(LVWnd: HWnd; ExStyle: LPARAM): DWORD;
  1054. begin
  1055.   Result := SendMessage(LVWnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, ExStyle);
  1056. end;
  1057.  
  1058. function ListView_GetExtendedListViewStyle(LVWnd: HWnd): DWORD;
  1059. begin
  1060.   Result := SendMessage(LVWnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0);
  1061. end;
  1062.  
  1063. function ListView_GetSubItemRect(LVWnd: HWnd; ParentItem, SubItem,
  1064.    Code: integer; var Rect: TRect): boolean;
  1065. begin
  1066.   Rect.Top := SubItem;
  1067.   Rect.Left := Code;
  1068.   Result := (SendMessage(LVWnd, LVM_GETSUBITEMRECT, ParentItem,
  1069.      LPARAM(@Rect)) <> 0);
  1070. end;
  1071.  
  1072. {$IFNDEF DFS_C3D4COMMCTRL}
  1073.   // C3 & D4 users don't need this because their COMMCTRL.PAS file has it right
  1074.   // and they can simply use the existing TLVHitTestInfo and
  1075.   // ListView_SubItemHitTest
  1076. function ListView_SubItemHitTestEx(LVWnd: HWnd;
  1077.    var HitTestInfo: TLVHitTestInfoEx): integer;
  1078. begin
  1079.   Result := SendMessage(LVWnd, LVM_SUBITEMHITTEST, 0, LPARAM(@HitTestInfo));
  1080. end;
  1081. {$ENDIF}
  1082.  
  1083. function ListView_SetColumnOrderArray(LVWnd: HWnd; Count: integer;
  1084.                                       IntArray: PIntArray): boolean;
  1085. begin
  1086.   Result := (SendMessage(LVWnd, LVM_SETCOLUMNORDERARRAY, Count,
  1087.      LPARAM(IntArray)) <> 0);
  1088. end;
  1089.  
  1090. function ListView_GetColumnOrderArray(LVWnd: HWnd; Count: integer;
  1091.                                       IntArray: PIntArray): boolean;
  1092. begin
  1093.   Result := (SendMessage(LVWnd, LVM_GETCOLUMNORDERARRAY, Count,
  1094.      LPARAM(IntArray)) <> 0);
  1095. end;
  1096.  
  1097. function ListView_SetHotItem(LVWnd: HWnd; Item: integer): integer;
  1098. begin
  1099.   Result := SendMessage(LVWnd, LVM_SETHOTITEM, Item, 0);
  1100. end;
  1101.  
  1102. function ListView_GetHotItem(LVWnd: HWnd): integer;
  1103. begin
  1104.   Result := SendMessage(LVWnd, LVM_GETHOTITEM, 0, 0);
  1105. end;
  1106.  
  1107. function ListView_SetHotCursor(LVWnd: HWnd; Cursor: HCursor): HCursor;
  1108. begin
  1109.   Result := HCursor(SendMessage(LVWnd, LVM_SETHOTCURSOR, 0, LPARAM(Cursor)));
  1110. end;
  1111.  
  1112. function ListView_GetHotCursor(LVWnd: HWnd): HCursor;
  1113. begin
  1114.   Result := HCursor(SendMessage(LVWnd, LVM_GETHOTCURSOR, 0, 0));
  1115. end;
  1116.  
  1117. function ListView_ApproximateViewRect(LVWnd: HWnd; Width, Height,
  1118.    Count: integer): DWORD;
  1119. begin
  1120.   Result := SendMessage(LVWnd, LVM_APPROXIMATEVIEWRECT, Count,
  1121.      MAKELPARAM(Width, Height));
  1122. end;
  1123.  
  1124. function ListView_SetWorkArea(LVWnd: HWnd; const Rect: TRect): boolean;
  1125. begin
  1126.   Result := (SendMessage(LVWnd, LVM_SETWORKAREA, 0, LPARAM(@Rect)) <> 0);
  1127. end;
  1128.  
  1129. function ListView_GetCheckState(LVWnd: HWnd; Index: UINT): boolean;
  1130. begin
  1131.   Result := (SendMessage(LVWnd, LVM_GETITEMSTATE, Index,
  1132.      LVIS_STATEIMAGEMASK) SHR 12)-1 <> 0;
  1133. end;
  1134.  
  1135. procedure ListView_SetCheckState(LVWnd: HWnd; Index: UINT; Checked: boolean);
  1136. const
  1137.   LVIS_UNCHECKED = $1000;
  1138.   LVIS_CHECKED = $2000;
  1139. var
  1140.   Data: integer;
  1141. begin
  1142.   if Checked then Data := LVIS_CHECKED
  1143.   else Data := LVIS_UNCHECKED;
  1144.   ListView_SetItemState(LVWnd, Index, Data, LVIS_STATEIMAGEMASK);
  1145. end;
  1146.  
  1147. procedure ListView_SetItemCountEx(LVWnd: HWnd; Items: integer; Flags: DWORD);
  1148. begin
  1149.   SendMessage(LVWnd, LVM_SETITEMCOUNT, Items, Flags);
  1150. end;
  1151.  
  1152. {$IFNDEF DFS_C3D4COMMCTRL}
  1153. function ListView_SetExtendedListViewStyleEx(LVWnd: HWnd; Mask: DWord;
  1154.    ExStyle: LPARAM): DWORD;
  1155. begin
  1156.   Result := SendMessage(LVWnd, LVM_SETEXTENDEDLISTVIEWSTYLE, Mask, ExStyle);
  1157. end;
  1158. {$ENDIF}
  1159.  
  1160. function ListView_GetSelectionMark(LVWnd: HWnd): integer;
  1161. begin
  1162.   Result := SendMessage(LVWnd, LVM_GETSELECTIONMARK, 0, 0);
  1163. end;
  1164.  
  1165. function ListView_SetSelectionMark(LVWnd: HWnd; iIndex: integer): integer;
  1166. begin
  1167.   Result := SendMessage(LVWnd, LVM_SETSELECTIONMARK, 0, iIndex);
  1168. end;
  1169.  
  1170. {$IFNDEF DFS_C3D4COMMCTRL}
  1171. function ListView_SetHoverTime(LVWnd: HWnd; dwHoverTimeMS: DWORD): DWORD;
  1172. begin
  1173.   Result := SendMessage(LVWnd, LVM_SETHOVERTIME, 0, dwHoverTimeMs);
  1174. end;
  1175.  
  1176. function ListView_GetHoverTime(LVWnd: HWnd): DWORD;
  1177. begin
  1178.   Result := DWORD(SendMessage(LVWnd, LVM_GETHOVERTIME, 0, 0));
  1179. end;
  1180.  
  1181. function ListView_SetToolTips(LVWnd, NewWnd: HWnd): HWnd;
  1182. begin
  1183.   Result := SendMessage(LVWnd, LVM_SETTOOLTIPS, NewWnd, 0);
  1184. end;
  1185.  
  1186. function ListView_GetToolTips(LVWnd: HWnd): HWnd;
  1187. begin
  1188.   Result := SendMessage(LVWnd, LVM_GETTOOLTIPS, 0, 0);
  1189. end;
  1190.  
  1191. function ListView_SetBkImage(LVWnd: HWnd; plvbki: PLVBkImage): BOOL;
  1192. begin
  1193.   Result := (SendMessage(LVWnd, LVM_SETBKIMAGE, 0, LPARAM(plvbki)) <> 0);
  1194. end;
  1195.  
  1196. function ListView_GetBkImage(LVWnd: HWnd; plvbki: PLVBkImage): BOOL;
  1197. begin
  1198.   Result := (SendMessage(LVWnd, LVM_GETBKIMAGE, 0, LPARAM(plvbki)) <> 0);
  1199. end;
  1200. {$ENDIF}
  1201.  
  1202.  
  1203.  
  1204. constructor TELVBackgroundImage.Create(AOwner: TExtListView);
  1205. begin
  1206.   inherited Create;
  1207.   FOwningListView := AOwner;
  1208. end;
  1209.  
  1210. procedure TELVBackgroundImage.Assign(Source: TPersistent);
  1211. begin
  1212.   if Source is TELVBackgroundImage then
  1213.   begin
  1214.     FFilename := TELVBackgroundImage(Source).Filename;
  1215.     FTile := TELVBackgroundImage(Source).Tile;
  1216.     FXOffsetPercent := TELVBackgroundImage(Source).XOffsetPercent;
  1217.     FYOffsetPercent := TELVBackgroundImage(Source).YOffsetPercent;
  1218.     ApplyToListView;
  1219.   end;
  1220. end;
  1221.  
  1222. procedure TELVBackgroundImage.SetFilename(const Val: string);
  1223. begin
  1224.   if FFilename <> Val then
  1225.     FFilename := Val;
  1226.   ApplyToListView;
  1227. end;
  1228.  
  1229. procedure TELVBackgroundImage.SetTile(Val: boolean);
  1230. begin
  1231.   if FTile <> Val then
  1232.     FTile := Val;
  1233.   ApplyToListView;
  1234. end;
  1235.  
  1236. procedure TELVBackgroundImage.SetXOffsetPercent(Val: integer);
  1237. begin
  1238.   if FXOffsetPercent <> Val then
  1239.     FXOffsetPercent := Val;
  1240.   ApplyToListView;
  1241. end;
  1242.  
  1243. procedure TELVBackgroundImage.SetYOffsetPercent(Val: integer);
  1244. begin
  1245.   if FYOffsetPercent <> Val then
  1246.     FYOffsetPercent := Val;
  1247.   ApplyToListView;
  1248. end;
  1249.  
  1250. procedure TELVBackgroundImage.ApplyToListView;
  1251. var
  1252.   LVBkImg: TLVBkImage;
  1253. begin
  1254.   if assigned(FOwningListView) and FOwningListView.HandleAllocated then
  1255.   begin
  1256.     if FFilename <> '' then
  1257.       LVBkImg.ulFlags := LVBKIF_SOURCE_URL
  1258.     else
  1259.       LVBkImg.ulFlags := LVBKIF_SOURCE_NONE;
  1260.     if FTile then
  1261.       LVBkImg.ulFlags := LVBkImg.ulFlags or LVBKIF_STYLE_TILE
  1262.     else
  1263.       LVBkImg.ulFlags := LVBkImg.ulFlags or LVBKIF_STYLE_NORMAL;
  1264.     LVBkImg.hbm := 0;
  1265.     LVBkImg.pszImage := PChar(FFilename);
  1266.     LVBkImg.cchImageMax := Length(FFilename);
  1267.     LVBkImg.xOffsetPercent := FXOffsetPercent;
  1268.     LVBkImg.yOffsetPercent := FYOffsetPercent;
  1269.  
  1270.     ListView_SetTextBkColor(FOwningListView.Handle, $FFFFFFFF); 
  1271.     ListView_SetBkImage(FOwningListView.Handle, @LVBkImg);
  1272.   end;
  1273. end;
  1274.  
  1275.  
  1276.  
  1277. constructor TExtLVSaveSettings.Create;
  1278. begin
  1279.   inherited Create;
  1280.   FSaveColumnOrder := TRUE;
  1281. end;
  1282.  
  1283. procedure TExtLVSaveSettings.StoreColumnOrder(ColCount: integer;
  1284.    const IntArray: array of integer);
  1285. var
  1286.   Reg: TRegIniFile;
  1287.   x: integer;
  1288.   s: string;
  1289. begin
  1290.   if ColCount < 1 then exit;
  1291.   s := '';
  1292.   for x := 0 to ColCount-1 do
  1293.     s := s + IntToStr(IntArray[x]) + ',';
  1294.   SetLength(s, Length(s)-1);
  1295.   Reg := TRegIniFile.Create(RegistryKey);
  1296.   try
  1297.     Reg.WriteString('Columns', 'Order', s);
  1298.   finally
  1299.     Reg.Free;
  1300.   end;
  1301. end;
  1302.  
  1303. procedure TExtLVSaveSettings.ReadColumnOrder(ColCount: integer;
  1304.    var IntArray: array of integer);
  1305. var
  1306.   Reg: TRegIniFile;
  1307.   x,y: integer;
  1308.   s: string;
  1309. begin
  1310.   if ColCount < 1 then exit;
  1311.   s := '';
  1312.   Reg := TRegIniFile.Create(RegistryKey);
  1313.   try
  1314.     s := Reg.ReadString('Columns', 'Order', '');
  1315.   finally
  1316.     Reg.Free;
  1317.   end;
  1318.   if s = '' then
  1319.   begin
  1320.     for x := 0 to ColCount-1 do
  1321.       IntArray[x] := x;
  1322.     exit;
  1323.   end;
  1324.   y := 0;
  1325.   for x := 0 to ColCount-1 do
  1326.   begin
  1327.     try
  1328.       y := Pos(',', s);
  1329.       if y = 0 then
  1330.         y := Length(s)+1;
  1331.       IntArray[x] := StrToInt(Copy(s, 1, y-1));
  1332.     except
  1333.       IntArray[x] := 0;
  1334.     end;
  1335.     s := copy(s, y+1, length(s));
  1336.     if s = '' then break;
  1337.   end;
  1338. end;
  1339.  
  1340.  
  1341.  
  1342. // Override constructor to "zero out" our internal variable.
  1343. constructor TExtListView.Create(AOwner: TComponent);
  1344. begin
  1345.   inherited Create(AOwner);
  1346.  
  1347.   FItemCountEx := 0;
  1348.   FItemCountExFlags := [];
  1349.   FSelectionMark := -1;
  1350.   FHoverTime := $FFFFFFFF;
  1351.   FExtendedStyles := [];
  1352.   FColumnOrder := NIL;
  1353.   FColumnOrderCount := 0;
  1354.   FRequireComCtlUpdate := FALSE;
  1355.   FSaveSettings := TExtLVSaveSettings.Create;
  1356.   FColumnsFormatChangeLink := TChangeLink.Create;
  1357.   FColumnsFormatChangeLink.OnChange := ColumnHeaderImagesChange;
  1358.   FVirtualMode := FALSE;
  1359.   FColumnsFormat := TExtListColumns.Create(Self);
  1360. {$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  1361.   FBackgroundImage := TELVBackgroundImage.Create(Self);
  1362. {$ENDIF}
  1363. end;
  1364.  
  1365. destructor TExtListView.Destroy;
  1366. begin
  1367.   FColumnsFormat.Free; { don't think i need this, it has an Owner property }
  1368.   FColumnsFormatChangeLink.Free;
  1369.  
  1370.   if FColumnOrder <> NIL then
  1371.     FreeMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  1372.  
  1373.   inherited Destroy;
  1374.  
  1375.   FSaveSettings.Free;
  1376. {$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  1377.   { Free after inherited because inherited calls DestroyWnd and it is needed
  1378.     until after that...}
  1379.   FBackgroundImage.Free;
  1380. {$ENDIF}
  1381. end;
  1382.  
  1383. procedure TExtListView.CreateParams(var Params: TCreateParams);
  1384. begin
  1385.   inherited CreateParams(Params);
  1386.  
  1387.   if FVirtualMode then
  1388.     Params.Style := Params.Style or LVS_OWNERDATA;
  1389. end;
  1390.  
  1391. procedure TExtListView.CreateWnd;
  1392. begin
  1393.   inherited CreateWnd;
  1394.  
  1395.   SetSelectionMark(FSelectionMark);
  1396.   SetHoverTime(FHoverTime);
  1397.   SetExtendedStyles(FExtendedStyles);
  1398.   if VirtualMode and (FItemCountEx > 0) then
  1399.     SetItemCountEx(FItemCountEx, FItemCountExFlags);
  1400.  
  1401.   if FColumnOrder <> NIL then
  1402.   begin
  1403.     SendMessage(Handle, LVM_SETCOLUMNORDERARRAY, FColumnOrderCount,
  1404.        LongInt(FColumnOrder));
  1405.     Refresh;
  1406.   end;
  1407. {$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  1408.   FBackgroundImage.ApplyToListView;
  1409. {$ENDIF}
  1410. end;
  1411.  
  1412. procedure TExtListView.Loaded;
  1413. begin
  1414.   inherited Loaded;
  1415.  
  1416.   HandleNeeded;
  1417.   UpdateColumnsImages;
  1418. end;
  1419.  
  1420. // Subitem set to -1 means Caption text
  1421. function TExtListView.GetSubItemText(Index, SubItem: integer): string;
  1422. var
  1423.   x,
  1424.   ColCount: integer;
  1425.   ColArray: PIntArray;
  1426. begin
  1427.   // needs to account for modified column order
  1428.   Result := '';
  1429.   if Items[Index] = NIL then
  1430.     exit;
  1431.  
  1432.   ColCount := Columns.Count;
  1433.   if (SubItem + 2 > ColCount) then
  1434.   begin
  1435.     if SubItem < Items[Index].SubItems.Count then
  1436.       Result := Items[Index].SubItems[SubItem];
  1437.   end else begin
  1438.     GetMem(ColArray, SizeOf(Integer)*ColCount);
  1439.     try
  1440.       GetColumnOrder(ColCount, ColArray^);
  1441.       x := ColArray[SubItem+1];
  1442.       if x = 0 then
  1443.         Result := Items[Index].Caption
  1444.       else
  1445.         Result := Items[Index].SubItems[x-1];
  1446.     finally
  1447.       FreeMem(ColArray);
  1448.     end;
  1449.   end;
  1450. end;
  1451.  
  1452. function TExtListView.GetActualColumn(Index: integer): TListColumn;
  1453. var
  1454. //  x,
  1455.   ColCount: integer;
  1456.   ColArray: PIntArray;
  1457. begin
  1458.   // account for modified column order
  1459.  
  1460.   // Delphi 2 and C++B 1 have a bug in TListColumn.GetWidth.  It returns zero
  1461.   // for the width if the handle hasn't been allocated yet instead of returning
  1462.   // the value of the internal storage variable like Delphi 3 does.  I've also
  1463.   // had some problems similar under Delphi 3, so I'm just always requiring the
  1464.   // handle to be valid.
  1465.   HandleNeeded;
  1466.  
  1467.   Result := NIL;
  1468.   ColCount := Columns.Count;
  1469.   if Index >= ColCount then
  1470.     exit;
  1471.  
  1472.   GetMem(ColArray, SizeOf(Integer)*ColCount);
  1473.   try
  1474.     GetColumnOrder(ColCount, ColArray^);
  1475.     Result := Columns[ColArray[Index]];
  1476. (* I must have been high
  1477.     for x := 0 to ColCount-1 do
  1478.       if ColArray[x] = Index then
  1479.       begin
  1480.         Result := Columns[ColArray[x]];
  1481.         exit;
  1482.       end;
  1483. *)    
  1484.   finally
  1485.     FreeMem(ColArray);
  1486.   end;
  1487. end;
  1488.  
  1489. procedure TExtListView.DrawItem(var Canvas: TCanvas; Index: Integer;
  1490.    Rect: TRect; State: TOwnerDrawState; var DefaultDrawing,
  1491.    FullRowSelect: boolean);
  1492. begin
  1493.   { Default to whatever is in ExtendedStyles settings }
  1494.   FullRowSelect := lvxFullRowSelect in ExtendedStyles;
  1495.   inherited DrawItem(Canvas, Index, Rect, State, DefaultDrawing,
  1496.      FullRowSelect);
  1497. end;
  1498.  
  1499.  
  1500. procedure TExtListView.DefaultDrawHeader(var Canvas: TCanvas;
  1501.    Index: Integer; var Rect: TRect; Selected: boolean);
  1502. var
  1503.   TheColumn: TListColumn;
  1504.   ExtColumn: TExtListColumn;
  1505.   ImageOffset: integer;
  1506.   Offset: integer;
  1507.   R, CR: TRect;
  1508.   Bmp: TBitmap;
  1509. begin
  1510.  
  1511. (******************************************************************************)
  1512. (* NOTE:  This method is overriden and replaced from the one in TEnhListView. *)
  1513. (*   That means that if changes are made here, they will also need to be made *)
  1514. (*   in EnhListView.pas' DefaultDrawHeader method.                            *)
  1515. (******************************************************************************)
  1516.  
  1517.   if not Selected then
  1518.     InflateRect(Rect, -2, -2);
  1519.   Canvas.FillRect(Rect);
  1520.   if Selected then
  1521.     InflateRect(Rect, -2, -2);
  1522.  
  1523.   if (Index >= 0) and (Index < Columns.Count) then
  1524.   begin
  1525.     // Don't use ActualColumn[] here!  That's for SubItem foolery, not header.
  1526.     TheColumn := Columns[Index];
  1527.  
  1528.     if Selected then
  1529.     begin
  1530.       inc(Rect.Top);
  1531.       inc(Rect.Left);
  1532.     end;
  1533.  
  1534.     R := Rect;
  1535.  
  1536.     case TheColumn.Alignment of
  1537.       taRightJustify:
  1538.         Dec(R.Right, 4);
  1539.       taLeftJustify:
  1540.         Inc(R.Left, 4);
  1541.       // taCenter needs no modification
  1542.     end;
  1543.  
  1544.     if (Index < ColumnsFormat.Count) and assigned(SmallImages) and
  1545.        ((ColumnsFormat[Index].ImageIndex >= 0) and
  1546.        (ColumnsFormat[Index].ImageIndex < SmallImages.Count)) then
  1547.       ExtColumn := ColumnsFormat[Index]
  1548.     else
  1549.       ExtColumn := NIL;
  1550.  
  1551.     if assigned(ExtColumn) then
  1552.     begin
  1553.       case ExtColumn.ImageAlignment of
  1554.         ciaLeftOfText:
  1555.           Inc(R.Left, SmallImages.Width + 4);
  1556.         ciaRightOfText:
  1557.           Dec(R.Right, SmallImages.Width + 4);
  1558.       end;
  1559.     end;
  1560.  
  1561.     if ShowSortArrows and (LastColumnClicked = Index) and
  1562.        ((AutoColumnSort <> acsNoSort) or (assigned(OnSortItems))) then
  1563.     begin
  1564.       if CurrentSortAscending then
  1565.         Bmp := SortUpBmp
  1566.       else
  1567.         Bmp := SortDownBmp;
  1568.  
  1569.       Dec(R.Right, Bmp.Width + 8);
  1570.       if R.Right < R.Left then
  1571.         R.Right := R.Left;
  1572.  
  1573.       { How big of a rectangle do we have to work with for the text? }
  1574.       CR := R;
  1575.       DrawTextEx(Canvas.Handle, PChar(TheColumn.Caption), -1, CR,
  1576.          DRAWTEXTEX_FLAGS or DT_CALCRECT or
  1577.          DRAWTEXTEX_ALIGNMENT[TheColumn.Alignment], NIL);
  1578.       { Note that DT_CALCRECT does not adjust for alignment. We must do that }
  1579.       case TheColumn.Alignment of
  1580.         taRightJustify:
  1581.           R.Left := R.Right - (CR.Right - CR.Left);
  1582.         taCenter:
  1583.           begin
  1584.             R.Left := R.Left + (((R.Right - R.Left) - (CR.Right - CR.Left)) div
  1585.                2);
  1586.             R.Right := R.Left + (CR.Right - CR.Left);
  1587.           end;
  1588.       else // taLeftJustify: doesn't matter, that is what DT_CALCRECT returns
  1589.         R := CR;
  1590.       end;
  1591.       if R.Left < Rect.Left then
  1592.         R.Left := Rect.Left;
  1593.       if R.Right > Rect.Right then
  1594.         R.Right := Rect.Right;
  1595.  
  1596.       if Selected then
  1597.         OffsetRect(R, 1, 1);
  1598.       // Draw the caption in the rect available
  1599.       DrawTextEx(Canvas.Handle, PChar(TheColumn.Caption), -1, R,
  1600.          DRAWTEXTEX_FLAGS or DRAWTEXTEX_ALIGNMENT[TheColumn.Alignment], NIL);
  1601.  
  1602.       // Draw column image if we have one
  1603.       if assigned(ExtColumn) then
  1604.       begin
  1605.         ImageOffset := (Rect.Bottom - Rect.Top - SmallImages.Height) div 2;
  1606.         case ExtColumn.ImageAlignment of
  1607.           ciaLeftOfText:
  1608.             SmallImages.Draw(Canvas, R.Left - (SmallImages.Width + 4),
  1609.                R.Top + ImageOffset, ExtColumn.ImageIndex);
  1610.           ciaRightOfText:
  1611.             begin
  1612.               SmallImages.Draw(Canvas, R.Right + 4, R.Top + ImageOffset,
  1613.                  ExtColumn.ImageIndex);
  1614.               inc(R.Right, SmallImages.Width);
  1615.               if R.Right > Rect.Right then
  1616.                 R.Right := Rect.Right;
  1617.             end;
  1618.         end;
  1619.       end;
  1620.  
  1621.       // Draw the sort arrow bitmap
  1622.       Offset := (Rect.Bottom - Rect.Top - Bmp.Height) div 2;
  1623.       // Only draw if we have enough room
  1624.       if (R.Right + Bmp.Width + 8) <= Rect.Right then
  1625.         Canvas.Draw(R.Right + 8, R.Top + Offset, Bmp);
  1626.     end else begin
  1627.       if Selected then
  1628.         OffsetRect(R, 1, 1);
  1629.       CR := R;
  1630.  
  1631.       DrawTextEx(Canvas.Handle, PChar(TheColumn.Caption), -1, CR,
  1632.          DRAWTEXTEX_FLAGS or DT_CALCRECT or
  1633.          DRAWTEXTEX_ALIGNMENT[TheColumn.Alignment], NIL);
  1634.       { Note that DT_CALCRECT does not adjust for alignment. We must do that }
  1635.       case TheColumn.Alignment of
  1636.         taRightJustify:
  1637.           R.Left := R.Right - (CR.Right - CR.Left);
  1638.         taCenter:
  1639.           begin
  1640.             R.Left := R.Left + (((R.Right - R.Left) - (CR.Right - CR.Left)) div
  1641.                2);
  1642.             R.Right := R.Left + (CR.Right - CR.Left);
  1643.           end;
  1644.       else // taLeftJustify: doesn't matter, that is what DT_CALCRECT returns
  1645.         R := CR;
  1646.       end;
  1647.       if R.Left < Rect.Left then
  1648.         R.Left := Rect.Left;
  1649.       if R.Right > Rect.Right then
  1650.         R.Right := Rect.Right;
  1651.  
  1652.       DrawTextEx(Canvas.Handle, PChar(TheColumn.Caption), -1, R,
  1653.          DRAWTEXTEX_FLAGS or DRAWTEXTEX_ALIGNMENT[TheColumn.Alignment], NIL);
  1654.  
  1655.       // Draw column image if we have one
  1656.       if assigned(ExtColumn) then
  1657.       begin
  1658.         ImageOffset := (Rect.Bottom - Rect.Top - SmallImages.Height) div 2;
  1659.         case ExtColumn.ImageAlignment of
  1660.           ciaLeftOfText:
  1661.             // Only draw if we have enough room
  1662.             if (R.Left - (SmallImages.Width + 4)) >= Rect.Left then
  1663.               SmallImages.Draw(Canvas, R.Left - (SmallImages.Width + 4),
  1664.                  R.Top + ImageOffset, ExtColumn.ImageIndex);
  1665.           ciaRightOfText:
  1666.             // Only draw if we have enough room
  1667.             if (R.Right + SmallImages.Width + 4) <= Rect.Right then
  1668.               SmallImages.Draw(Canvas, R.Right + 4, R.Top + ImageOffset,
  1669.                  ExtColumn.ImageIndex);
  1670.         end;
  1671.       end;
  1672.     end;
  1673.   end;
  1674. end;
  1675.  
  1676.  
  1677. const
  1678.   API_STYLES: array[Low(TLVExtendedStyle)..High(TLVExtendedStyle)] of LPARAM = (
  1679.      LVS_EX_GRIDLINES, LVS_EX_SUBITEMIMAGES, LVS_EX_CHECKBOXES,
  1680.      LVS_EX_TRACKSELECT, LVS_EX_HEADERDRAGDROP, LVS_EX_FULLROWSELECT,
  1681.      LVS_EX_ONECLICKACTIVATE, LVS_EX_TWOCLICKACTIVATE, LVS_EX_FLATSB,
  1682.      {$IFDEF DFS_TRY_INFOTIP} LVS_EX_INFOTIP, {$ENDIF}
  1683.      LVS_EX_UNDERLINEHOT, LVS_EX_UNDERLINECOLD);
  1684.      // LVS_EX_INFOTIP, LVS_EX_REGIONAL, LVS_EX_MULTIWORKAREAS - not implemented
  1685.  
  1686. // Function to convert our style set type into the value expected by the API.
  1687. function TExtListView.SetValueToAPIValue(Styles: TLVExtendedStyles): LPARAM;
  1688. var
  1689.   x: TLVExtendedStyle;
  1690. begin
  1691.   Result := 0;
  1692.   { Check for each possible style. }
  1693.   for x := Low(TLVExtendedStyle) to High(TLVExtendedStyle) do
  1694.     { If the style is set... }
  1695.     if x in Styles then
  1696.       { OR the appropriate value into the result. }
  1697.       Result := Result OR API_STYLES[x];
  1698. end;
  1699.  
  1700. // Function to convert from the API values to our style set type.
  1701. function TExtListView.SetValueFromAPIValue(Styles: DWORD): TLVExtendedStyles;
  1702. var
  1703.   x: TLVExtendedStyle;
  1704. begin
  1705.   Result := [];
  1706.   { Check for each possible style. }
  1707.   for x := Low(TLVExtendedStyle) to High(TLVExtendedStyle) do
  1708.     { If the style is set... }
  1709.     if (API_STYLES[x] and Styles) <> 0 then
  1710.       { OR the appropriate value into the result. }
  1711.       Result := Result + [x];
  1712. end;
  1713.  
  1714. // Property method to get the extended style bits.
  1715. function TExtListView.GetExtendedStyles: TLVExtendedStyles;
  1716. begin
  1717.   if HandleAllocated then
  1718.     FExtendedStyles :=
  1719.        SetValueFromAPIValue(ListView_GetExtendedListViewStyle(Handle));
  1720.   Result := FExtendedStyles;
  1721. end;
  1722.  
  1723. // Property method to set new style bits.
  1724. procedure TExtListView.SetExtendedStyles(Val: TLVExtendedStyles);
  1725. begin
  1726.   { Update the window with the new styles. }
  1727.   if (Val * [lvxUnderlineHot, lvxUnderlineCold] <> []) then
  1728.   begin
  1729.     // lvxUnderlineHot and lvxUnderlineCold require lvxOneClickActivate and/or
  1730.     // lvxTwoClickActivate
  1731.     if (lvxUnderlineCold in Val) and (not (lvxOneClickActivate in Val)) then
  1732.       Include(Val, lvxOneClickActivate);
  1733.     if (lvxUnderlineHot in Val) and
  1734.        (Val * [lvxOneClickActivate, lvxTwoClickActivate] = []) then
  1735.       Include(Val, lvxOneClickActivate);
  1736.   end;
  1737.  
  1738.   // A real world use of XOR!!!  We need to invalidate if subitem images is in
  1739.   // new value and not in old, or in old value and not in new, but NOT if it is
  1740.   // set or cleared in both.
  1741.   if ((lvxSubItemImages in Val) xor (lvxSubItemImages in FExtendedStyles)) and
  1742.      (HandleAllocated) then
  1743.     Invalidate;
  1744.  
  1745.   FExtendedStyles := Val;
  1746.   if HandleAllocated then
  1747.     ListView_SetExtendedListViewStyle(Handle, SetValueToAPIValue(Val));
  1748. end;
  1749.  
  1750. function TExtListView.GetHeaderHandle: HWnd;
  1751. begin
  1752.   if FHeaderHandle <> 0 then
  1753.     Result := FHeaderHandle
  1754.   else begin
  1755.     if HandleAllocated then
  1756.       Result := ListView_GetHeader(Handle)
  1757.     else
  1758.       Result := 0;
  1759.   end;
  1760. end;
  1761.  
  1762. procedure TExtListView.SetIconSpacing(X, Y: integer);
  1763. begin
  1764. // Not sure about how to update the view after changing this.  Refresh doesn't
  1765. // do the job.  Seems the best way to do it is in client code, something like:
  1766. (*
  1767.   SetIconSpacing(X, Y);
  1768.   // Does strange things if ViewStyle is not set to vsIcon!
  1769.   if ViewStyle = vsIcon then
  1770.   begin
  1771.     SendMessage(Handle, WM_SETREDRAW, 0, 0);
  1772.     try
  1773.       ViewStyle := vsSmallIcon;
  1774.       ViewStyle := vsIcon;
  1775.     finally
  1776.       SendMessage(Handle, WM_SETREDRAW, 1, 0);
  1777.     end;
  1778.   end;
  1779. *)
  1780.  
  1781.   if HandleAllocated then
  1782.     if ViewStyle = vsIcon then
  1783.       ListView_SetIconSpacing(Handle, X, Y);
  1784. end;
  1785.  
  1786. function TExtListView.GetSubItemRect(Item, SubItem: integer;
  1787.    Index: integer): TRect;
  1788. begin
  1789.   if HandleAllocated then
  1790.     ListView_GetSubItemRect(Handle, Item, SubItem, Index, Result);
  1791. end;
  1792.  
  1793. function TExtListView.GetSubItemAt(X, Y: integer): string;
  1794. var
  1795. {$IFNDEF DFS_C3D4COMMCTRL}
  1796.   Info: TLVHitTestInfoEx;
  1797. {$ELSE}
  1798.   Info: TLVHitTestInfo;
  1799. {$ENDIF}
  1800. begin
  1801.   Result := '';
  1802.   if HandleAllocated then
  1803.   begin
  1804.     Info.pt := Point(X, Y);
  1805. {$IFNDEF DFS_C3D4COMMCTRL}
  1806.     if ListView_SubItemHitTestEx(Handle, Info) <> -1 then
  1807. {$ELSE}
  1808.     if ListView_SubItemHitTest(Handle, @Info) <> -1 then
  1809. {$ENDIF}
  1810.     begin
  1811.       if (Info.iItem > -1) and (Items[Info.iItem] <> NIL) then
  1812.       begin
  1813.         if Info.iSubItem = 0 then
  1814.           Result := Items[Info.iItem].Caption
  1815.         else
  1816.           Result := Items[Info.iItem].SubItems[Info.iSubItem-1];
  1817.       end;
  1818.     end;
  1819.   end;
  1820. end;
  1821.  
  1822. procedure TExtListView.SetColumnOrder(Count: integer; const IntArray:
  1823.    array of integer);
  1824. begin
  1825.   if FColumnOrder <> NIL then
  1826.     FreeMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  1827.   FColumnOrderCount := Count;
  1828.   GetMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  1829.   Move(IntArray, FColumnOrder^, FColumnOrderCount * SizeOf(Integer));
  1830.   if HandleAllocated then
  1831.   begin
  1832.     ListView_SetColumnOrderArray(Handle, Count, @IntArray);
  1833.     Refresh;
  1834.   end;
  1835. end;
  1836.  
  1837. function TExtListView.GetColumnOrder(Count: integer;
  1838.                                      var IntArray: array of integer): boolean;
  1839. begin
  1840.   if HandleAllocated then
  1841.   begin
  1842.     if Count <> FColumnOrderCount then
  1843.     begin
  1844.       FColumnOrderCount := Count;
  1845.       if FColumnOrder <> NIL then
  1846.         FreeMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  1847.       GetMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  1848.     end;
  1849.     Result := ListView_GetColumnOrderArray(Handle, FColumnOrderCount,
  1850.        @IntArray);
  1851.     Move(IntArray, FColumnOrder^, FColumnOrderCount * SizeOf(Integer));
  1852.   end else begin
  1853.     if FColumnOrder <> NIL then
  1854.     begin
  1855.       Move(FColumnOrder^, IntArray, Count * SizeOf(Integer));
  1856.       Result := TRUE;
  1857.     end else
  1858.       Result := FALSE;
  1859.   end;
  1860. end;
  1861.  
  1862. procedure TExtListView.SetHotItem(Val: integer);
  1863. begin
  1864.   if HandleAllocated then
  1865.     ListView_SetHotItem(Handle, Val);
  1866. end;
  1867.  
  1868. function TExtListView.GetHotItem: integer;
  1869. begin
  1870.   if HandleAllocated then
  1871.     Result := ListView_GetHotItem(Handle)
  1872.   else
  1873.     Result := -1;
  1874. end;
  1875.  
  1876. procedure TExtListView.SetHotCursor(const Val: HCursor);
  1877. begin
  1878.   if HandleAllocated then
  1879.     ListView_SetHotCursor(Handle, Val);
  1880. end;
  1881.  
  1882. function TExtListView.GetHotCursor: HCursor;
  1883. begin
  1884.   if HandleAllocated then
  1885.     Result := ListView_GetHotCursor(Handle)
  1886.   else
  1887.     Result := 0;
  1888. end;
  1889.  
  1890. function TExtListView.ApproximateViewRect(Count: integer;
  1891.    const Proposed: TPoint): TPoint;
  1892. var
  1893.   Res: DWORD;
  1894. begin
  1895.   if HandleAllocated then
  1896.   begin
  1897.     Res := ListView_ApproximateViewRect(Handle, Count, Proposed.X, Proposed.Y);
  1898.     Result := Point(LoWord(Res), HiWord(Res));
  1899.   end else
  1900.     Result := Point(-1, -1);
  1901. end;
  1902.  
  1903. procedure TExtListView.SetWorkArea(Rect: TRect);
  1904. begin
  1905.   if HandleAllocated then
  1906.     ListView_SetWorkArea(Handle, Rect);
  1907. end;
  1908.  
  1909. procedure TExtListView.SetCheckState(Index: integer; Checked: boolean);
  1910. begin
  1911.   if HandleAllocated then
  1912.     ListView_SetCheckState(Handle, Index, Checked);
  1913. end;
  1914.  
  1915. function TExtListView.GetCheckState(Index: integer): boolean;
  1916. begin
  1917.   if HandleAllocated then
  1918.     Result := ListView_GetCheckState(Handle, Index)
  1919.   else
  1920.     Result := FALSE;
  1921. end;
  1922.  
  1923. procedure TExtListView.SetItemCountEx(Count: integer; Flags: TLVItemCountFlags);
  1924. var
  1925.   APIFlags: DWORD;
  1926. begin
  1927.   FItemCountEx := Count;
  1928.   FItemCountExFlags := Flags;
  1929.   if HandleAllocated then
  1930.   begin
  1931.     APIFlags := 0;
  1932.     if lvsicfNoInvalidateAll in Flags then
  1933.       APIFlags := LVSICF_NOINVALIDATEALL;
  1934.     if lvsicfNoScroll in Flags then
  1935.       APIFlags := APIFlags or LVSICF_NOSCROLL;
  1936.     ListView_SetItemCountEx(Handle, Count, APIFlags);
  1937.   end;
  1938. end;
  1939.  
  1940. procedure TExtListView.SetVirtualMode(Val: boolean);
  1941. begin
  1942.   if Val = FVirtualMode then exit;
  1943.   FVirtualMode := Val;
  1944.   if Items <> NIL then
  1945.     Items.Clear;
  1946.   if HandleAllocated then
  1947.   begin
  1948.     RecreateWnd;
  1949.     HandleNeeded;
  1950.   end;
  1951. end;
  1952.  
  1953. function TExtListView.GetItemIndent(Index: integer): Integer;
  1954. var
  1955.   APIItem: TLVItemEx;
  1956. begin
  1957.   HandleNeeded;
  1958.   { Which item do they want? }
  1959.   APIItem.iItem := Index;
  1960.   { Indenting is only supported for items, not subitems, by COMCTL32.DLL }
  1961.   APIItem.iSubItem := 0;
  1962.   { Tell it that only the iIndent value is to be set for the item so it }
  1963.   { leaves the rest of the stuff alone }
  1964.   APIItem.mask := LVIF_INDENT;
  1965.   { Get it. }
  1966.   if SendMessage(Handle, LVM_GETITEM, 0, LPARAM(@APIItem)) <> 0 then
  1967.     Result := APIItem.iIndent
  1968.   else
  1969.     Result := -1;
  1970. end;
  1971.  
  1972.  
  1973. procedure TExtListView.SetItemIndent(Index: integer; Value: Integer);
  1974. var
  1975.   APIItem: TLVItemEx;
  1976. begin
  1977.   HandleNeeded;
  1978.   { Which item do they want? }
  1979.   APIItem.iItem := Index;
  1980.   { Indenting is only supported for items, not subitems, by COMCTL32.DLL }
  1981.   APIItem.iSubItem := 0;
  1982.   { Tell it that only the iIndent value is set for the item so it }
  1983.   { leaves the rest of the stuff alone }
  1984.   APIItem.mask := LVIF_INDENT;
  1985.   APIItem.iIndent := Value;
  1986.   { Set it. }
  1987.   if SendMessage(Handle, LVM_SETITEM, 0, LPARAM(@APIItem)) = 0 then
  1988.     messagebeep(1);
  1989. end;
  1990.  
  1991.  
  1992. procedure TExtListView.CNNotify(var Message: TWMNotify);
  1993. var
  1994.   CallInherited: boolean;
  1995. begin
  1996.   if Message.NMHdr = NIL then
  1997.   begin
  1998.     inherited;
  1999.     exit;
  2000.   end;
  2001.  
  2002.   with Message.NMHdr^ do
  2003.   begin
  2004.     Message.Result := 0;
  2005.     CallInherited := FALSE;
  2006.     case code of
  2007.       // We only want to handle LVN_GETDISPINFO when in virtual mode
  2008.       LVN_GETDISPINFO:
  2009.         if FVirtualMode then
  2010.           VMGetDispInfo(PLVDispInfoEx(pointer(Message.NMHdr))^.item)
  2011.         else
  2012.           CallInherited := TRUE;
  2013.       LVN_ODCACHEHINT:
  2014.         VMCacheHint(PNMCacheHint(pointer(Message.NMHdr))^);
  2015.       LVN_ODSTATECHANGED:
  2016.         VMStateChanged(PNMODStateChange(pointer(Message.NMHdr))^);
  2017.       LVN_ODFINDITEM:
  2018.         Message.Result := VMFindItem(PNMFindItem(pointer(Message.NMHdr))^);
  2019.  
  2020.       LVN_ITEMACTIVATE:
  2021.         begin
  2022.           ItemActivate;
  2023.           Message.Result := 0;
  2024.         end;
  2025.       LVN_MARQUEEBEGIN:
  2026.         begin
  2027.           if MarqueeBegin then
  2028.             Message.Result := 0
  2029.           else
  2030.             Message.Result := 1;
  2031.         end;
  2032.       LVN_HOTTRACK:
  2033.         begin
  2034.           if HotTrack(PNMListView(Message.NMHdr)^) then
  2035.             Message.Result := 0
  2036.           else
  2037.             Message.Result := 1;
  2038.         end;
  2039. {$IFDEF DFS_TRY_INFOTIP}
  2040.       LVN_GETINFOTIP:
  2041.         begin
  2042.           GetInfoTip(PNMLVGetInfoTip(Message.NMHdr));
  2043.           SetWindowPos(Handle, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOREDRAW or
  2044.           SWP_NOSIZE or SWP_NOMOVE);
  2045.           Message.Result := 1;
  2046.         end;
  2047. {$ENDIF}        
  2048.     else
  2049.       CallInherited := TRUE;
  2050.     end;
  2051.   end;
  2052.   if CallInherited then
  2053.     inherited;
  2054. end;
  2055.  
  2056.  
  2057. procedure TExtListView.WMNotify(var Message: TWMNotify);
  2058. begin
  2059.   // For some reason, the SECOND time you drag a header width, it toasts the
  2060.   // bitmap.  I think it has to do with the TListView class somehow resetting
  2061.   // the column information, overwriting our information (image info).  Anyway,
  2062.   // catching the condition (begin column header drag) and resetting all the
  2063.   // extended information for that column fixes it.
  2064.   if Message.NMHdr.code = HDN_BEGINTRACK then
  2065.     UpdateColumnImage(PHDNotify(Message.NMHdr).Item);
  2066.  
  2067.   inherited;
  2068.  
  2069. end;
  2070.  
  2071.  
  2072. function TExtListView.MarqueeBegin: boolean;
  2073. begin
  2074.   Result := TRUE;
  2075.   if assigned(FOnMarqueeBegin) then
  2076.     FOnMarqueeBegin(Self, Result);
  2077. end;
  2078.  
  2079. procedure TExtListView.ItemActivate;
  2080. begin
  2081.   if assigned(FOnItemActivate) then
  2082.     FOnItemActivate(Self);
  2083. end;
  2084.  
  2085. function TExtListView.HotTrack(var Item: TNMListView): boolean;
  2086. begin
  2087.   Result := TRUE;
  2088.   if assigned(FOnHotTrack) then
  2089.     FOnHotTrack(Self, Item.iItem, Item.iSubItem, Item.ptAction, Result);
  2090. end;
  2091.  
  2092. {$IFDEF DFS_TRY_INFOTIP}
  2093. procedure TExtListView.GetInfoTip(InfoTip: PNMLVGetInfoTip);
  2094. var
  2095.   Current,
  2096.   Additional: string;
  2097. begin
  2098.   if assigned(InfoTip) and assigned(FOnInfoTip) then
  2099.   begin
  2100.     if InfoTip^.dwFlags = LVGIT_UNFOLDED then
  2101.       Current := string(InfoTip^.pszText)
  2102.     else
  2103.       Current := '';
  2104.     FOnInfoTip(Self, InfoTip^.iItem, Current, Additional);
  2105.     if Additional <> '' then
  2106.     begin
  2107.       if InfoTip^.dwFlags = LVGIT_UNFOLDED then
  2108.         StrLCat(InfoTip^.pszText, PChar(Additional), InfoTip^.cchTextMax)
  2109.       else
  2110.         StrLCopy(InfoTip^.pszText, PChar(Additional), InfoTip^.cchTextMax);
  2111.     end;
  2112.   end;
  2113. end;
  2114. {$ENDIF}
  2115.  
  2116. procedure TExtListView.VMGetDispInfo(var ItemInfo: TLVItemEx);
  2117.   function MaskFlagsToSet(Mask: UINT): TLVVMMaskItems;
  2118.   begin
  2119.     Result := [];
  2120.     if (Mask and LVIF_TEXT) = LVIF_TEXT then
  2121.       Include(Result, lvifText);
  2122.     if (Mask and LVIF_IMAGE) = LVIF_IMAGE then
  2123.       Include(Result, lvifImage);
  2124.     if (Mask and LVIF_PARAM) = LVIF_PARAM then
  2125.       Include(Result, lvifParam);
  2126.     if (Mask and LVIF_STATE) = LVIF_STATE then
  2127.       Include(Result, lvifState);
  2128.     if (Mask and LVIF_INDENT) = LVIF_INDENT then
  2129.       Include(Result, lvifIndent);
  2130.   end;
  2131. var
  2132.   Text: string;
  2133.   NewState: UINT;
  2134.   GetMask: TLVVMMaskItems;
  2135. begin
  2136.   if ItemInfo.iItem = -1 then exit;  // No way.
  2137.   Text := '';
  2138.   NewState := ItemInfo.State;
  2139.   GetMask := MaskFlagsToSet(ItemInfo.Mask);
  2140.   if assigned(FOnVMGetItemInfo) then
  2141.   begin
  2142.     with ItemInfo do
  2143.       FOnVMGetItemInfo(Self, iItem, iSubItem, GetMask,
  2144.          iImage, lParam, NewState, iIndent, Text);
  2145.     if (ItemInfo.mask and LVIF_TEXT) = LVIF_TEXT then
  2146.       StrLCopy(ItemInfo.pszText, PChar(Text), ItemInfo.cchTextMax);
  2147.     ItemInfo.State := NewState;
  2148.   end;
  2149. end;
  2150.  
  2151. procedure TExtListView.VMCacheHint(var HintInfo: TNMCacheHint);
  2152. begin
  2153.   if assigned(FOnVMCacheHint) then
  2154.     FOnVMCacheHint(Self, HintInfo);
  2155. end;
  2156.  
  2157. function TExtListView.VMFindItem(var FindInfo: TNMFindItem): integer;
  2158. begin
  2159.   Result := -1;
  2160.   if assigned(FOnVMFindItem) then
  2161.     FOnVMFindItem(Self, FindInfo, Result);
  2162. end;
  2163.  
  2164. procedure TExtListView.VMStateChanged(var StateInfo: TNMODStateChange);
  2165. begin
  2166.   if assigned(FOnVMStateChanged) then
  2167.     FOnVMStateChanged(Self, StateInfo);
  2168. end;
  2169.  
  2170. function TExtListView.StoreSettings: boolean;
  2171. var
  2172.   x,
  2173.   ColCount: integer;
  2174.   ColArray: PIntArray;
  2175. begin
  2176.   // DON'T CALL INHERITED!!!!  It has caused me no end of trouble, so I
  2177.   // just resave the width stuff if I need to rather than call inherited.
  2178.  
  2179.   if FSaveSettings.AutoSave and
  2180.      ((([csDesigning, csLoading, csReading] * ComponentState) = []) or
  2181.      (csDestroying in ComponentState)) then
  2182.   begin
  2183.     Result := TRUE;
  2184.     ColCount := Columns.Count;
  2185.     if (FSaveSettings.SaveColumnOrder or FSaveSettings.SaveColumnSizes) and
  2186.        (ColCount > 0) then
  2187.     begin
  2188.       GetMem(ColArray, SizeOf(Integer)*ColCount);
  2189.       try
  2190.         if FSaveSettings.SaveColumnOrder then
  2191.         begin
  2192.           GetColumnOrder(ColCount, ColArray^);
  2193.           FSaveSettings.StoreColumnOrder(ColCount, ColArray^);
  2194.         end;
  2195.         if FSaveSettings.SaveColumnSizes then
  2196.         begin
  2197.           for x := 0 to ColCount-1 do
  2198.             ColArray[x] := ActualColumn[x].Width;
  2199.           FSaveSettings.StoreColumnSizes(ColCount, ColArray^);
  2200.         end;
  2201.       finally
  2202.         FreeMem(ColArray);
  2203.       end;
  2204.     end;
  2205.     if FSaveSettings.SaveCurrentSort then
  2206.       FSaveSettings.StoreCurrentSort(CurrentSortAscending, LastColumnClicked);
  2207.   end else
  2208.     Result := FALSE;
  2209. end;
  2210.  
  2211. function TExtListView.LoadSettings: boolean;
  2212. var
  2213.   x,
  2214.   ColCount: integer;
  2215.   ColArray: PIntArray;
  2216.   SortCol: integer;
  2217.   SortAscending: boolean;
  2218. begin
  2219.   if FSaveSettings.AutoSave and (not(csDesigning in ComponentState)) then
  2220.   begin
  2221.     Result := TRUE;
  2222.     ColCount := Columns.Count;
  2223.     if (FSaveSettings.SaveColumnOrder or FSaveSettings.SaveColumnSizes) and
  2224.        (ColCount > 0) then
  2225.     begin
  2226.       GetMem(ColArray, SizeOf(Integer)*ColCount);
  2227.       try
  2228.         if FSaveSettings.AutoSave and FSaveSettings.SaveColumnOrder then
  2229.         begin
  2230.           FSaveSettings.ReadColumnOrder(ColCount, ColArray^);
  2231.           SetColumnOrder(ColCount, ColArray^);
  2232.         end;
  2233.  
  2234.         if FSaveSettings.SaveColumnSizes then
  2235.         begin
  2236.           FSaveSettings.ReadColumnSizes(ColCount, ColArray^);
  2237.           if ColArray[0] <> -1 then
  2238.             for x := 0 to ColCount-1 do
  2239.               ActualColumn[x].Width := ColArray[x];
  2240.         end;
  2241.       finally
  2242.         FreeMem(ColArray);
  2243.       end;
  2244.     end;
  2245.  
  2246.     if FSaveSettings.SaveCurrentSort then
  2247.     begin
  2248.       FSaveSettings.ReadCurrentSort(SortAscending, SortCol);
  2249.       if SortCol >= Columns.Count then
  2250.         SortCol := Columns.Count-1;
  2251.       if SortCol < 0 then
  2252.         SortCol := 0;
  2253.       BeginUpdate;
  2254.       try
  2255.         CurrentSortAscending := SortAscending;
  2256.         LastColumnClicked := SortCol;
  2257.         Resort;
  2258.       finally
  2259.         EndUpdate;
  2260.       end;
  2261.     end;
  2262.   end else
  2263.     Result := FALSE;
  2264. end;
  2265.  
  2266.  
  2267. function TExtListView.ELV_GetNextItem(StartItem: integer;
  2268.    Direction: TSearchDirection; States: TItemStates): integer;
  2269. var
  2270.   Flags: Integer;
  2271. begin
  2272.   Result := -1;
  2273.   if HandleAllocated then
  2274.   begin
  2275.     Flags := 0;
  2276.     case Direction of
  2277.       sdAbove: Flags := LVNI_ABOVE;
  2278.       sdBelow: Flags := LVNI_BELOW;
  2279.       sdLeft: Flags := LVNI_TOLEFT;
  2280.       sdRight: Flags := LVNI_TORIGHT;
  2281.       sdAll: Flags := LVNI_ALL;
  2282.     end;
  2283.     if isCut in States then Flags := Flags or LVNI_CUT;
  2284.     if isDropHilited in States then Flags := Flags or LVNI_DROPHILITED;
  2285.     if isFocused in States then Flags := Flags or LVNI_FOCUSED;
  2286.     if isSelected in States then Flags := Flags or LVNI_SELECTED;
  2287.     Result := ListView_GetNextItem(Handle, StartItem, Flags);
  2288.   end;
  2289. end;
  2290.  
  2291.  
  2292. procedure TExtListView.ColumnHeaderImagesChange(Sender: TObject);
  2293. begin
  2294.   UpdateColumnsImages; { Images changed }
  2295. end;
  2296.  
  2297.  
  2298. procedure TExtListView.SetColumnsFormat(Value: TExtListColumns);
  2299. begin
  2300.   FColumnsFormat.Assign(Value);
  2301. end;
  2302.  
  2303. {$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  2304. procedure TExtListView.SetBackgroundImage(Value: TELVBackgroundImage);
  2305. begin
  2306.   FBackgroundImage.Assign(Value);
  2307. end;
  2308. {$ENDIF}
  2309.  
  2310. function TExtListView.GetSubItemImageIndex(Item, SubItem: integer): integer;
  2311. var
  2312.   APIItem: TLVItem;
  2313. begin
  2314.   HandleNeeded;
  2315.  
  2316.   Result := -1; // Assume the worst
  2317.  
  2318.   { Which item do they want? }
  2319.   APIItem.iItem := Item;
  2320.   { Subitem index, this is one-based, zero is the caption item }
  2321.   APIItem.iSubItem := SubItem+1;
  2322.   { Tell it that only the iImage value is to be set for the item so it }
  2323.   { leaves the rest of the stuff alone }
  2324.   APIItem.mask := LVIF_IMAGE;
  2325.   { Get it. }
  2326.   if ListView_GetItem(Handle, APIItem) then
  2327.     Result := APIItem.iImage;
  2328. end;
  2329.  
  2330. procedure TExtListView.SetSubItemImageIndex(Item, SubItem, Value: integer);
  2331. var
  2332.   APIItem: TLVItem;
  2333. begin
  2334.   HandleNeeded;
  2335.  
  2336.   { Which item is it? }
  2337.   APIItem.iItem := Item;
  2338.   { Subitem index, this is one-based, zero is the caption item }
  2339.   APIItem.iSubItem := SubItem+1;
  2340.   { Tell it what image list index to use }
  2341.   APIItem.iImage := Value;
  2342.   { Tell it that only the iImage value is to be set for the item so it }
  2343.   { leaves the rest of the stuff in the item alone }
  2344.   APIItem.mask := LVIF_IMAGE;
  2345.   { Set it. }
  2346.   ListView_SetItem(Handle, APIItem);
  2347. end;
  2348.  
  2349. function TExtListView.GetSmallImages: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList; {$ELSE} TImageList; {$ENDIF}
  2350. begin
  2351.   // Nothing, just get it
  2352.   Result := inherited SmallImages;
  2353. end;
  2354.  
  2355. procedure TExtListView.SetSmallImages(Value: {$IFDEF DFS_COMPILER_4_UP} TCustomImageList {$ELSE} TImageList {$ENDIF});
  2356. begin
  2357.   // Unlink ourself from old value
  2358.   if SmallImages <> NIL then
  2359.     SmallImages.UnregisterChanges(FColumnsFormatChangeLink);
  2360.  
  2361.   inherited SmallImages := Value;
  2362.  
  2363.   // Re-link to the new value.
  2364.   if SmallImages <> NIL then
  2365.     SmallImages.RegisterChanges(FColumnsFormatChangeLink);
  2366.  
  2367.   // Force the header to redraw
  2368.   SetColumnsOwnerDrawFlag(assigned(OnDrawHeader) or ShowSortArrows);
  2369. end;
  2370.  
  2371. function TExtListView.GetSelectionMark: integer;
  2372. begin
  2373.   if HandleAllocated then
  2374.     FSelectionMark := ListView_GetSelectionMark(Handle);
  2375.   Result := FSelectionMark;
  2376. end;
  2377.  
  2378. procedure TExtListView.SetSelectionMark(Val: integer);
  2379. begin
  2380.   if Val <> FSelectionMark then
  2381.     FSelectionMark := Val;
  2382.   // Call even if not changed because handle may not have been allocated
  2383.   if HandleAllocated then
  2384.     ListView_SetSelectionMark(Handle, Val);
  2385. end;
  2386.  
  2387. function TExtListView.GetHoverTime: DWORD;
  2388. begin
  2389.   if HandleAllocated then
  2390.     FHoverTime := ListView_GetHoverTime(Handle);
  2391.   Result := FHoverTime;
  2392. end;
  2393.  
  2394. procedure TExtListView.SetHoverTime(Val: DWORD);
  2395. begin
  2396.   if Val <> FHoverTime then
  2397.     FHoverTime := Val;
  2398.   // Call even if not changed because handle may not have been allocated last time
  2399.   if HandleAllocated then
  2400.     ListView_SetHoverTime(Handle, Val);
  2401. end;
  2402.  
  2403. procedure TExtListView.SetRequireComCtlUpdate(Value: boolean);
  2404. begin
  2405.   FRequireComCtlUpdate := Value;
  2406.   if FRequireComCtlUpdate and (not (csDesigning in ComponentState)) then
  2407.   begin
  2408.     if not CheckComCtlVersion(4, 70, 0, 0) then
  2409.       raise EELVOldComCtl.Create('COMCTL32.DLL is older than required version');
  2410.   end;
  2411. end;
  2412.  
  2413. procedure TExtListView.UpdateColumnsImages;
  2414. var
  2415.   i: Integer;
  2416. begin
  2417.   if not (assigned(OnDrawHeader) or ShowSortArrows) then
  2418.     if HandleAllocated then
  2419.       for i := 0 to Columns.Count - 1 do UpdateColumnImage(i);
  2420. end;
  2421.  
  2422. procedure TExtListView.UpdateColumnImage(Index: integer);
  2423.   function ValidImages: boolean;
  2424.   begin
  2425.     Result := assigned(SmallImages) and (SmallImages.Count > 0);
  2426.   end;
  2427. var
  2428.   Column: TLVColumnEx;
  2429. begin { UpdateColumnImage }
  2430.   if assigned(OnDrawHeader) or ShowSortArrows then
  2431.     exit;
  2432.  
  2433.   if HandleAllocated and (Index > -1) and (Index < FColumnsFormat.Count) and
  2434.      ValidImages then
  2435.   begin
  2436.     FillChar(Column, SizeOf(Column), #0);
  2437.     ListView_GetColumnEx(Handle, Index, Column);
  2438.     with Column, FColumnsFormat[Index] do
  2439.     begin
  2440.       if (ImageIndex <> -1) then
  2441.       begin
  2442.         iImage := ImageIndex;
  2443.         // Add LVCF_FMT Just to make sure...
  2444.         mask := mask or LVCF_IMAGE or LVCF_FMT;
  2445.         fmt  := fmt or LVCFMT_IMAGE;
  2446.         if ImageAlignment = ciaRightOfText then
  2447.           fmt := fmt or LVCFMT_BITMAP_ON_RIGHT;
  2448.       end else begin
  2449.         mask := LVCF_FMT;
  2450.         fmt  := fmt and not LVCFMT_IMAGE and not LVCFMT_BITMAP_ON_RIGHT;
  2451.       end;
  2452.       case Columns.Items[Index].Alignment of
  2453.         taLeftJustify: fmt := fmt or LVCFMT_LEFT;
  2454.         taCenter: fmt := fmt or LVCFMT_CENTER;
  2455.         taRightJustify: fmt := fmt or LVCFMT_RIGHT;
  2456.       end;
  2457.     end;
  2458.     ListView_SetColumnEx(Handle, Index, Column);
  2459.   end;
  2460. end;
  2461.  
  2462. function TExtListView.CheckComCtlVersion(MajorHi, MajorLo,
  2463.    MinorHi, MinorLo: word): boolean;
  2464. begin
  2465.   Result := CheckDLLVersion('COMCTL32.DLL', MajorHi, MajorLo, MinorHi, MinorLo);
  2466. end;
  2467.  
  2468. function TExtListView.GetShowSortArrows: boolean;
  2469. begin
  2470.   Result := inherited ShowSortArrows;
  2471. end;
  2472.  
  2473. procedure TExtListView.SetShowSortArrows(Value: boolean);
  2474. begin
  2475.   inherited ShowSortArrows := Value;
  2476.   UpdateColumnsImages;
  2477. end;
  2478.  
  2479. function TExtListView.ActualColumnIndex(Index: integer): integer;
  2480. var
  2481.   x,
  2482.   ColCount: integer;
  2483.   ColArray: PIntArray;
  2484. begin
  2485.   // account for modified column order
  2486.  
  2487.   // Delphi 2 and C++B 1 have a bug in TListColumn.GetWidth.  It returns zero
  2488.   // for the width if the handle hasn't been allocated yet instead of returning
  2489.   // the value of the internal storage variable like Delphi 3 does.  I've also
  2490.   // had some problems similar under Delphi 3, so I'm just always requiring the
  2491.   // handle to be valid.
  2492.   HandleNeeded;
  2493.  
  2494.   Result := 0;
  2495.   ColCount := Columns.Count;
  2496.   if Index >= ColCount then
  2497.     exit;
  2498.  
  2499.   GetMem(ColArray, SizeOf(Integer)*ColCount);
  2500.   try
  2501.     GetColumnOrder(ColCount, ColArray^);
  2502.     for x := 0 to ColCount-1 do
  2503.       if ColArray[x] = Index then
  2504.       begin
  2505.         Result := x;
  2506.         exit;
  2507.       end;
  2508.   finally
  2509.     FreeMem(ColArray);
  2510.   end;
  2511. end;
  2512.  
  2513. function TExtListView.GetVersion: TDFSVersion;
  2514. begin
  2515.   Result := DFS_COMPONENT_VERSION;
  2516. end;
  2517.  
  2518.  
  2519. { TExtListColumn }
  2520.  
  2521. constructor TExtListColumn.Create(Collection: TCollection);
  2522. begin
  2523.   inherited Create(Collection);
  2524.   FSmallImageIndex := -1;
  2525.   FImageAlignment := ciaRightOfText;
  2526. end;
  2527.  
  2528. destructor TExtListColumn.Destroy;
  2529. begin
  2530.   FSmallImageIndex := -1;
  2531.   FImageAlignment := ciaRightOfText;
  2532.  
  2533.   inherited Destroy;
  2534. end;
  2535.  
  2536. procedure TExtListColumn.DoChange;
  2537. var
  2538.   i: Integer;
  2539. begin
  2540.   for i := 0 to Collection.Count-1 do
  2541.     Changed(i <> Collection.Count);
  2542. end;
  2543.  
  2544. procedure TExtListColumn.SetSmallImageIndex(Value: Integer);
  2545. begin
  2546.   if FSmallImageIndex <> Value then
  2547.   begin
  2548.     FSmallImageIndex := Value;
  2549.     DoChange;
  2550.   end;
  2551. end;
  2552.  
  2553. procedure TExtListColumn.SetImageAlignment(Value: TColumnImageAlign);
  2554. begin
  2555.   if FImageAlignment <> Value then
  2556.   begin
  2557.     FImageAlignment := Value;
  2558.     DoChange;
  2559.   end;
  2560. end;
  2561.  
  2562. procedure TExtListColumn.Assign(Source: TPersistent);
  2563. var
  2564.   Column: TExtListColumn;
  2565. begin
  2566.   if Source is TExtListColumn then
  2567.   begin
  2568.     Column := TExtListColumn(Source);
  2569.     ImageIndex := Column.ImageIndex;
  2570.     ImageAlignment  := Column.ImageAlignment;
  2571.   end else
  2572.     inherited Assign(Source);
  2573. end;
  2574.  
  2575. constructor TExtListColumns.Create(AOwner: TExtListView);
  2576. begin
  2577.   inherited Create(TExtListColumn);
  2578.   FOwner := AOwner;
  2579. end;
  2580.  
  2581. function TExtListColumns.GetItem(Index: Integer): TExtListColumn;
  2582. begin
  2583.   Result := TExtListColumn(inherited GetItem(Index));
  2584. end;
  2585.  
  2586. procedure TExtListColumns.SetItem(Index: Integer; Value: TExtListColumn);
  2587. begin
  2588.   inherited SetItem(Index, Value);
  2589. end;
  2590.  
  2591. function TExtListColumns.Add: TExtListColumn;
  2592. begin
  2593.   Result := TExtListColumn(inherited Add);
  2594. end;
  2595.  
  2596. function TExtListColumns.GetOwner: TPersistent;
  2597. begin
  2598.   Result := FOwner;
  2599. end;
  2600.  
  2601. procedure TExtListColumns.Update(Item: TCollectionItem);
  2602. begin
  2603.   if Owner <> NIL then
  2604.   begin
  2605.     if Item <> NIL then
  2606.       Owner.UpdateColumnImage(Item.Index)
  2607.     else
  2608.       Owner.UpdateColumnsImages;
  2609.   end;
  2610. end;
  2611.  
  2612. procedure TExtListColumns.Refresh;
  2613. begin
  2614.   if Owner <> NIL then
  2615.     Owner.UpdateColumnsImages;
  2616. end;
  2617.  
  2618. procedure TExtListColumns.Assign(Source: TPersistent);
  2619. begin
  2620.   Clear;
  2621.   inherited Assign(Source);
  2622. end;
  2623.  
  2624.  
  2625. function CheckDLLVersion(const DLLName: string; MajorHi, MajorLo,
  2626.    MinorHi, MinorLo: word): boolean;
  2627. var
  2628.   VerInfoSize: DWORD;
  2629.   VerInfo: Pointer;
  2630.   VerValueSize: DWORD;
  2631.   VerValue: PVSFixedFileInfo;
  2632.   Dummy: DWORD;
  2633.   V1, V2, V3, V4: word;
  2634. begin
  2635.   Result := FALSE;
  2636.   VerInfoSize := GetFileVersionInfoSize(PChar(DLLName), Dummy);
  2637.   if VerInfoSize = 0 then
  2638.     exit;
  2639.   GetMem(VerInfo, VerInfoSize);
  2640.   if not assigned(VerInfo) then
  2641.     exit;
  2642.   try
  2643.     if GetFileVersionInfo(PChar(DLLName), 0, VerInfoSize, VerInfo) then
  2644.     begin
  2645.       if VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize) then
  2646.       begin
  2647.         with VerValue^ do
  2648.         begin
  2649.           V1 := dwFileVersionMS shr 16;
  2650.           V2 := dwFileVersionMS and $FFFF;
  2651.           V3 := dwFileVersionLS shr 16;
  2652.           V4 := dwFileVersionLS and $FFFF;
  2653.         end;
  2654.         { This would be SO much easier with D4's int64 type... }
  2655.         if V1 < MajorHi then
  2656.           Result := FALSE
  2657.         else if V1 > MajorHi then
  2658.           Result := TRUE
  2659.         else begin
  2660.           if V2 < MajorLo then
  2661.             Result := FALSE
  2662.           else if V2 > MajorLo then
  2663.             Result := TRUE
  2664.           else begin
  2665.             if V3 < MinorHi then
  2666.               Result := FALSE
  2667.             else if V3 > MinorHi then
  2668.               Result := TRUE
  2669.             else begin
  2670.               if V4 < MinorLo then
  2671.                 Result := FALSE
  2672.               else if V4 > MinorLo then
  2673.                 Result := TRUE;
  2674.             end;
  2675.           end;
  2676.         end;
  2677.       end;
  2678.     end;
  2679.   finally
  2680.     FreeMem(VerInfo, VerInfoSize);
  2681.   end;
  2682. end;
  2683.  
  2684.  
  2685. initialization
  2686. {$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  2687. //  OleInitialize(NIL);
  2688.   CoInitialize(NIL);
  2689. {$ENDIF}
  2690. finalization
  2691. {$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  2692. //  OleUninitialize;
  2693.   CoUninitialize;
  2694. {$ENDIF}
  2695. end.
  2696.  
  2697.