systemcombobox.pas

动态提示控件

      Canvas.Brush := Brush;
      if Integer(itemID) >= 0 then
        DrawItem(itemID, rcItem, State)
      else
        Canvas.FillRect(rcItem);
    finally
      Canvas.Handle := 0;
    end;
  end;
end;

{*******************************************************************************
Procedure:  TdfsSystemComboBox.SetActiveFolderName
Parameters: Value String
Notes:
  This proceudre sets the active folder ( in the edit portion) based on the
  passed string.  It is assumed that the string is a valid path somewere in
  the file system, if not the active folder does not change.

  It gets the PIDL of the given string and then passes it to the
  SetActiveFolderIDList method.

Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
1999/02/07        [e-mail]: PidlHelp unit change
*******************************************************************************}
procedure TdfsSystemComboBox.SetActiveFolderName(const Value: String);
var
   FindID: PItemIDList;
begin
   if (FDesktopFolder <> NIL) and GetPIDLFromPath(GetValidHandle,
      FDesktopFolder, Value, FindID) then
     SetActiveFolderIDList(FindID);
end;

{*******************************************************************************
Procedure:  TdfsSystemComboBox.SetActiveFolderIDList
Parameters: Value PItemIDList
Notes:
  This proceudre sets the active folder ( in the edit portion) based on the
  passed PItemIDList.  It is assumed that is is a valid identifier somewere in
  the file system, if not the active folder does not change.

  Remove any Items which are removeable. (added last time by this method)

  While the given ItemIDlist is in the default set of
  Item Identifiers, strip the last one and add it to a list.

  At some point the item must exist or it was an invalid ItemIDList

  If it exists, add the items recursively.  THis will give the TreeView look.
Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
1999/02/15        [e-mail]: PidlHelp unit change.
                                      Plugged several pidl leaks.
*******************************************************************************}
procedure TdfsSystemComboBox.SetActiveFolderIDList(const Value: PItemIDList);

   function InItems(ID: PItemIDList; var ValIndex: integer): boolean;
   var
     i: integer;
     ShellItem: TShellItem;
   begin
     Result := FALSE;
     for i := 0 to Items.Count-1 do
     begin
        ShellItem := TShellItem(Items.Objects[i]);
        if FDesktopFolder.CompareIDs(0, ShellItem.FullID, ID) = 0 then
        begin
          ValIndex := i;
          Result := TRUE;
          break;
        end;
     end;
   end;

var
  TempPIDL,
  FindID: PItemIDList;
  IDList: TList;
  x: integer;
  Found: boolean;
  InsertIndex: integer;
  SelectedIndex: integer;
  ShellItem: TShellItem;
