systemcontrolpack.pas

动态提示控件

    {$IFDEF DFS_SCP_SYSTREEVIEW}
    property TreeView: TdfsCustomSystemTreeView
       read FTreeView write SetTreeView;
    {$ENDIF}
    {$IFDEF DFS_SCP_SYSLISTVIEW}
    property ListView: TdfsCustomSystemListView
       read FListView write SetListView;
    {$ENDIF}

  public
    { Overriden Methods }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    { New Public Methods }
    // Descendant implementation notes:  resets the control entirely.  This
    // implementatino does nothing but notify linked controls of the change.
    procedure Reset; dynamic;
    // Usage note:  GetSelectionPIDL and GetSelectionParentFolder must be able to
    // return the new value before this method is called.
    procedure NotifyLinkedControls(ForceUpdate: boolean); dynamic;
    procedure LinkedControlChanged(Sender: TObject; ForceUpdate: boolean); dynamic;

    { New Properties }
    property SelectionPIDL: PItemIDList
       read GetSelectionPIDL;
    property SelectionParentFolder: IShellFolder
       read GetSelectionParentFolder;

    { Modified Existing Properties }
    // Leave Items public because you can't change at design-time.  Also, don't
    // store the stuff in it, it's system dependent and must be built when run.
    property Items stored FALSE;
  end;
{$ENDIF} // DFS_SCP_SYSCOMBOBOX

implementation

uses
  Graphics, Forms, dialogs,
  {$IFDEF DFS_DEBUG} EJHkEng, {$ENDIF}
  {$IFDEF DFS_COMPILER_4_UP} ImgList, {$ENDIF}
  ShellAPI, PidlHelp;


{$IFDEF DFS_SCP_SYSTREEVIEW}
var
  FTimerTrees: TList;
  FMainWinHookSet: boolean;
  FMyComputerID: PItemIDList;

procedure TimerCallback(Wnd: HWND; Msg, TimerID: UINT; CurTime: DWORD); stdcall;
var
  x: integer;
begin
  for x := 0 to FTimerTrees.Count - 1 do
    if TdfsCustomSystemTreeView(FTimerTrees[x]).FReadDelayTimer = TimerID then
    begin
      TdfsCustomSystemTreeView(FTimerTrees[x]).TimerEvent;
      break;
    end;
end;

{ TdfsCustomSystemTreeView }

function TdfsCustomSystemTreeView.AppWinHook(var Message: TMessage): boolean;
begin
  if (Message.Msg = WM_DEVICECHANGE) and ((Message.WParam = $8000) or
    (Message.WParam = $8004)) then
    DeviceChanged;
  Result := FALSE;
end;

procedure TdfsCustomSystemTreeView.Change(Node: TTreeNode);
begin
  inherited Change(Node);

  if (FReadDelay > 0) and (not FInhibitReadDelay) then
  begin
    // Delay refreshing linked.  Do it when the timer fires.
    if FReadDelayTimer <> 0 then
      KillTimer(0, FReadDelayTimer);
    FReadDelayTimer := SetTimer(0, STV_READ_DELAY_TIMER, FReadDelay, @TimerCallback);
  end else begin
    // No read delay, just tell them to refresh now.
    if ([csLoading] * ComponentState) = [] then
      FInhibitReadDelay := FALSE;
    NotifyLinkedControls(FALSE);
  end;
end;

procedure TdfsCustomSystemTreeView.CMSysColorChange(var Message: TWMSysColorChange);
var
  RealColor: TColor;
begin
  SetupImageList;

  inherited;

  // There is apparently a bug in the VCl that doesn't correctly reset the
  // tree/list color on a system color change.  The window background color gets
  // changed correctly, but the text background color doesn't.  This may be
  // specific to D4, I'm not certain.
  RealColor := Color;
  // Change the color to something else, doesn't matter what so long as it's
  // different.
  if Color = clBlack then
    Color := clWhite
  else
    Color := clBlack;
  // Put back the real color
  Color := RealColor;
end;

constructor TdfsCustomSystemTreeView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FTimerTrees.Add(Self);
  FReadDelay := 500;
  FReadDelayTimer := 0;
  FInhibitReadDelay := TRUE;

  HookMainWin;

  // Initialize the image list to the system's image list
  SetupImageList;
end;

