systemcombobox.pas

动态提示控件

{*******************************************************************************
Constructor:  TdfsSystemComboBox.Create
Parameters:   AOwner  TComponent
Notes:
  This constructor is based on the constructor for the SysTreeView component.
  Gets access to the system image list and sets the initializes the comobox
  style.

Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial from SystemTreeView
1999/02/15        [e-mail]: Moved image list stuff into SetupImageList
                                      in base class.
*******************************************************************************}
constructor TdfsSystemComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Style := csOwnerDrawFixed;
end;

{*******************************************************************************
Destructor:   TdfsSystemComboBox.Destroy
Parameters:
Notes:
  Clean up allocations

Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
1999/02/15        [e-mail]: D2/C1 compatibility, plugged pidl leak.
*******************************************************************************}
destructor TdfsSystemComboBox.Destroy;
begin
  // Easiest way to free the associated objects
{  while Items.Count > 0 do
    Items.Delete(Items.Count - 1);}
    
  { FDesktopShellItem, FDesktopFolder and FPIDL are in the Objects property, so
    they will be released when all the rest of the items are delete.  We don't
    need to do it here.  Only FActiveFolderIDList is "unowned". }
  FreePIDL(FActiveFolderIDList);

  inherited Destroy;
end;

procedure TdfsSystemComboBox.PopulateCombo;
var
  ShellItem: TShellItem;
  InsertIndex, x: integer;
  MyComputerPIDL: PItemIDList;
  NoPIDL: PItemIDList;
  Attrs: DWORD;
begin
  if (not HandleAllocated) or (csLoading in ComponentState) then
    exit;

{$IFDEF DFS_DEBUG} Debugger.EnterProc('SCB.Reset'); {$ENDIF}

  // remove all items from the the list
  RemoveAllItems;
  // get the desktop shell folder
  SHGetDesktopFolder(FDesktopFolder);
  {$IFNDEF DFS_NO_COM_CLEANUP} FDesktopFolder.AddRef; {$ENDIF}

  // Invalidate cached information.
  NoPIDL := NIL;
  Attrs := SFGAO_VALIDATE;
  FDesktopFolder.GetAttributesOf(0, NoPIDL, Attrs);

  OLECheck(SHGetSpecialFolderLocation(GetValidHandle, CSIDL_DESKTOP, FPIDL));

  // add the desktop shell item
  FDesktopShellItem := TShellItem.Create;
  FDesktopShellItem.ID := FPIDL;
  FDesktopShellItem.FullID := FPIDL;
  FDesktopShellItem.NormalIndex := GetShellImage(FPIDL, TRUE, FALSE);
  FDesktopShellItem.SelectedIndex := GetShellImage(FPIDL, FALSE, TRUE);
  FDesktopShellItem.FullPathName := GetDisplayName(FDesktopFolder, FPIDL,
     dntForParsing);
  FDeskTopShellItem.RelativePathName := GetDisplayName(FDesktopFolder, FPIDL,
     dntNormal);
  FDesktopShellItem.Indent := 0;
  FDesktopShellItem.ParentShellFolder := NIL;
  FDesktopShellItem.ShellFolder := FDesktopFolder;
  {$IFNDEF DFS_NO_COM_CLEANUP} FDesktopShellItem.ShellFolder.AddRef; {$ENDIF}
  FDesktopShellItem.Removeable := FALSE;
  Items.AddObject(FDesktopShellItem.RelativePathName, FDesktopShellItem);

  // now add the sub items
  EnumerateSubItems(FDesktopShellItem, 0, FALSE);
  AddSubItems(FDesktopShellItem);

  // now find and populate the 'My Computer' node.
  InsertIndex := 0;
  ShellItem := NIL;
  SHGetSpecialFolderLocation(GetValidHandle, CSIDL_DRIVES, MyComputerPIDL);
  try
    for x := 0 to Items.Count-1 do
    begin
      if ComparePIDLs(TShellItem(Items.Objects[x]).FullID, MyComputerPIDL) then
      begin
        ShellItem := TShellItem(Items.Objects[x]);
        InsertIndex := x;
        break;
      end;
    end;
  finally
    FreePIDL(MyComputerPIDL);
  end;

  if ShellItem <> NIL then
  begin
    EnumerateSubItems(ShellItem, InsertIndex, FALSE);
    InsertSubItems(ShellItem, InsertIndex);
  end;
end;

