systemcombobox.pas

动态提示控件

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

{ -----------------------------------------------------------------------------}
{ TdfsSystemComboBox                                                           }
{ -----------------------------------------------------------------------------}
{ A combo box control that acts as the combo box in the Windows Explorer.      }
{ This is part of the System Control Pack.                                     }
{ Copyright 1999, Andrew Barnes and Brad Stowers.  All Rights Reserved.        }
{ -----------------------------------------------------------------------------}
{ NOTE:  This component was originally developed entirely by Andrew Barnes.    }
{   Originally, I wanted to keep it as close to his originally code as         }
{   possible, while still making it work with the tree/list view components.   }
{   However, during this integration of the components, I found that it simply }
{   wasn't going to work well that way.  After discussing this with Andrew,    }
{   he agreed to let me "adopt" the code and modify it as needed in order to   }
{   make it work well with the other components.  While I've made a lot of     }
{   changes to this component, the core of it is still what Andrew developed   }
{   and shared with us.  He deserves a huge amount of thanks for doing this,   }
{   as it seemed I was never going to get to it myself.                        }
{ -----------------------------------------------------------------------------}
{                                                                              }
{ 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 SystemComboBox;

interface

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

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  {$IFDEF DFS_COMPILER_4_UP} ImgList, {$ENDIF}
  {$IFDEF DFS_COMPILER_3_UP} ShlObj, ActiveX, {$ELSE} MyShlObj, OLE2, {$ENDIF}
  StdCtrls, ComCtrls, SystemControlPack;

const
  DFS_COMPONENT_COMBO_VERSION = 'TdfsSystemComboBox ' + DFS_SCP_VERSION;

type
  TShellItem = class
  public
    ParentShellFolder,            // parent shell folder
    ShellFolder: IShellFolder;    // shell folder for this shell item
    FullID,                       // a fully qualified ID
    ID: PItemIDList;              // ID releative to the parent shell folder
    FullPathName,                 // a fully qualified path
    RelativePathName: string;     // path relative to the parent
    NormalIndex,                  // normal system image list index
    SelectedIndex,                // selected system image list index
    Indent: integer;              // indent for sub items
    ParentItem: TShellItem;       // parent shellitem
    Removeable: boolean;          // used to keep the default items in the list
    ChildList: TList;             // list of child items, this could be removed
                                  // with some code changes.
    constructor Create; {$IFDEF DFS_COMPILER_4_UP} reintroduce; {$ENDIF}
    destructor Destroy; override;
    procedure AddChild(Item: TShellItem);
  end;

  TdfsSystemComboBox = class(TdfsCustomSystemComboBox)
  private
    FDrawInEdit: boolean;          // boolean used for first item when dropped
    FPIDL: PItemIDList;            // root(desktop) folder's ItemIDList
    FDesktopFolder: IShellFolder;  // Shell folder used for the desktop
    FDesktopShellItem: TShellItem; // The shell item associated with the desktop
    FActiveFolderIDList: PItemIDList; // ActiveFolderIDList property decleration
    FRecreatingWnd: boolean;

    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure WMDeleteItem(var Message: TWMDeleteItem); message WM_DELETEITEM;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;

    function GetActiveFolderName: string;
    procedure SetActiveFolderName(const Value: string);
    procedure SetActiveFolderIDList(const Value: PItemIDList);
    procedure EnumerateSubItems(const ParentShellItem: TShellItem;
       const InsertIndex: integer; const CanDelete: boolean);
    procedure AddShellItem(const ParentShellItem: TShellItem;
       const NewID: PItemIDList; const CanDelete: boolean);
    procedure AddSubItems(ShellItem: TShellItem);
    procedure InsertSubItems(ShellItem: TShellItem; InsertIndex: integer);
    procedure RemoveAllItems;
    function GetActiveFolderIDList: PItemIDList;
    function GetVersion: string;
    procedure SetVersion(const Val: string);
  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;
    procedure PopulateCombo;
    
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure Loaded; override;
    procedure DrawItem(Index: integer; Rect: TRect;
       State: TOwnerDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Reset; override;
    // Move up one directory, i.e. "cd .."
    procedure ChangeToParent;

    // Can't publish this because it could be system dependent.
    property ActiveFolderName: string
       read GetActiveFolderName
       write SetActiveFolderName;
    property ActiveFolderIDList: PItemIDList
       read GetActiveFolderIDList
       write SetActiveFolderIDList;
  published
    {$IFDEF DFS_SCP_SYSTREEVIEW}
    property TreeView;
    {$ENDIF}
    {$IFDEF DFS_SCP_SYSLISTVIEW}
    property ListView;
    {$ENDIF}
    property Version: string
       read GetVersion
       write SetVersion
       stored FALSE;
//    property Style; -- It's always owner drawn, don't publish it.
    property Align;
    {$IFDEF DFS_COMPILER_4_UP}
    property Anchors;
    property BiDiMode;
    {$ENDIF}
    property Color;
    {$IFDEF DFS_COMPILER_4_UP}
    property Constraints;
    {$ENDIF}
    property Ctl3D;
    property DragMode;
    property DragCursor;
    {$IFDEF DFS_COMPILER_4_UP}
    property DragKind;
    {$ENDIF}
    property DropDownCount;
    property Enabled;
    property Font;
    {$IFDEF DFS_COMPILER_3_UP}
    property ImeMode;
    property ImeName;
    {$ENDIF}
    property ItemHeight;
    property MaxLength;
    {$IFDEF DFS_COMPILER_4_UP}
    property ParentBiDiMode;
    {$ENDIF}
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
//    property Sorted;  -- We sort it internally.
    property TabOrder;
    property TabStop;
//    property Text;  -- not an editable combo, so makes no sense to publish.
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    {$IFDEF DFS_COMPILER_4_UP}
    property OnEndDock;
    {$ENDIF}
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    {$IFDEF DFS_COMPILER_4_UP}
    property OnStartDock;
    {$ENDIF}
    property OnStartDrag;
  end;

implementation

uses
  PidlHelp, CommCtrl,
  {$IFDEF DFS_DEBUG} uDbg, {$ENDIF}
  {$IFDEF DFS_COMPILER_3_UP} ComObj, {$ELSE} OleAuto, {$ENDIF}
  ShellAPI;


{*******************************************************************************
function:     GetShellImage
Parameters:   PIDL        PItemIDList
              Large       Boolean
              Open        Boolean
Result:       Integer
Notes:
  This function returns the index of PIDL in the system image list.
  If Large is open, it returns the Large image index.
  If Open is true, it returns the Open image index.

Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial from VirtualListViewDemo
*******************************************************************************}
function GetShellImage(PIDL: PItemIDList; Large, Open: Boolean): Integer;
var
  FileInfo: TSHFileInfo;
  Flags: Integer;
begin
  FillChar(FileInfo, SizeOf(FileInfo), #0);
  Flags := SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_ICON;
  if Open then
    Flags := Flags or SHGFI_OPENICON;
  if Large then
    Flags := Flags or SHGFI_LARGEICON
  else
    Flags := Flags or SHGFI_SMALLICON;
  SHGetFileInfo(PChar(PIDL), 0, FileInfo, SizeOf(FileInfo), Flags);
  Result := FileInfo.iIcon;
end;

{*******************************************************************************
function:     SortChildren
Parameters:   Item1, Item2 Pointer
Result:       Integer
Notes:
  This function is the sort algorithum used for sorting child items.
  This is requured by the Tlist's sort method.  Sort implementation
  was taken from SystemTreeViews sort of child nodes but modified for my
  component.

  Origional source by Brad Stowers

Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial from SystemTreeView
*******************************************************************************}
function SortChildren(Item1, Item2: Pointer): Integer;
begin
  if Item1 = Item2 then
    Result := 0
  else if Item1 = NIL then
    Result := -1
  else if Item2 = NIL then
    Result := 1
  else begin
    // Status is returned in the 'code' portion (low word) of the result.
    // Search for 'HResult' in Winodws.pas to read more about it.
    // 0 means sort by name.
    Result := shortint(TShellItem(Item1).ParentShellFolder.CompareIDs(0,
       TShellItem(Item1).ID, TShellItem(Item2).ID));
  end;
end;

{ TShellItem }

{*******************************************************************************
constructor  TShellItem.Create
Parameters None
Notes:
  This proceudre allocates a child list for the shell item
Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
*******************************************************************************}
constructor TShellItem.Create;
begin
  inherited Create;

  ChildList := TList.Create;
end;

{*******************************************************************************
Destructor  TShellItem.Destroy
Parameters None
Notes:
  This proceudre frees the dynamic memory used by this ShellItem
Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
1999/02/15        [e-mail]: D2/C1 compatibility, plugged memory leak.
*******************************************************************************}
destructor TShellItem.Destroy;
var
  Same: boolean;
begin
  {$IFNDEF DFS_NO_COM_CLEANUP}
  if ParentShellFolder <> NIL then
    ParentShellFolder.Release;
  if ShellFolder <> NIL then
    ShellFolder.Release;
  {$ENDIF}
  Same := ComparePIDLs(ID, FullID);
  FreePIDL(ID);
  if not Same then
    FreePIDL(FullID);
  ChildList.Free;

  inherited Destroy;
end;

{*******************************************************************************
procedure  TShellItem.AddChild
Parameters Item  TShellItem
Notes:
  This proceudre adds a child item to the list oc child items for this
  Shell item
Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
*******************************************************************************}
procedure TShellItem.AddChild(Item: TShellItem);
begin
  ChildList.Add(Item);
  ChildList.Sort(SortChildren);
end;


{ TdfsSystemComboBox }