{$IFDEF DFS_SCP_BROKEN_COLOR}
procedure TdfsCustomSystemTreeView.CreateWnd;
begin
  inherited;
  Perform(TVM_SETBKCOLOR, 0, LPARAM(ColorToRGB(Color)));
  Perform(TVM_SETTEXTCOLOR, 0, LPARAM(ColorToRGB(Font.Color)));
end;
{$ENDIF}

destructor TdfsCustomSystemTreeView.Destroy;
begin
  if FMainWinHookSet then
  begin
    Application.UnHookMainWindow(AppWinHook);
    FMainWinHookSet := FALSE;
  end;

  if FReadDelayTimer <> 0 then
    KillTimer(0, FReadDelayTimer);
  FTimerTrees.Remove(Self);

  inherited Destroy;
end;

procedure TdfsCustomSystemTreeView.DeviceChanged;
begin
  // One of the drives changed.
  Reset;
end;

function TdfsCustomSystemTreeView.GetValidHandle: HWND;
begin
  if HandleAllocated then
    Result := Handle
  else if assigned(Parent) and Parent.HandleAllocated then
    Result := Parent.Handle
  else if (GetParentForm(Self) <> NIL) and
     (GetParentForm(Self).HandleAllocated) then
    Result := GetParentForm(Self).Handle
  else if assigned(Application.MainForm) and
     Application.MainForm.HandleAllocated then
    Result := Application.MainForm.Handle
  else
    Result := 0;
end;

procedure TdfsCustomSystemTreeView.HookMainWin;
begin
  if not FMainWinHookSet then
  begin
    Application.HookMainWindow(AppWinHook);
    FMainWinHookSet := TRUE;
  end;
end;

procedure TdfsCustomSystemTreeView.LinkedControlChanged(Sender: TObject;
   ForceUpdate: boolean);
begin
  if csDesigning in ComponentState then
    exit;

  // Have to get linked's new pidl and refresh using it
  {$IFDEF DFS_SCP_SYSLISTVIEW}
  if (Sender = ListView) then
    LinkedReset(ListView.SelectionParentFolder, ListView.SelectionPIDL,
       ForceUpdate);
  {$ENDIF}

  {$IFDEF DFS_SCP_SYSCOMBOBOX}
  if (Sender = ComboBox) then
    LinkedReset(ComboBox.SelectionParentFolder, ComboBox.SelectionPIDL,
       ForceUpdate);
  {$ENDIF}
end;

procedure TdfsCustomSystemTreeView.Notification(AComponent: TComponent;
  AOperation: TOperation);
begin
  inherited Notification(AComponent, AOperation);

  case AOperation of
    opInsert:
      begin
        {$IFDEF DFS_SCP_SYSLISTVIEW}
        if (AComponent is TdfsCustomSystemListView) and (FListView = NIL) then
        begin
          ListView := TdfsCustomSystemListView(AComponent);
          ListView.TreeView := Self;
        end;
        {$ENDIF}

        {$IFDEF DFS_SCP_SYSCOMBOBOX}
        if (AComponent is TdfsCustomSystemComboBox) and (FComboBox = NIL) then
        begin
          ComboBox := TdfsCustomSystemComboBox(AComponent);
          ComboBox.TreeView := Self;
        end;
        {$ENDIF}
      end;

    opRemove:
      begin
        {$IFDEF DFS_SCP_SYSLISTVIEW}
        if AComponent = FListView then
          ListView := NIL;
        {$ENDIF}

        {$IFDEF DFS_SCP_SYSCOMBOBOX}
        if AComponent = FComboBox then
          ComboBox := NIL;
        {$ENDIF}
      end;
  end;
end;

procedure TdfsCustomSystemTreeView.NotifyLinkedControls(ForceUpdate: boolean);
begin
  {$IFDEF DFS_SCP_SYSLISTVIEW}
  if FListView <> NIL then
    ListView.LinkedControlChanged(Self, ForceUpdate);
  {$ENDIF}

  {$IFDEF DFS_SCP_SYSCOMBOBOX}
  if FComboBox <> NIL then
    ComboBox.LinkedControlChanged(Self, ForceUpdate);
  {$ENDIF}
end;

procedure TdfsCustomSystemTreeView.Reset;
begin
  NotifyLinkedControls(FALSE);
end;

{$IFDEF DFS_SCP_SYSCOMBOBOX}
procedure TdfsCustomSystemTreeView.SetComboBox(Val: TdfsCustomSystemComboBox);
begin
  if FComboBox <> Val then
  begin
    FComboBox := Val;
  end;