{*******************************************************************************
Procedure:  TdfsSystemComboBox.Reset
Parameters:
Notes:
  This proceudre overrides the default reset, removing all items, and reseting
  to the default items. Selected is set to the desktop after rest.

Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
1999/02/15        [e-mail]: D2/C1 compatibility.
                                      Plugged pidl leak.
                                      Fixed hard-coded "My Computer" reference.
                                      Fixed compiler warning about uninit var.
                                      PidlHelp unit changes.
*******************************************************************************}
procedure TdfsSystemComboBox.Reset;
begin
{$IFDEF DFS_DEBUG} Debugger.EnterProc('SCB.Reset'); {$ENDIF}

  PopulateCombo;
  ItemIndex := 0;
  inherited Reset;

{$IFDEF DFS_DEBUG} Debugger.LeaveProc('SCB.Reset'); {$ENDIF}

end;

{*******************************************************************************
Procedure:  TdfsSystemComboBox.AddSubItems
Parameters: ShellItem   TShellItem
Notes:
  This proceudre adds the sub items of the shellfoler pointed to by the
  ShellFolder property of the passed parameter ShellItem to the list of items.
  Items are added to the end of the list.  The items are assumed to be in the
  ChildList of ShellItem.

Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
*******************************************************************************}
procedure TdfsSystemComboBox.AddSubItems(ShellItem: TShellItem);
var
  x: integer;
  NewShellItem: TShellItem;
begin
  for x := 0 to ShellItem.ChildList.Count-1  do
  begin
    NewShellItem := TShellItem(ShellItem.ChildList.Items[x]);
    Items.AddObject(NewShellItem.RelativePathName, NewShellItem);
  end;
end;

{*******************************************************************************
Procedure:  TdfsSystemComboBox.InsertSubItems
Parameters: ShellItem   TShellItem
            InserIndex  Integer
Notes:
  This proceudre adds the sub items of the shellfoler pointed to by the
  ShellFolder property of the passed parameter ShellItem to the list of items.
  Items are added after InsertIndex.  The items are assumed to be in the
  ChildList of ShellItem.

Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
*******************************************************************************}
procedure TdfsSystemComboBox.InsertSubItems(ShellItem: TShellItem;
   InsertIndex: integer);
var
  x: integer;
  NewShellItem: TShellItem;
begin
  for x := ShellItem.ChildList.Count-1 downto 0 do
  begin
    NewShellItem := TShellItem(ShellItem.ChildList.Items[x]);
    Items.InsertObject(InsertIndex+1, NewShellItem.RelativePathName,
       NewShellItem);
  end;
end;

{*******************************************************************************
Procedure:  TdfsSystemComboBox.EnumerateSubItems
Parameters: ParentShellItem   TShellItem
            InserIndex  Integer
            CanDelete    Boolean
Notes:
  This proceudre enumerates sub items of the shellfoler pointed to by the
  ShellFolder property of the passed parameter ParentShellItem to the ChildList
  of ParentShellItem.

  CanDelete is passed to set the Removeable property of the sub items added.
Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
1999/02/15        [e-mail]: D2/C1 compatibility, made a little more
                                      robust.
*******************************************************************************}
procedure TdfsSystemComboBox.EnumerateSubItems(const ParentShellItem: TShellItem;
   const InsertIndex: integer; const CanDelete: boolean);
const
  FLAGS = SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN;
var
  NewID: PItemIDList;
  NumIDs: ULONG;
  EnumList: IEnumIDList;
begin
  if Succeeded(ParentShellItem.ShellFolder.EnumObjects(GetValidHandle, FLAGS,
     EnumList)) then
  begin
    while EnumList.Next(1, NewID, NumIDs) = S_OK do
    begin
      AddShellItem(ParentShellItem, NewID, CanDelete);
// Could make a little more efficient by changing AddShellItem to use this ID instead of copying it and freeing it here.
      FreePIDL(NewID);
    end;
    {$IFNDEF DFS_NO_COM_CLEANUP} EnumList.Release; {$ENDIF}
  end;
end;

{*******************************************************************************
Procedure:  TdfsSystemComboBox.AddShellItem
Parameters: ParentShellItem   TShellItem
            NewID             PItemIDList
            CanDelete         Boolean
Notes:
  This proceudre adds the shell item specified by NewID of the shellfoler
  pointed to by the ShellFolder property of the passed parameter ParentShellItem
  to ParentShellItem's list of child items.

  CanDelete is used to set the removeable property of the new item.

Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
1999/02/15        [e-mail]: D2/C1 compatibility
                                      Binding to wrong pidl
                                      Removed unused variable
*******************************************************************************}
procedure TdfsSystemComboBox.AddShellItem(const ParentShellItem: TShellItem;
   const NewID: PItemIDList; Const CanDelete: boolean);
var
  ShellItem: TShellItem;
  NoPIDL: PItemIDList;
  Attrs: DWORD;
