systemlistview.pas

动态提示控件

{$IFNDEF DFS_SLV_FASTMODE}
  if Message.NMHdr.code = LVN_DELETEITEM then
  begin
    with PNMListView(Pointer(Message.NMHdr))^ do
      FreeItemData(TListItem(lParam));
    // we can't do the actual delete processing here because we don't have
    // access to some of the stuff needed.  Let default handling do it below.
  end;

  inherited;
{$ELSE}
  Assert(Message.NMHdr <> NIL);
  
  case Message.NMHdr.code of
    LVN_DELETEITEM:
      begin
         with PNMListView(Pointer(Message.NMHdr))^ do
           FreeItemData(TListItem(lParam));

        // we can't do the actual delete processing here because we don't have
        // access to some of the stuff needed.  Let default handling do it.
        inherited;
      end;

    LVN_GETDISPINFO:
      begin
        with PLVDispInfo(Pointer(Message.NMHdr))^.item do
        begin
          if (mask and LVIF_PARAM) <> 0 then
            Item := TListItem(lParam)
          else
            Item := Items[IItem];

          if (Item = NIL) or (Item.Data = NIL) then
          begin
            if (mask and LVIF_TEXT) <> 0 then
              pszText[0] := #0;
            if (mask and LVIF_IMAGE) <> 0 then
              iImage := -1;
          end
          else
          begin
            with TFolderItemData(Item.Data) do
            begin
              if (mask and LVIF_TEXT) <> 0 then
              begin
                if iSubItem = 0 then
                begin
                  NiceName := GetDisplayName(SFParent, IDList, dntNormal);
                  StrPLCopy(pszText, NiceName, cchTextMax);
                end else begin
                  with Item.SubItems do
                  begin
                    if iSubItem <= Count then
                    begin
                      NiceName := '';
                      case iSubItem of
                        1: //Size
                          begin
                            if SUCCEEDED(SHGetDataFromIDList(SFParent, IDList,
                               SHGDFIL_FINDDATA, @FD, SizeOf(FD))) then
                            begin
                              // size in KBs
                              if ((Attributes and
                                 (SFGAO_FOLDER or SFGAO_HASSUBFOLDER)) <> 0) then
                                NiceName := ''
                              else begin
                                FileSizeLow := FD.nFileSizeLow;
                                FileSizeHigh := FD.nFileSizeHigh;
                                {$IFDEF DFS_COMPILER_4_UP}
                                NiceName := Commaize(IntToStr((FileSize + 1023)
                                   div 1024)) + strKilobytes;
                                {$ELSE}
                                NiceName := Commaize(Format('%.0f', [(FileSize +
                                   1023) / 1024])) + strKilobytes;
                                {$ENDIF}
                              end;
                            end else
                              NiceName := '';
                          end;
                        2: //Type
                          begin
                            Res := SHGetDataFromIDList(SFParent, IDList,
                               SHGDFIL_DESCRIPTIONID, @DI, SizeOf(DI));
                            if Res = E_INVALIDARG then
                              // Not implemented until v4.71 of Shell32.dll.  Just
                              // treat everything as a file system object.
                              DI.dwDescriptionID := SHDID_FS_FILE;
                            if DI.dwDescriptionId = SHDID_ROOT_REGITEM then
                              // System folder
                              nicename := strSystemFolder
                            else if (SHGetFileInfo(PChar(FQ_IDLIST), 0, FI,
                               SizeOf(FI), SHGFI_PIDL or SHGFI_TYPENAME)<>0) then
                              nicename := FI.szTypeName
                            else
                              nicename := '';
                          end;
                        3://Modified
                          begin
                            if SUCCEEDED(SHGetDataFromIDList(SFParent, IDList,
                               SHGDFIL_FINDDATA, @FD, SizeOf(FD))) then
                            begin
                              FileTimeToLocalFileTime(FD.ftLastWriteTime, fTime);
                              FileTimeToSystemTime(fTime, SysTime);
                              SetLength(DateStr, 256);
                              SetLength(DateStr, GetDateFormat(LOCALE_USER_DEFAULT,
                                 0, @SysTime, NIL, PChar(DateStr), 255) - 1);
                              SetLength(TimeStr, 256);
                              SetLength(TimeStr, GetTimeFormat(LOCALE_USER_DEFAULT,
                                 0, @SysTime, NIL, PChar(TimeStr), 255)  - 1);
                              NiceName := DateStr + ' ' + TimeStr;
                            end;
                          end;
                        4://Attributes
                          begin
                            NiceName := '';
                            if SUCCEEDED(SHGetDataFromIDList(SFParent, IDList,
                               SHGDFIL_FINDDATA, @FD, SizeOf(FD))) then
                            begin
                              if (FD.dwFileAttributes and faReadOnly) <> 0 then
                                NiceName := NiceName + strReadOnlyChar;
                              if (FD.dwFileAttributes and faHidden) <> 0 then
                                NiceName := NiceName + strHiddenChar;
                              if (FD.dwFileAttributes and faSysFile) <> 0 then
                                NiceName := NiceName + strSystemChar;
                              if (FD.dwFileAttributes and faArchive) <> 0 then
                                NiceName := NiceName + strArchiveChar;
                            end;
                          end;
                      end; { case }
                      StrPLCopy(pszText, NiceName, cchTextMax);
                    end else
                      pszText[0] := #0;
                  end;
                end;
              end;
              if (mask and LVIF_IMAGE) <> 0 then
              begin
                if iSubItem = 0 then
                begin
                  GetNormalAndSelectedIcons(FQ_IDList, N, S);
                  if Item.Selected then
                    iImage := S
                  else
                    iImage := N;
                end
                else
                  iImage := -1;
              end;
              // Don't ask for it again!
              mask := mask or LVIF_DI_SETITEM;
            end;
          end;
        end;
      end;
  else
    inherited;
  end;
{$ENDIF}
end; {CNNotify}


