systemlistview.pas

动态提示控件

{$I DFS.INC}                    { Defines for all Delphi Free Stuff components }
{$I SYSTEMCONTROLPACK.INC}      { Defines specific to these components }

{ -----------------------------------------------------------------------------}
{ TdfsSystemListView                                                           }
{ -----------------------------------------------------------------------------}
{ A list view control that acts as the list in the Windows Explorer.  This is  }
{ part of the System Control Pack.                                             }
{                                                                              }
{ Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
{                                                                              }
{ Copyright:                                                                   }
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
{ property of the author.                                                      }
{                                                                              }
{ Distribution Rights:                                                         }
{ You are granted a non-exlusive, royalty-free right to produce and distribute }
{ compiled binary files (executables, DLLs, etc.) that are built with any of   }
{ the DFS source code unless specifically stated otherwise.                    }
{ You are further granted permission to redistribute any of the DFS source     }
{ code in source code form, provided that the original archive as found on the }
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
{ example, if you create a descendant of TDFSColorButton, you must include in  }
{ the distribution package the colorbtn.zip file in the exact form that you    }
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
{                                                                              }
{ Restrictions:                                                                }
{ Without the express written consent of the author, you may not:              }
{   * Distribute modified versions of any DFS source code by itself. You must  }
{     include the original archive as you found it at the DFS site.            }
{   * Sell or lease any portion of DFS source code. You are, of course, free   }
{     to sell any of your own original code that works with, enhances, etc.    }
{     DFS source code.                                                         }
{   * Distribute DFS source code for profit.                                   }
{                                                                              }
{ Warranty:                                                                    }
{ There is absolutely no warranty of any kind whatsoever with any of the DFS   }
{ source code (hereafter "software"). The software is provided to you "AS-IS", }
{ and all risks and losses associated with it's use are assumed by you. In no  }
{ event shall the author of the softare, Bradley D. Stowers, be held           }
{ accountable for any damages or losses that may occur from use or misuse of   }
{ the software.                                                                }
{                                                                              }
{ Support:                                                                     }
{ Support is provided via the DFS Support Forum, which is a web-based message  }
{ system.  You can find it at http://www.delphifreestuff.com/discus/           }
{ All DFS source code is provided free of charge. As such, I can not guarantee }
{ any support whatsoever. While I do try to answer all questions that I        }
{ receive, and address all problems that are reported to me, you must          }
{ understand that I simply can not guarantee that this will always be so.      }
{                                                                              }
{ Clarifications:                                                              }
{ If you need any further information, please feel free to contact me directly.}
{ This agreement can be found online at my site in the "Miscellaneous" section.}
{------------------------------------------------------------------------------}
{ The lateset version of my components are always available on the web at:     }
{   http://www.delphifreestuff.com/                                            }
{ See SCP.txt for notes, known issues, and revision history.                   }
{ -----------------------------------------------------------------------------}
{ Date last modified:  June 28, 2001                                           }
{ -----------------------------------------------------------------------------}

unit SystemListView;

interface

{$IFNDEF DFS_SCP_SYSLISTVIEW}
  'Error, shouldn''t be compiling this unit!'
{$ENDIF}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  {$IFDEF DFS_COMPILER_3_UP} ShlObj, ActiveX, {$ELSE} MyShlObj, OLE2, {$ENDIF}
  {$IFDEF DFS_DEBUG} MMSystem, {$ENDIF}
  SystemControlPack, PidlHelp, ItemProp, Menus, ComCtrls, StdCtrls,
  CommCtrl, _Res__IDs;

const
  DFS_COMPONENT_LIST_VERSION = 'TdfsSystemListView ' + DFS_SCP_VERSION;

{$IFDEF DFS_COMPILER_3_UP}
resourcestring
{$ELSE}
const
{$ENDIF}
  strColName        = 'Name';
  strColType        = 'Type';
  strColTotalSize   = 'Total Size';
  strColFreeSpace   = 'Free Space';
  strColDescription = 'Description';
  strColDocuments   = 'Documents';
  strColPhone       = 'Phone #';
  strColStatus      = 'Status';
  strColComment     = 'Comment';
  strColEntryName   = 'Entry name';
  strColDeviceName  = 'Device name';
  strColSize        = 'Size';
  strColModified    = 'Modified';
  strColUserDefined = 'User defined';
  strKilobytes      = ' KB';
  strColAttrib      = 'Attributes';
  strSystemFolder   = 'System Folder';

  strReadOnlyChar   = 'R';
  strHiddenChar     = 'H';
  strSystemChar     = 'S';
  strArchiveChar    = 'A';

type
  TSLVAddListItem = procedure(Sender: TObject; AItem: TListItem) of object;
  TSLVCreateColumns = TNotifyEvent;
  TColumnType = (ctFileSystem, ctMachine, ctControlPanel, ctPrinters, ctDUNet,
     ctNetwork, ctUser, ctUnknown);

  TdfsSystemListView = class(TdfsCustomSystemListView)
  private
    FCurrentPIDL: PItemIDList;
    FCurrentShellFolder: IShellFolder;
    FLastNodeWasDesktop: boolean;
    FFileMask: string;
    FFileMaskList: TStringList;
    FNeedsReset: boolean;
    FPopupMenuMethod: TPopupMenuMethod;
    FOnCreateColumns: TSLVCreateColumns;
    FAutoscroll: boolean;
    FOnAddListItem: TSLVAddListItem;
    FShowErrorsInMsgBox: boolean;
    FLastNode: TTreeNode;
    // This will eventually be a set of attributes (system, read-only, etc.)
    FShowHiddenFiles: boolean;
    FShowFolders: boolean;
    FColumnType: TColumnType;
    FColumnWidths: record
      cwName, cwSize, cwType, cwModified, cwAttr: integer;
    end;
    FRecreatingWnd: boolean;
    {$IFNDEF DFS_SLV_USING_ELV}
    FLastSortOrder : ByteBool;
    FLastColumnIndexSort : Integer;
    {$ENDIF}

    FOnPopulated: TNotifyEvent;

    function AddItemData(ItemFolder: IShellFolder; aIDList,
       aFQ_IDList: PItemIDList; Attrs: UINT): TFolderItemData;
    procedure FreeItemData(Item: TListItem);
    procedure FreeAllItemData;
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
    {$IFDEF DFS_COMPILER_5_UP}
    procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
    {$ELSE}
    procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
    {$ENDIF}
  protected
    { Base Class Abstract Implementations }
    // Implementation must return the actual ID list.  Caller will make a copy
    // of it it wants it's own.  Implementer owns this one, i.e. it's the "real
    // thing".  If there isn't one, return NIL.
    function GetSelectionPIDL: PItemIDList; override;
    function GetSelectionParentFolder: IShellFolder; override;

    // Implementation notes: IDList parameter belongs to someone else.  If
    // needed by this component, a copy must be made of it.  This differs from
    // the Reset method in that it does not notify linked controls of a change
    // because that could result in an endless cycle of notifications. Return
    // value indicates success or failure.
    function LinkedReset(const ParentFolder: IShellFolder;
       const IDList: PItemIDList; ForceUpdate: boolean): boolean; override;

    function GetItemFromAPIItem(const Item: TLVItem): TListItem;
    procedure CreateColumns(ColType: TColumnType); dynamic;
    procedure SetColumnType(ColType: TColumnType);
    procedure SetShowFolders(Val: boolean);
    function GetFilename(Index: TListItem): string;
    function GetFullFilename(Index: TListItem): string;
    function CanEdit(Item: TListItem): boolean; override;
    procedure Edit(const Item: TLVItem); override;
    function GetVersion: string; {$IFDEF DFS_SLV_USING_ELV} override; {$ENDIF}
    {$IFNDEF DFS_SLV_USING_ELV}
    procedure SetVersion(const Val: string);
    {$ENDIF}
    function GetItems: TListItems;
    procedure SetFileMask(const Val: string);

    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure Loaded; override;
    function GetPopupMenu: TPopupMenu; override;
    function EnumerateFiles(const Folder: IShellFolder;
       const IDList: PItemIDList): boolean;
    function GetItemData(Item: TListItem): TFolderItemData;
    function AddNode(const ShellFolder: IShellFolder; FQ_IDList,
       IDList: PItemIDList): TListItem; dynamic;

    {$IFNDEF DFS_SLV_USING_ELV}
    // Added by Fabrice FOUQUET 30/03/98
    // To change the sort
    procedure ColClick(Column: TListColumn); override;
    function CustomSort(SortProc: TLVCompare; Data: Longint): Boolean; dynamic;
    function AlphaSort: Boolean; 
    {$ENDIF}
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Compute_ListMoves(X, Y: integer); dynamic;
    procedure DblClick; override;
    procedure Populated; dynamic;
    function FindItemFromID(AnID: PItemIDList): TListItem;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    // Useful functions for applications.  These modify permanently, not just
    // the item.  i.e. if you rename 'My Computer' to 'Crasher', it is renamed
    // system wide, not just in your app.  If you delete the 'C:\WINDOWS'
    // folder, you are in deep trouble and I deny any responsibility.
    function RenameItem(const Item: TListItem; const NewName: string): boolean;
    function DeleteItem(const Item: TListItem): boolean;
    // Move up one directory, i.e. "cd .."
    procedure ChangeToParent;

    procedure DefaultDblClickAction(Item: TListItem);
    procedure Reset; override;
    procedure RecreateColumns; virtual;
    function DisplayContextMenu(Item: TListItem; Where: TPoint): boolean;
       dynamic;
    function DisplaySelectedContextMenu(Where: TPoint): boolean; dynamic;

    procedure SetColumnWidths(NameWidth, SizeWidth, TypeWidth, ModifiedWidth,
       AttrWidth: integer);
    function GetItemAttrs(const Item: TListItem): UINT;
    function GetFullPath(const Item: TListItem): string;
    // The var parameter of this function is a memory block allocated with
    // GetMem.  The caller of the function MUST release the memory with FreeMem
    // when done with the array. The PPIDLArray type is defined in the ItemProp
    // unit. The return value is the number of items in the array.
    function GetSelectedPIDLs(var SelPIDLs: PPIDLArray): integer;

    property ShowErrorsInMsgBox: boolean
       read FShowErrorsInMsgBox write FShowErrorsInMsgBox default TRUE;
    property Items
       read GetItems;
    property Filename[Index: TListItem]: string
       read GetFilename;
    property FullFilename[Index: TListItem]: string
       read GetFullFilename;
    property ItemData[Item: TListItem]: TFolderItemData
       read GetItemData;

    property Columns;
    {$IFDEF DFS_SLV_USE_EXTLISTVIEW}
    property LastColumnClicked;
    property CurrentColumnWidth;
    property HeaderHandle;
    property SubItem_BoundsRect;
    property SubItem_IconRect;
    property SubItem_LabelRect;
    property SubItem_SelectBoundsRect;
    property HotItem;
    property HotCursor;
    property WorkArea;
    property IsChecked;
    property SubItem_ImageIndex;
    property SelectionMark;
    property ItemIndent;
    property CurrentSortAscending;
    {$ELSE}
    {$IFDEF DFS_SLV_USE_ENHLISTVIEW}
    property HeaderHandle;
    property CurrentSortAscending;
    property LastColumnClicked;
    property CurrentColumnWidth;
    {$ENDIF}
    {$ENDIF}
  published
    property Version: string
       read GetVersion
       write SetVersion
       stored FALSE;
    property PopupMenuMethod: TPopupMenuMethod
       read FPopupMenuMethod
       write FPopupMenuMethod
       default pmmContextUser;
    property ColumnType: TColumnType
       read FColumnType write SetColumnType default ctFileSystem;
    property ShowHiddenFiles: boolean
       read FShowHiddenFiles write FShowHiddenFiles default TRUE;
    property ShowFolders: boolean
       read FShowFolders write SetShowFolders default TRUE;
    property Autoscroll: boolean
       read FAutoscroll write FAutoscroll default FALSE;
    property FileMask: string
       read FFileMask write SetFileMask;


    property OnCreateColumns: TSLVCreateColumns
       read FOnCreateColumns write FOnCreateColumns;
    property OnAddListItem: TSLVAddListItem
       read FOnAddListItem write FOnAddListItem;
    property OnPopulated: TNotifyEvent
       read FOnPopulated write FOnPopulated;

    {$IFDEF DFS_SCP_SYSTREEVIEW}
    property TreeView;
    {$ENDIF}
    {$IFDEF DFS_SCP_SYSCOMBOBOX}
    property ComboBox;
    {$ENDIF}

    {$IFDEF DFS_SLV_USE_EXTLISTVIEW}
    property HideSelection;
    property ExtendedStyles;
    property VirtualMode;
    property HoverTime;
    property RequireComCtlUpdate;
    {$IFDEF DFS_TRY_BACKGROUND_IMAGE}
    property BackgroundImage;
    {$ENDIF}
    property SaveSettings;
    property ColumnsFormat;
    // New Events
    property OnMarqueeBegin;
    property OnItemActivate;
    property OnHotTrack;
    {$IFDEF DFS_TRY_INFOTIP}
    property OnInfoTip;
    {$ENDIF}
    property OnVMGetItemInfo;
    property OnVMCacheHint;
    property OnVMFindItem;
    property OnVMStateChanged;
    property ShowSortArrows;


    // Publish inherited protected properties
    property AutoColumnSort;
    property AutoSortStyle;
    property AutoResort;
    property AutoSortAscending;
    property ReverseSortArrows;
    property Style;

    property OnDrawHeader;
    property OnMeasureItem;
    property OnDrawItem;
    property OnDrawSubItem;
    property OnAfterDefaultDrawItem;
    property OnSortItems;
    property OnSortBegin;
    property OnSortFinished;
    property OnEditCanceled;


    property Align;
    {$IFDEF DFS_COMPILER_4_UP}
    property Anchors;
    property BiDiMode;
    {$ENDIF}
    property BorderStyle;
    {$IFDEF DFS_COMPILER_4_UP}
    property BorderWidth;
    {$ENDIF}
    property Color;
    property ColumnClick;
    {$IFDEF DFS_COMPILER_4_UP}
    property Constraints;
    {$ENDIF}
    property OnClick;
    property OnDblClick;
    property Ctl3D;
    property DragMode;
    {$IFDEF DFS_COMPILER_4_UP}
    property DragKind;
    {$ENDIF}
    property ReadOnly
       default False;
    property Enabled;
    property Font;
    property IconOptions;
    property AllocBy;
    property MultiSelect;
    property OnChange;
    property OnChanging;
    property OnColumnClick;
    property OnDeletion;
    property OnEdited;
    property OnEditing;
    {$IFDEF DFS_COMPILER_4_UP}
    property OnEndDock;
    {$ENDIF}
    property OnEnter;
    property OnExit;
    property OnInsert;
    property OnDragDrop;
    property OnDragOver;
    property DragCursor;
    property OnStartDrag;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    {$IFDEF DFS_COMPILER_4_UP}
    property OnResize;
    property OnSelectItem;
    property OnStartDock;
    {$ENDIF}
    property ParentColor
       default False;
    property ParentFont;