begin
//!!! May need to treat this as a root selection.
  if Value = NIL then
    exit;

  // remove the items added last time
  for x := Items.Count-1 downto 0 do
  begin
    ShellItem := TShellItem(Items.Objects[x]);
    if Shellitem.Removeable then
    begin
      // remove the item from the parent list of child items.
      with ShellItem.ParentItem.ChildList do
        Delete(IndexOf(ShellItem));
      Items.Delete(x); // This will free ShellItem in the WM_DELETEITEM handler
    end;
  end;

  Found := TRUE;
  IDList := TList.Create;
  FindID := CopyPIDL(Value);
  try
    { Now iterate through the PIDL and find the ItemIDList's parent item.
      It must exist in the system or the ItemIDList passed is invalid}
    while (not InItems(FindID, InsertIndex)) do
    begin
      { this item is not in our current tree. Add it to the list because we
        will need it if we find the parent item}
      IDList.Add(CopyLastID(FindID));
      { Now see if it's parent exists }
      TempPIDL := CopyParentPIDL(FindID);
      try
        FreePIDL(FindID);
      finally
        FindID := TempPIDL;
     end;
      if FindID.mkid.cb = 0 then
      begin
        Found := FALSE;
        break;
      end;
    end;
  finally
    FreePIDL(FindID);
  end;

  if Found then
  begin
    // now add the sub items to the list
    SelectedIndex := InsertIndex+IdList.COunt;
    for x := IDList.Count-1 downto 0 do
    begin
      ShellItem := TShellItem(Items.Objects[InsertIndex]);
      AddShellItem(ShellItem, IDList.Items[x], TRUE);
      InsertSubItems(ShellItem, InsertIndex);
      Inc(InsertIndex);
    end;
    ItemIndex := SelectedIndex;
    FreePIDL(FActiveFolderIDList);
    FActiveFolderIDList := Value;
  end else begin
    TempPIDL := Value;
    FreePIDL(TempPIDL);
    ItemIndex := -1;
  end;

  // now free the IDlist data
  while IDList.Count <> 0 do
  begin
    TempPIDL := PItemIDList(IDlist.Items[0]);
    FreePIDL(TempPIDL);
    IdList.Delete(0);
  end;
  IDList.Free;

  NotifyLinkedControls(FALSE);
end;

{*******************************************************************************
Function:  TdfsSystemComboBox.GetActiveFolderName
Result:    String
Notes:
  This proceudre returns the mame of the active folder
Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
1999/02/15        [e-mail]: Removed unnecessary variable.
*******************************************************************************}
function TdfsSystemComboBox.GetActiveFolderName: string;
begin
  Result := TShellItem(Items.Objects[ItemIndex]).FullPathName;
end;

{*******************************************************************************
Function:  TdfsSystemComboBox.RemoveAllItems
Notes:
  Removes all items in the list, and indirectly all data associated with those
  items via WM_DELETEITEM message generated from here.
Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
1999/02/15        [e-mail]: Removed unnecessary variable.
*******************************************************************************}
procedure TdfsSystemComboBox.RemoveAllItems;
var
  x: integer;
begin
  // remove all the Items in the list
  if Items.Count > 0 then
  begin
    for x := Items.Count -1 downto 0 do
      Items.Delete(x); // This will free ShellItem in the WM_DELETEITEM handler.
  end;
end;

{*******************************************************************************
Procedure:    TdfsSystemComboBox.Loaded
Parameters:   AOwner  TComponent
Notes:
  Overrides the default Loaded procedure and reads the default items in to the
  combo box.

Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial from SystemTreeView
1999/02/15        [e-mail]: Removed ItemIndex assignment, done in Reset
*******************************************************************************}
procedure TdfsSystemComboBox.Loaded;
begin
  inherited Loaded;

  Reset; // We've finished loading, we can populate the tree now.
end;

{*******************************************************************************
procedure  TdfsSystemComboBox.CreateWnd
Parameters var Message: TWMDeleteItem
Notes:
  This proceudre overrides the default CreateWnd method.  It was overridden
  so that the combo box will be populated and the default ItemIndex is 0
Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
1999/02/15        [e-mail]: Removed ItemIndex assignment, done in Reset
                                      Added some comments for clarification.
*******************************************************************************}
procedure TdfsSystemComboBox.CreateWnd;
begin
  inherited CreateWnd;

  FRecreatingWnd := FALSE;
  // If we are loading object from stream (form file), we have to wait until
  // everything is loaded before populating the list.  If we are not loading,
  // i.e. the component was created dynamically or was just dropped on a form,
  // we need to populate it now since the Loaded method will never get called.
  // Reset handles this internally.
  Reset;
end;

procedure TdfsSystemComboBox.DestroyWnd;
begin
  FRecreatingWnd := TRUE;
  inherited;
end;

{*******************************************************************************
procedure  TdfsSystemComboBox.WMDeleteItem
Parameters var Message: TWMDeleteItem
Notes:
  This proceudre overrides the default WMDeteteItem method.  It was overridden
  so that the ShellItem associated with this ComboBox item is free.
Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
*******************************************************************************}
procedure TdfsSystemComboBox.WMDeleteItem(var Message: TWMDeleteItem);
var
  ShellItem: TShellItem;
  DelIndex: Integer;
begin
  if not FRecreatingWnd then
  begin
    DelIndex := Message.DeleteItemStruct.itemID;
    ShellItem := TShellItem(Items.Objects[DelIndex]);
    if ShellItem <> NIL then
      ShellItem.Free;
  end;

  inherited;
end;

{*******************************************************************************
Procedure:    TdfsSystemComboBox.GetActiveFolderIDList
Parameters:   None
Notes:
  Property read method.  Returns the fully qualified PItemIDList of the selected
  item.

Revision History
yyyy/mm/dd        By: change
1999/02/07        [e-mail]: Initial
*******************************************************************************}
function TdfsSystemComboBox.GetActiveFolderIDList: PItemIDList;
begin
  if (ItemIndex >= 0) and (ItemIndex < Items.Count) then
    Result := TShellItem(Items.Objects[ItemIndex]).FullID
  else
    Result := NIL;
end;


// 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 TdfsSystemComboBox.GetSelectionPIDL: PItemIDList;
begin
  Result := ActiveFolderIDList;
end;

function TdfsSystemComboBox.GetSelectionParentFolder: IShellFolder;
begin
  Result := FDesktopFolder;
(*
  if ItemIndex >= 0 then
    Result := TShellItem(Items.Objects[ItemIndex]).ParentShellFolder
  else
    Result := NIL;
*)
end;

// 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 TdfsSystemComboBox.LinkedReset(const ParentFolder: IShellFolder;
   const IDList: PItemIDList; ForceUpdate: boolean): boolean;
begin

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

  Items.BeginUpdate;
  try
    PopulateCombo;
    // ID list belongs to someone else, use a copy!
    ActiveFolderIDList := CopyPIDL(IDList);
    Result := ItemIndex > -1;
  finally
    Items.EndUpdate;
  end;

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

end;

function TdfsSystemComboBox.GetVersion: string;
begin
  Result := DFS_COMPONENT_COMBO_VERSION;
end;

procedure TdfsSystemComboBox.SetVersion(const Val: string);
begin
  { empty write method, just needed to get it to show up in Object Inspector }
end;


procedure TdfsSystemComboBox.ChangeToParent;
var
  ParentPIDL: PItemIDList;
begin
  ParentPIDL := CopyParentPIDL(FActiveFolderIDList);
  try
    LinkedReset(NIL, ParentPIDL, FALSE);
    NotifyLinkedControls(FALSE);
  finally
    FreePIDL(ParentPIDL);
  end;
end;

{ Added by Tamas Demjen }
procedure TdfsSystemComboBox.CMFontChanged(var Message: TMessage);
var
  DC: HDC;
  OldFont: HFONT;
  Size: TSize;
begin
  DC := GetDC(0);
  OldFont := SelectObject(DC, Font.Handle);
  try
    if GetTextExtentPoint32(DC, '@9Wgp,|"''', -1, Size) then
      ItemHeight := Size.cy + 2;
  finally
    SelectObject(DC, OldFont);
    ReleaseDC(0, DC);
  end;
end;

end.