end;
{$ENDIF}

{$IFDEF DFS_SCP_SYSLISTVIEW}
procedure TdfsCustomSystemTreeView.SetListView(Val: TdfsCustomSystemListView);
begin
  if FListView <> Val then
  begin
    FListView := Val;
  end;
end;
{$ENDIF}

procedure TdfsCustomSystemTreeView.SetupImageList;
var
  SysIL: HImageList;
  SFI: TSHFileInfo;
begin
  if Images <> NIL then
    Images.Free;
  // Because we are the owner, it'll get freed automatically when we do.
  Images := TImageList.Create(Self);
  SysIL := SHGetFileInfo('', 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX or
     SHGFI_SMALLICON);
  if SysIL <> 0 then
  begin
    if Images.HandleAllocated then
      Images.Handle := 0;
    Images.Masked := TRUE;
//    Images.BkColor := ImageList_GetBkColor(SysIL);
    Images.BkColor := clNone;
    Images.DrawingStyle := dsTransparent;
    Images.Handle := SysIL;
    Images.ShareImages := TRUE;  // DON'T FREE THE SYSTEM IMAGE LIST!!!!!
                                 // BAD IDEA (tm)!
  end;
end;

procedure TdfsCustomSystemTreeView.TimerEvent;
begin
  KillTimer(0, FReadDelayTimer);
  FReadDelayTimer := 0;
  // Delay timer fired, notify linked controls
  NotifyLinkedControls(FALSE);
end;

{$ENDIF}




{$IFDEF DFS_SCP_SYSLISTVIEW}

{ TdfsCustomSystemListView }

function TdfsCustomSystemListView.AppWinHook(var Message: TMessage): boolean;
begin
  if (Message.Msg = WM_DEVICECHANGE) and ((Message.WParam = $8000) or
    (Message.WParam = $8004)) then
    DeviceChanged;
  Result := FALSE;
end;

procedure TdfsCustomSystemListView.CMSysColorChange(var Message: TWMSysColorChange);
var
  RealColor: TColor;
begin
  SetupImageList;
  inherited;

  // There is apparently a bug in the VCl that doesn't correctly reset the
  // tree/list color on a system color change.  The window background color gets
  // changed correctly, but the text background color doesn't.  This may be
  // specific to D4, I'm not certain.
  RealColor := Color;
  // Change the color to something else, doesn't matter what so long as it's
  // different.
  if Color = clBlack then
    Color := clWhite
  else
    Color := clBlack;
  // Put back the real color
  Color := RealColor;
end;


constructor TdfsCustomSystemListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  HookMainWin;
  // Initialize the image list to the system's image list
  SetupImageList;
end;

{$IFDEF DFS_SCP_BROKEN_COLOR}
procedure TdfsCustomSystemListView.CreateWnd;
begin
  inherited;
  Perform(LVM_SETBKCOLOR, 0, LPARAM(ColorToRGB(Color)));
end;
{$ENDIF}

destructor TdfsCustomSystemListView.Destroy;
begin
  if FMainWinHookSet then
  begin
    Application.UnHookMainWindow(AppWinHook);
    FMainWinHookSet := FALSE;
  end;

  inherited;
end;

procedure TdfsCustomSystemListView.DeviceChanged;
begin
  // One of the drives changed.
  {$IFDEF DFS_SCP_SYSTREEVIEW}
  if TreeView <> NIL then
    TreeView.Reset
  else
  {$ENDIF}
    Reset;
end;

function TdfsCustomSystemListView.GetValidHandle: HWND;
begin
  if HandleAllocated then
    Result := Handle
  else if assigned(Parent) and Parent.HandleAllocated then
    Result := Parent.Handle
  else if (GetParentForm(Self) <> NIL) and
     (GetParentForm(Self).HandleAllocated) then
    Result := GetParentForm(Self).Handle
  else if assigned(Application.MainForm) and
     Application.MainForm.HandleAllocated then
    Result := Application.MainForm.Handle
  else
    Result := 0;
end;

procedure TdfsCustomSystemListView.HookMainWin;
begin
  if not FMainWinHookSet then
  begin
    Application.HookMainWindow(AppWinHook);
    FMainWinHookSet := TRUE;
  end;
end;

procedure TdfsCustomSystemListView.LinkedControlChanged(Sender: TObject;
   ForceUpdate: boolean);
begin
  if csDesigning in ComponentState then
    exit;