rmd_rptexp.pas

report machine 2.3 功能强大

var
  lItem: TListItem;
  liCount: Integer;
  liSize: Integer;
  lsSize: string;
  lItems: TStrings;
  liIndex: Integer;
begin
  lItems := TStringList.Create;
  GetSelectedItems(lItems);
  liCount := lItems.Count;
  liSize := 0;
  FAllFolders := True;
  for liIndex := 0 to lItems.Count - 1 do
  begin
    lItem := TListItem(lItems.Objects[liIndex]);
    if ((lItem.ImageIndex + 1) <> itFolder) then
    begin
      FAllFolders := False;
      lsSize := lItem.SubItems[0];
      lsSize := Copy(lsSize, 1, Length(lsSize) - Length('KB')); {'KB'}
      liSize := liSize + Round(StrToFloat(lsSize) * 1024);
    end;
  end;
  lItems.Free;
  FSelectionCount := liCount;
  FSelectionSize := liSize;
  DoOnSelectionChange;
end;

procedure TRMItemList.DblClickEvent(Sender: TObject);
var
  lItem: TListItem;
begin
  lItem := Selected;
  if (lItem = nil) then Exit;
  if ((lItem.ImageIndex + 1) = itFolder) then
  begin
    FFolderId := Integer(lItem.Data);
    GetItemsForFolder;
    DoOnFolderChange;
  end
  else
    DoOnDoubleClick;
end;

procedure TRMItemList.ColumnClickEvent(Sender: TObject; Column: TListColumn);
begin
  if (FSortMode = (Column.Index + 1)) then
    FSortMode := FSortMode * -1
  else
    FSortMode := Column.Index + 1;
  AlphaSort;
  SetSortModeDescription;
end;