begin
  ShellItem := TShellItem.Create;
  with ShellItem do
  begin
    ParentItem := ParentShellItem;
    ParentShellFolder := ParentItem.ShellFolder;
    // Invalidate cached information.
    NoPIDL := NIL;
    Attrs := SFGAO_VALIDATE;
    ParentShellFolder.GetAttributesOf(0, NoPIDL, Attrs);
    {$IFNDEF DFS_NO_COM_CLEANUP} ParentShellFolder.AddRef; {$ENDIF}
// See comments in EnumerateSubItems about copying this
    ID := CopyPIDL(NewID);
    ParentShellFolder.BindToObject(ID, NIL, IID_IShellFolder,
       Pointer(ShellFolder));
    {$IFNDEF DFS_NO_COM_CLEANUP}
    if ShellFolder <> NIL then
      ShellFolder.AddRef;
    {$ENDIF}
    FullID := ConcatPIDLs(ParentItem.FullID, ID);
    NormalIndex := GetShellImage(FullID, TRUE, FALSE);
    SelectedIndex := GetShellImage(FullID, TRUE, TRUE);
    FullPathName := GetDisplayName(ParentItem.ShellFolder, ID, dntForParsing);
    RelativePathName := GetDisplayName(ParentItem.ShellFolder, ID, dntNormal);
    Indent := ShellItem.ParentItem.Indent+10;
    Removeable := CanDelete;
  end;
  ParentShellItem.AddChild(ShellItem);
end;

{*******************************************************************************
Procedure:  TdfsSystemComboBox.DrawItem
Parameters: Index   Integer
            Rect    TRect
Notes:
  This proceudre draws the item specified by Index. It's kinda funky.  If the
  drawing in the edit portion of the combo box draw without an indent.

Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
1999/02/15        [e-mail]: Changed so that image and text are drawn
                                      centered vertically in the given rect.
*******************************************************************************}
procedure TdfsSystemComboBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
  BlueRect: TRect;
  ShellItem: TShellItem;
begin
  if FDrawInEdit then
  begin
    if Index >= 0 then
    begin
      ShellItem := TShellItem(Items.Objects[Index]);
      Images.DrawingStyle := dsTransparent;
      Images.Draw(Canvas, Rect.Left + 2, Rect.Top + ((Rect.Bottom - Rect.Top -
         Images.Height) div 2), ShellItem.SelectedIndex);
      inc(Rect.Left, Images.Width + 6);
      DrawText(Canvas.Handle, PChar(Items[Index]), -1, Rect, DT_LEFT or
         DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER);
    end else begin
      Canvas.FillRect(rect);
    end;
  end else begin
    if odSelected in State then
    begin
      Images.DrawingStyle := dsFocus;
      Canvas.Brush.Color := clHighlight;
      Canvas.Font.Color := clHighlightText;
    end else
      Images.DrawingStyle := dsTransparent;
    with Canvas do
    begin
      ShellItem := TShellItem(Items.Objects[Index]);
      BlueRect.Left := Rect.Left + Images.Width + 6 + ShellItem.Indent - 1;
      BlueRect.Right := BlueRect.Left + Canvas.TextWidth(Items[Index]) + 2;
      BlueRect.Top := Rect.Top;
      BlueRect.Bottom := Rect.Bottom;
      FillRect(BlueRect);
      Inc(Rect.Left, ShellItem.Indent);
      if Index = ItemIndex then
        Images.Draw(Canvas, Rect.Left + 2, Rect.Top + ((Rect.Bottom-Rect.Top-
           Images.Height) div 2), ShellItem.SelectedIndex)
      else
        Images.Draw(Canvas, Rect.Left + 2, Rect.Top + ((Rect.Bottom-Rect.Top-
           Images.Height) div 2), ShellItem.NormalIndex);
      inc(Rect.Left, Images.Width + 6);
      DrawText(Handle, PChar(Items[Index]), -1, Rect, DT_LEFT or DT_NOPREFIX or
         DT_SINGLELINE or DT_VCENTER);
      if odFocused in State then
         DrawFocusRect(BlueRect);
    end;
  end;
end;

{*******************************************************************************
Procedure:  TdfsSystemComboBox.CNDrawItem
Parameters: Index   Integer
            Rect    TRect
Notes:
  This procedure Overrides the default CNDrawItem method so the focus rect
  and highlight are like explorer's.
  It masks off the ItemState to determine where the item is being drawn.

Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
*******************************************************************************}
procedure TdfsSystemComboBox.CNDrawItem(var Message: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  with Message.DrawItemStruct^ do
  begin
    // check and see if we are in the edit portion of the combo box
    FDrawInEdit := (ODS_COMBOBOXEDIT and itemState) <> 0;
    {$IFDEF DFS_COMPILER_5_UP}
    State := TOwnerDrawState(LongRec(itemState).Lo);
    {$ELSE}
    State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
    {$ENDIF}
    Canvas.Handle := hDC;
    try
      Canvas.Font := Font;