systemcontrolpack.pas

动态提示控件

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

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

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

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

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

    opRemove:
      begin
        {$IFDEF DFS_SCP_SYSTREEVIEW}
        if AComponent = FTreeView then
          TreeView := NIL;
        {$ENDIF}

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

procedure TdfsCustomSystemListView.NotifyLinkedControls(ForceUpdate: boolean);
begin
  {$IFDEF DFS_SCP_SYSTREEVIEW}
  if FTreeView <> NIL then
    TreeView.LinkedControlChanged(Self, ForceUpdate);
  {$ENDIF}

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

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

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

{$IFDEF DFS_SCP_SYSTREEVIEW}
procedure TdfsCustomSystemListView.SetTreeView(Val: TdfsCustomSystemTreeView);
begin
  if FTreeView <> Val then
  begin
    FTreeView := Val;
  end;
end;
{$ENDIF}

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

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

{$ENDIF}

{ TdfsCustomSystemComboBox }

{$IFDEF DFS_SCP_SYSCOMBOBOX}

function TdfsCustomSystemComboBox.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 TdfsCustomSystemComboBox.Click;
begin
  NotifyLinkedControls(FALSE);

  inherited Click;
end;

procedure TdfsCustomSystemComboBox.CMSysColorChange(var Message: TWMSysColorChange);
begin
  SetupImageList;

  inherited;
end;

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

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

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

  inherited;
end;

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

function TdfsCustomSystemComboBox.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 TdfsCustomSystemComboBox.HookMainWin;
begin
  if not FMainWinHookSet then
  begin
    Application.HookMainWindow(AppWinHook);
    FMainWinHookSet := TRUE;
  end;
end;

procedure TdfsCustomSystemComboBox.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_SYSTREEVIEW}
  if (Sender = TreeView) then
    LinkedReset(TreeView.SelectionParentFolder, TreeView.SelectionPIDL,
       ForceUpdate);
  {$ENDIF}

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

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

  case AOperation of
    opInsert:
      begin
        {$IFDEF DFS_SCP_SYSTREEVIEW}
        if (AComponent is TdfsCustomSystemTreeView) and (FTreeView = NIL) then
        begin
          TreeView := TdfsCustomSystemTreeView(AComponent);
          TreeView.ComboBox := Self;
        end;
        {$ENDIF}

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

    opRemove:
      begin
        {$IFDEF DFS_SCP_SYSTREEVIEW}
        if AComponent = FTreeView then
          TreeView := NIL;
        {$ENDIF}

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

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

  {$IFDEF DFS_SCP_SYSTREEVIEW}
  if FTreeView <> NIL then
    TreeView.LinkedControlChanged(Self, ForceUpdate);
  {$ENDIF}
end;

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

procedure TdfsCustomSystemComboBox.SetImages(const Value: TImageList);
begin
  if FImages <> NIL then
    FImages.Free;
  // Because we are the owner, it'll get freed automatically when we do.
  FImages := TImageList.Create(Self);
  FImages.Assign(Value);
end;

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

{$IFDEF DFS_SCP_SYSTREEVIEW}
procedure TdfsCustomSystemComboBox.SetTreeView(Val: TdfsCustomSystemTreeView);
begin
  if FTreeView <> Val then
  begin
    FTreeView := Val;
  end;
end;
{$ENDIF}

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

{$ENDIF}


{ TFolderItemData }

var
  NewCount: integer;

constructor TFolderItemData.Create;
begin
  inherited;
  inc(NewCount);
end;

destructor TFolderItemData.Destroy;
begin
  inherited;
  dec(NewCount);
end;

{$IFDEF DFS_COMPILER_4_UP}

function TFolderItemData.GetFileSize: Int64;
begin
  Result := (FFileSizeHigh SHR 32) + FFileSizeLow;
end;

{$ELSE}
{$IFDEF DFS_DELPHI}

function TFolderItemData.GetFileSize: Comp;
var
  LI: TLargeInteger;
begin
  LI.LowPart := FFileSizeLow;
  LI.HighPart := FFileSizeHigh;
  Result := Comp(LI);
end;

{$ENDIF}
{$ENDIF}

function TFolderItemData.ItemHasFlag(Flag: UINT): boolean;
begin
  Result := (Attributes and Flag) <> 0;
end;

var
  Malloc: IMalloc;

initialization
  NewCount := 0;
  FTimerTrees := TList.Create;
  FMainWinHookSet := FALSE;
  ShGetSpecialFolderLocation(0, CSIDL_DRIVES, FMyComputerID);
finalization
  FTimerTrees.Free;
  ShGetMalloc(Malloc);
  try
    Malloc.Free(FMyComputerID);
  finally;
    {$IFDEF DFS_COMPILER_2}
    ShellMalloc.Release;
    {$ENDIF}
  end;
  if NewCount > 0 then
    raise ELeaking.Create(MEMLEAK_STR);
end.