procedure TRMItemList.CompareEvent(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
var
  liSize1: Integer;
  liSize2: Integer;
  ldDateTime1: TDateTime;
  ldDateTime2: TDateTime;
  liDiff: Double;
begin
  if ((Item1.ImageIndex + 1) = itFolder) and ((Item2.ImageIndex + 1) = itFolder) then
  begin
    case FSortMode of
      1: Compare := CompareText(Item1.Caption, Item2.Caption);
      -1: Compare := CompareText(Item2.Caption, Item1.Caption);
    end;
  end
  else if ((Item1.ImageIndex + 1) = itFolder) then
    Compare := -1
  else if ((Item2.ImageIndex + 1) = itFolder) then
    Compare := 1
  else
    case FSortMode of
      1: Compare := CompareText(Item1.Caption, Item2.Caption);
      -1: Compare := CompareText(Item2.Caption, Item1.Caption);
      2, -2:
        begin
          liSize1 := Round(StrToFloat(Copy(Item1.SubItems[0], 1, Length(Item1.SubItems[0]) - 2)));
          liSize2 := Round(StrToFloat(Copy(Item2.SubItems[0], 1, Length(Item2.SubItems[0]) - 2)));
          if (FSortMode = 2) then
            Compare := liSize1 - liSize2
          else
            Compare := liSize2 - liSize1;
        end;
      3: Compare := CompareText(Item1.SubItems[1], Item2.SubItems[1]);
      -3: Compare := CompareText(Item2.SubItems[1], Item1.SubItems[1]);
      4, -4:
        begin
          ldDateTime1 := StrToDateTime(Item1.SubItems[2]);
          ldDateTime2 := StrToDateTime(Item2.SubItems[2]);
          if (FSortMode = 4) then
            liDiff := ldDateTime1 - ldDateTime2
          else
            liDiff := ldDateTime2 - ldDateTime1;
          if (liDiff > 0) then
            Compare := 1
          else if (liDiff < 0) then
            Compare := -1
          else
            Compare := 0;
        end;
    end;
  if (Compare = 0) then
    Compare := CompareText(Item1.Caption, Item2.Caption);
end;

procedure TRMItemList.DragDropEvent(Sender, Source: TObject; X, Y: Integer);
var
  lTargetItem: TListItem;
begin
  lTargetItem := GetItemAt(X, Y);
  if (lTargetItem = nil) then Exit;
  if ((lTargetItem.ImageIndex + 1) <> itFolder) then Exit;
  MoveSelectionToFolder(Integer(lTargetItem.Data));
end;

procedure TRMItemList.DragOverEvent(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  lItem: TListItem;
begin
  lItem := GetItemAt(X, Y);
  if (lItem <> nil) then
    Accept := ((lItem.ImageIndex + 1) = itFolder)
  else
    Accept := False;
end;

procedure TRMItemList.EditingEvent(Sender: TObject; Item: TListItem; var AllowEdit: Boolean);
begin
  AllowEdit := (FFolderId <> -2);
end;

procedure TRMItemList.EditedEvent(Sender: TObject; Item: TListItem; var S: string);
begin
  if ((Item.ImageIndex + 1) = itFolder) then
  begin
//    liParentId := FReportExplorer.GetParentId(Integer(Item.Data));
    DoOnRenameFolder(Integer(Item.Data), S);
    FReportExplorer.RenameFolder(Integer(Item.Data), S);
  end
  else
  begin
    FReportExplorer.Rename(Item.Caption, S, Item.ImageIndex + 1, Integer(Item.Data));
  end;
end;

procedure TRMItemList.MoveSelectionToFolder(aFolderId: Integer);
var
  lItem: TListItem;
  liIndex: Integer;
  lItems: TStrings;
  lbChange: Boolean;
  lbFolderChange: Boolean;
begin
  lItems := TStringList.Create;
  GetSelectedItems(lItems);
  lbChange := False;
  lbFolderChange := False;
  for liIndex := 0 to lItems.Count - 1 do
  begin
    lItem := TListItem(lItems.Objects[liIndex]);
    if ((lItem.ImageIndex + 1) = itFolder) then
    begin
      if FReportExplorer.ChangeParentFolder(Integer(lItem.Data), aFolderId) then
        lbFolderChange := True;
    end
    else
    begin
      if FReportExplorer.ChangeFolder(lItem.Caption, lItem.ImageIndex + 1, Integer(lItem.Data), aFolderId) then
        lbChange := True;
    end;
  end;
  lItems.Free;
  if lbFolderChange then
    DoOnFolderChange
  else if lbChange then
    GetItemsForFolder;
end;

procedure TRMItemList.EmptyRecycleBin;
var
  lbConfirmed: Boolean;
  sl: TStringList;
  lIndex: Integer;
begin
  sl := TStringList.Create;
  try
    FReportExplorer.GetItems(-2, itAllFolders, sl);
    lbConfirmed := TRUE;
    for lIndex := 0 to sl.Count - 1 do
      TRMItemInfo(sl.Objects[lIndex]).Free;
    if lbConfirmed then
    begin
      FReportExplorer.DeleteItemsInFolder(-2);
      DoOnFolderChange;
    end;
  finally
    sl.Free;
  end;
end;

procedure TRMItemList.DeleteSelection;
var
  lItem: TListItem;
  lItems: TStrings;
  liIndex: Integer;
  lbConfirmed: Boolean;
  lbFolderChange: Boolean;
begin
  if Application.MessageBox('真的删除所选择的文件夹和报表吗?', '提示信息', MB_ICONQUESTION + MB_YESNO) <> IDYES then
    Exit;

  lItems := TStringList.Create;
  GetSelectedItems(lItems);
  if (FFolderId = itRecycleBin) then
    lbConfirmed := TRUE
  else
    lbConfirmed := TRUE;

  if not (lbConfirmed) then Exit;
  Items.BeginUpdate;
  lbFolderChange := False;
  for liIndex := 0 to lItems.Count - 1 do
  begin
    lItem := TListItem(lItems.Objects[liIndex]);
    if ((lItem.ImageIndex + 1) = itFolder) then
      lbFolderChange := True;
    if (FFolderId = itRecycleBin) then
      FReportExplorer.Delete(lItem.Caption, lItem.ImageIndex + 1, Integer(lItem.Data))
    else
    begin
      if ((lItem.ImageIndex + 1) = itFolder) then
        FReportExplorer.ChangeParentFolder(Integer(lItem.Data), -2)
      else
        FReportExplorer.ChangeFolder(lItem.Caption, lItem.ImageIndex + 1, Integer(lItem.Data), -2);
    end;
    lItem.Free;
  end;

  lItems.Free;
  Items.EndUpdate;
  if lbFolderChange then
    DoOnFolderChange;
end;

procedure TRMItemList.RenameItem;
var
  lItem: TListItem;
begin
  lItem := Selected;
  if (lItem <> nil) and (Integer(lItem.Data) >= 0) then
    lItem.EditCaption;
end;

procedure TRMItemList.SetSortModeDescription;
var
  lsSortDesc: string;
  liIndex: Integer;
begin
  Columns[0].Caption := '名称'; {Name}
  Columns[1].Caption := '大小'; {Size}
  Columns[2].Caption := '类型'; {Type}
  Columns[3].Caption := '修改时间'; {Modified}
  case FSortMode of
    1: lsSortDesc := ' ' + ''; {(a > z)}
    -1: lsSortDesc := ' ' + ''; {(z > a)}
    2: lsSortDesc := ' ' + ''; {(small > large)}
    -2: lsSortDesc := ' ' + ''; {(large > small)}
    3: lsSortDesc := ' ' + ''; {(a > z)}
    -3: lsSortDesc := ' ' + ''; {(z > a)}
    4: lsSortDesc := ' ' + ''; {(older > newer)}
    -4: lsSortDesc := ' ' + ''; {(newer > older)}
  end;

  if (FSortMode < 0) then
    liIndex := (FSortMode * -1) - 1
  else
    liIndex := FSortMode - 1;

  Columns[liIndex].Caption := Columns[liIndex].Caption + lsSortDesc;
end;

procedure TRMItemList.GetSelectedItems(aList: TStrings);
var
  lItem: TListItem;
begin
  lItem := Selected;
  while (lItem <> nil) do
  begin
    aList.AddObject(lItem.Caption, lItem);
    lItem := GetNextItem(lItem, sdAll, [isSelected]);
  end;
end;

procedure TRMItemList.GetItemsForFolder;
var
  lFolders: TStringList;
  lFolderInfo: TRMFolderInfo;
  lItemNames: TStringList;
  lItem: TListItem;
  liIndex: Integer;
  lItemInfo: TRMItemInfo;
  liTotalSize: Integer;
begin
  lFolders := TStringList.Create;
  lItemNames := TStringList.Create;
  Items.BeginUpdate;
  Items.Clear;
  FReportExplorer.GetChildFolders(FFolderId, lFolders);
  for liIndex := 0 to lFolders.Count - 1 do
  begin
    lFolderInfo := TRMFolderInfo(lFolders.Objects[liIndex]);
    lItem := Items.Add;
    lItem.Caption := lFolderInfo.Name;
    lItem.Data := TObject(lFolderInfo.FolderId);
    lItem.ImageIndex := itFolder - 1;
    lItem.SubItems.Add('');
    lItem.SubItems.Add(RMGetTypeDesc(itFolder));
    lFolderInfo.Free;
  end;
  if (FItemTypeFilter <> itAllFolders) then
    FReportExplorer.GetItems(FFolderId, FItemTypeFilter, lItemNames)
  else
    FReportExplorer.GetItems(FFolderId, itAllFolders, lItemNames);

  liTotalSize := 0;
  for liIndex := 0 to lItemNames.Count - 1 do
  begin
    lItemInfo := TRMItemInfo(lItemNames.Objects[liIndex]);
    lItem := Items.Add;
    lItem.Caption := lItemInfo.Name;
    lItem.ImageIndex := lItemInfo.ItemType - 1;
    lItem.Data := TObject(lItemInfo.FolderId);
    lItem.SubItems.Add(Format('%8.2f', [lItemInfo.Size / 1024]) + 'KB');
    lItem.SubItems.Add(RMGetTypeDesc(lItemInfo.ItemType));
    lItem.SubItems.Add(FormatDateTime(ShortDateFormat + ' ' + ShortTimeFormat, lItemInfo.Modified));
    liTotalSize := liTotalSize + lItemInfo.Size;
    lItemInfo.Free;
  end;

  FSelectionCount := lItemNames.Count;
  FSelectionSize := liTotalSize;
  lFolders.Free;
  lItemNames.Free;
  Items.EndUpdate;
end;

type
  THackReport = class(TRMReport)
  end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMReportExplorer}

constructor TRMReportExplorer.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FReport := TRMReport.Create(Self);
  FRootKey := 'Software\WHF SoftWare\Report Machine\Report Explorer\';

  FFolderFieldNames := TRMFolderFieldNames.Create(Self);
  FFolderDataSet := nil;

  FItemFieldNames := TRMItemFieldNames.Create(Self);
  FItemDataSet := nil;

  FForm := nil;
end;

destructor TRMReportExplorer.Destroy;
begin
  FReport.Free; FReport := nil;
  FFolderFieldNames.Free;
  FItemFieldNames.Free;
  inherited Destroy;
end;

procedure TRMReportExplorer.Notification(aComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(aComponent, Operation);
  if Operation = opRemove then
  begin
    if (aComponent = FFolderDataSet) then
      FFolderDataSet := nil
    else if (aComponent = FItemDataSet) then
      FItemDataSet := nil
    else if (aComponent = FReport) then
      FReport := nil;
  end;
end;

function TRMReportExplorer.IsReport(const aItemName: string; aFolderId: Integer): Boolean;
begin
  Result := LocateItemRecord(aItemName, itReport, aFolderId);
end;

function TRMReportExplorer.LocateItemRecord(const aItemName: string; aItemType, aFolderId: Integer): Boolean;
var
  lsFieldNames: string;
begin
  lsFieldNames := FItemFieldNames.FolderId + ';' +
    FItemFieldNames.ItemType + ';' +
    FItemFieldNames.Name;
  Result := FItemDataSet.Locate(lsFieldNames, VarArrayOf([aFolderId, aItemType, aItemName]), [loCaseInsensitive]);
end;

procedure TRMReportExplorer.SetFolderFieldNames(aFolderFieldNames: TRMFolderFieldNames);
begin
  FFolderFieldNames.Assign(aFolderFieldNames);
end;

procedure TRMReportExplorer.SetItemFieldNames(aItemFieldNames: TRMItemFieldNames);
begin
  FItemFieldNames.Assign(aItemFieldNames);
end;

procedure TRMReportExplorer.DeleteItemsInFolder(aFolderId: Integer);
begin
  while FItemDataSet.Locate(FItemFieldNames.FolderId, aFolderId, [loCaseInsensitive]) do
    FItemDataSet.Delete;
end;

procedure TRMReportExplorer.Execute;
begin
  if (not Assigned(FFolderDataSet)) or (not Assigned(FItemDataSet)) then Exit;

  if not FFolderDataSet.Active then FFolderDataSet.Active := TRUE;
  if not FItemDataSet.Active then FItemDataSet.Active := TRUE;
  FForm := TRMDFormReportExplorer.Create(Application);
  try
    TRMDFormReportExplorer(FForm).ReportExplorer := Self;
    FForm.ShowModal;
  finally
    FForm.Free; FForm := nil;
  end;
end;

function TRMReportExplorer.MoveFolderToFolder(aFolderId, aNewParentId: Integer): Boolean;
var
  lsFolderName: string;
  CollidingId: Integer;
  lbAllReportsMoved: Boolean;
  lbAllFoldersMoved: Boolean;
  lResult: Word;

  function MoveFoldersToFolder(aOldFolderId, aNewFolderId: Integer): Boolean;
  var
    List: TStringList;
    Index: Integer;
    FolderInfo: TRMFolderInfo;
  begin