function TdfsSystemListView.GetItemData(Item: TListItem): TFolderItemData;
begin
  Result := Item.Data;
  if Result = NIL then
  begin
    if FShowErrorsInMsgBox then
      MessageDlg(LoadStr(IDS_NOFOLDERDATA), mtError, [mbOK], 0)
    else
      raise ENoFolderData.Create(LoadStr(IDS_NOFOLDERDATA));
  end
end;

procedure TdfsSystemListView.SetColumnWidths(NameWidth, SizeWidth, TypeWidth,
   ModifiedWidth, AttrWidth: integer);
begin
  with FColumnWidths do
  begin
    cwName := NameWidth;
    cwSize := SizeWidth;
    cwType := TypeWidth;
    cwModified := ModifiedWidth;
    cwAttr := AttrWidth;
  end;
  RecreateColumns;
end;

(*******************************************************************************
  DisplayContextMenu:
*******************************************************************************)
function TdfsSystemListView.DisplayContextMenu(Item: TListItem;
   Where: TPoint): boolean;
var
  ItemData: TFolderItemData;
  WantsToRename: boolean;
begin
  ItemData := GetItemData(Item);
  if (ItemData <> NIL) and (ItemData.IDList <> NIL) then
  begin
{$IFDEF DFS_COMPILER_4_UP}
    Result := ItemProp.DisplayContextMenu(ItemData.SFParent, ItemData.FIDList,
       ItemData.Attributes, DFS_HWND(Handle), Where, 1, TRUE,
       WantsToRename);
{$ELSE}
    Result := ItemProp.DisplayContextMenuPIDL(ItemData.SFParent,
       ItemData.FIDList, ItemData.Attributes,
       {$IFDEF DFS_CPPB} Pointer(Handle) {$ELSE} Handle {$ENDIF}, Where, 1, TRUE,
       WantsToRename);
{$ENDIF}
    if WantsToRename then
      Item.EditCaption;
  end
  else
    Result := FALSE;
end;

// The var parameter of this function is a memory block allocated with GetMem.
// The caller of the function MUST release the memory with FreeMem when
// done with the array. The PPIDLArray type is defined in the ItemProp unit.
// The return value is the number of items in the array.
function TdfsSystemListView.GetSelectedPIDLs(var SelPIDLs: PPIDLArray): integer;
var
  ItemData: TFolderItemData;
  NextItem: TListItem;
begin
  Result := 0;
  SelPIDLs := NIL;
  if SelCount < 1 then
    exit;

  GetMem(SelPIDLs, SizeOf(PItemIDList) * SelCount);
  try
    NextItem := GetNextItem(NIL, sdAll, [isSelected]);
    if NextItem = NIL then
    begin
      // Should never happen...
      FreeMem(SelPIDLs);
      SelPIDLs := NIL;
      exit;
    end;
    ItemData := GetItemData(NextItem);
    if (ItemData.IDList <> NIL) then
    begin
      while NextItem <> NIL do
      begin
        if (NextItem.Data <> NIL) and
           (TFolderItemData(NextItem.Data).IDList <> NIL) then
        begin
{ Turn off range checking because SelPILDs is typed as an array of 0..0.}
{$IFOPT R+} {$DEFINE DFS_RESET_RANGE_CHECKING} {$R-} {$ENDIF}
          SelPIDLs[Result] := TFolderItemData(NextItem.Data).FIDList;
{$IFDEF DFS_RESET_RANGE_CHECKING} {$R+} {$UNDEF DFS_RESET_RANGE_CHECKING} {$ENDIF}
          inc(Result);
        end;
        NextItem := GetNextItem(NextItem, sdAll, [isSelected]);
      end;
    end;
  except
    // Something bad happend.  Release the allocated memory and reraise it.
    // Don't free the pidls in the array, they don't belong to us!
    FreeMem(SelPIDLs);
    raise;
  end;
end;

function TdfsSystemListView.DisplaySelectedContextMenu(Where: TPoint): boolean;
var
  ItemData: TFolderItemData;
  SelPIDLs: PPIDLArray;
  Count: integer;
  WantsToRename: boolean;
begin
  Result := FALSE;
  Count := GetSelectedPIDLs(SelPIDLs);
  if SelPIDLs = NIL then
    exit;

  try
    ItemData := GetItemData(Selected);
{$IFDEF DFS_COMPILER_4_UP}
    Result := ItemProp.DisplayContextMenu(ItemData.SFParent, SelPIDLs^[0],
       ItemData.Attributes, DFS_HWND(Handle), Where, Count, TRUE, WantsToRename);
{$ELSE}
    Result := ItemProp.DisplayContextMenuPIDL(ItemData.SFParent, SelPIDLs^[0],
       ItemData.Attributes,
       {$IFDEF DFS_CPPB} Pointer(Handle) {$ELSE} Handle {$ENDIF}, Where, Count,
       TRUE, WantsToRename);
{$ENDIF}
    if (ItemFocused <> NIL) and WantsToRename then
      ItemFocused.EditCaption;
  finally
    // Free the array that was allocated by GetSelectedPIDLs.
    // Don't free the pidls in the array, they don't belong to us!
    FreeMem(SelPIDLs);
  end;
end;

function TdfsSystemListView.GetPopupMenu: TPopupMenu;
begin
  if FPopupMenuMethod in [pmmUser, pmmContextUser] then
    Result := inherited GetPopupMenu
  else
    Result := NIL;
end;

{$IFDEF DFS_COMPILER_5_UP}
procedure TdfsSystemListView.WMContextMenu(var Message: TWMContextMenu);
{$ELSE}
procedure TdfsSystemListView.WMRButtonUp(var Message: TWMRButtonUp);
{$ENDIF}
var
  SelItem: TListItem;
  Pt: TPoint;
begin
  case FPopupMenuMethod of
    pmmContext,
    pmmContextUser:
      begin
        {$IFDEF DFS_COMPILER_5_UP}
        Pt := ScreenToClient(Point(Message.XPos, Message.YPos));
        {$ELSE}
        Pt := Point(Message.XPos, Message.YPos);
        {$ENDIF}
        SelItem := GetItemAt(Pt.x, Pt.y);
        if SelItem <> NIL then
        begin
          if not SelItem.Selected then
          begin
            Selected := SelItem;
            if DisplayContextMenu(SelItem, ClientToScreen(Pt)) then
              Message.Result := 1;
          end else begin
            if DisplaySelectedContextMenu(ClientToScreen(Pt)) then
              Message.Result := 1;
          end;
        end;
      end;
  end;
  inherited;
end;

function TdfsSystemListView.GetItemAttrs(const Item: TListItem): UINT;
begin
  if (Item <> NIL) and (Item.Data <> NIL) then
    Result := GetItemData(Item).Attributes
  else
    Result := 0;
end;

function TdfsSystemListView.GetFullPath(const Item: TListItem): string;
begin
  Result := '';
  if (Item <> NIL) and (Item.Data <> NIL) then
  begin
    SetLength(Result, MAX_PATH);
    if SHGetPathFromIDList(GetItemData(Item).FQ_IDList, PChar(Result)) then
    begin
      SetLength(Result, StrLen(PChar(Result)));
      if ((GetItemAttrs(Item) and SFGAO_FOLDER) <> 0) and
         (Length(Result) <> 0) and (Result[Length(Result)] <> '\') then
        Result := Result + '\';
    end else
      Result := '';
  end;
end;


procedure TdfsSystemListView.SetShowFolders(Val: boolean);
begin
  if Val = FShowFolders then exit;
  FShowFolders := Val;
  Reset;
end;

function TdfsSystemListView.GetFilename(Index: TListItem): string;
begin
  if Index = NIL then
    Result := ''
  else
    Result := Index.Caption;
end;

function TdfsSystemListView.GetFullFilename(Index: TListItem): string;
begin
  if Index = NIL then
    Result := ''
  else
    Result := GetFullPath(Index);
end;


function DefaultListViewSort(Item1, Item2: TListItem; lParam: Integer): Integer; stdcall;
begin
  // CompareIDs can probably handle NIL pointers.  need to try it.
  if Item1 = Item2 then
    Result := 0
  else if Item1 = NIL then
    Result := -1
  else if Item2 = NIL then
    Result := 1
  else begin
    if Item1.Data <> NIL then
      with TFolderItemData(Item1.Data) do
        // 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.
        if ((Attributes and (SFGAO_HASSUBFOLDER or SFGAO_FOLDER))