⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 rmd_reportexplorer.pas

📁 这是一个功能强大
💻 PAS
📖 第 1 页 / 共 4 页
字号:
    3: str := ' ' + ''; {(a > z)}
    -3: str := ' ' + ''; {(z > a)}
    4: str := ' ' + ''; {(older > newer)}
    -4: str := ' ' + ''; {(newer > older)}
  end;

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

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

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

procedure TRMItemListView.GetItemsForFolder;
var
  lFolders: TStringList;
  lFolderInfo: TRMFolderInfo;
  lItemNames: TStringList;
  lItem: TListItem;
  i: Integer;
  lItemInfo: TRMItemInfo;
  liTotalSize: Integer;
  liData: PRMListItemData;
begin
  lFolders := TStringList.Create;
  lItemNames := TStringList.Create;
  Items.BeginUpdate;
  try
    ClearData;
    Items.Clear;
    FReportExplorer.GetChildFolders(FFolderId, lFolders);
    for i := 0 to lFolders.Count - 1 do
    begin
      lFolderInfo := TRMFolderInfo(lFolders.Objects[i]);
      lItem := Items.Add;
      lItem.Caption := lFolderInfo.Name;

      New(liData);
      liData.ItemId := lFolderInfo.FolderId;
      liData.ItemType := rmitFolder;
      lItem.Data := liData;

      lItem.ImageIndex := 3;
      lItem.SubItems.Add('');
      lItem.SubItems.Add(RMGetTypeDesc(rmitFolder));
      lFolderInfo.Free;
    end;

    FReportExplorer.GetItems(FFolderId, lItemNames);

    liTotalSize := 0;
    for i := 0 to lItemNames.Count - 1 do
    begin
      lItemInfo := TRMItemInfo(lItemNames.Objects[i]);
      lItem := Items.Add;
      lItem.Caption := lItemInfo.Name;
      lItem.ImageIndex := 0; //lItemInfo.ItemType - 1;

      New(liData);
      liData.ItemId := lItemInfo.ItemId;
      liData.ItemType := lItemInfo.ItemType;
      lItem.Data := liData;

      lItem.SubItems.Add(Format('%8.2f', [lItemInfo.Size / 1024]) + 'KB');
      lItem.SubItems.Add(RMGetTypeDesc(rmitReport));
      lItem.SubItems.Add(FormatDateTime(ShortDateFormat + ' ' + ShortTimeFormat, lItemInfo.Modified));
      liTotalSize := liTotalSize + lItemInfo.Size;
      lItemInfo.Free;
    end;

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

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMReportItem}

constructor TRMReportItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
end;

procedure TRMReportItem.Assign(Source: TPersistent);
begin
  if Source is TRMReportItem then
  begin
    FReport := TRMReportItem(Source).Report;
  end
  else
    inherited Assign(Source);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMReportItems}

constructor TRMReportItems.Create(aReportExplorer: TRMReportExplorer; aReportItemClass: TRMReportItemClass);
begin
  inherited Create(aReportItemClass);
  FReportExplorer := aReportExplorer;
end;

function TRMReportItems.GetOwner: TPersistent;
begin
  Result := FReportExplorer;
end;

function TRMReportItems.Add: TRMReportItem;
begin
  Result := TRMReportItem(inherited Add);
end;

function TRMReportItems.GetItem(Index: Integer): TRMReportItem;
begin
  Result := TRMReportItem(inherited GetItem(Index));
end;

procedure TRMReportItems.SetItem(Index: Integer; Value: TRMReportItem);
begin
  inherited SetItem(Index, Value);
end;

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

type
  THackReport = class(TRMReport)
  end;

constructor TRMReportExplorer.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);

  FRootKey := 'Software\WHF SoftWare\Report Machine\Report Explorer\';

  FFolderFieldNames := TRMFolderFieldNames.Create;
  FFolderDataSet := nil;

  FItemFieldNames := TRMItemFieldNames.Create;
  FItemDataSet := nil;

  FForm := nil;
  FReports := TRMReportItems.Create(Self, TRMReportItem);
end;

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

procedure TRMReportExplorer.Notification(aComponent: TComponent; Operation: TOperation);
var
  i: Integer;
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 is TRMReport then
    begin
      for i := 0 to FReports.Count - 1 do
      begin
        if FReports[i].Report = aComponent then
          FReports[i].Report := nil;
      end;
    end;
  end;
end;

function TRMReportExplorer.IsReport(const aId: Integer): Boolean;
begin
  Result := LocateItemRecord(aId);
end;

function TRMReportExplorer.LocateItemRecord(const aId: Integer): Boolean;
begin
  Result := FItemDataSet.Locate(FItemFieldNames.ItemId, aId, [loCaseInsensitive]);
end;

procedure TRMReportExplorer.SetReports(Value: TRMReportItems);
begin
  FReports.Assign(Value);
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(nil);
  try
    TRMDFormReportExplorer(FForm).ReportExplorer := Self;
    FForm.ShowModal;
  finally
    FForm.Free; FForm := nil;
  end;
end;

function TRMReportExplorer.MoveFolderToFolder(aFolderId, aNewParentId: Integer): Boolean;
var
  str: string;
  liCollidingId: Integer;
  liAllReportsMoved: Boolean;
  liAllFoldersMoved: Boolean;
  liResult: Word;

  function _MoveFoldersToFolder(aOldFolderId, aNewFolderId: Integer): Boolean;
  var
    liList: TStringList;
    i: Integer;
    liFolderInfo: TRMFolderInfo;
  begin
    Result := True;
    liList := TStringList.Create;
    try
      GetChildFolders(aOldFolderId, liList);
      for i := 0 to liList.Count - 1 do
      begin
        liFolderInfo := TRMFolderInfo(liList.Objects[i]);
        if not MoveFolderToFolder(liFolderInfo.FolderId, aNewFolderId) then
          Result := False;
        liFolderInfo.Free;
      end;
    finally
      liList.Free;
    end;
  end;

  function _MoveItemsToFolder(aOldFolderId, aNewFolderId: Integer): Boolean;
  var
    liList: TStringList;
    i: Integer;
    liItemInfo: TRMItemInfo;
  begin
    Result := True;
    liList := TStringList.Create;
    try
      GetItems(aOldFolderId, liList);
      for i := 0 to liList.Count - 1 do
      begin
        liItemInfo := TRMItemInfo(liList.Objects[i]);
        if not MoveItemToFolder(liItemInfo.ItemId, aNewFolderId) then
          Result := False;
        liItemInfo.Free;
      end;
    finally
      liList.Free;
    end;
  end;

begin
  Result := False;
  str := GetFolderName(aFolderId);
  if FRecyclingItems then
  begin
    liCollidingId := -2;
    _MoveFoldersToFolder(aFolderId, liCollidingId);
    _MoveItemsToFolder(aFolderId, liCollidingId);
    DeleteFolder(aFolderId);
    Result := True;
  end
  else if not ValidFolderName(aNewParentId, str) then
  begin
    liCollidingId := FFolderDataSet[FFolderFieldNames.FolderId];
    if not FYesToAll then
    begin
      liResult := mrYesToAll;
      case liResult of
        mrYesToAll: FYesToAll := True;
        mrNo: Exit;
        mrCancel: Exit;
      end;
    end;

    liAllFoldersMoved := _MoveFoldersToFolder(aFolderId, liCollidingId);
    liAllReportsMoved := _MoveItemsToFolder(aFolderId, liCollidingId);
    if liAllReportsMoved and liAllFoldersMoved then
      DeleteFolder(aFolderId);
    Result := True;
  end
  else
  begin
    if FFolderDataSet.Locate(FFolderFieldNames.FolderId, aFolderId, [loCaseInsensitive]) then
    begin
      FFolderDataSet.Edit;
      FFolderDataSet[FFolderFieldNames.ParentId] := aNewParentId;
      FFolderDataSet.Post;
      Result := True;
    end;
  end;
end;

type
  THackDeisgner = class(TRMReportDesigner)
  end;

procedure TRMReportExplorer.New(aFolderId: Integer);
var
  i: Integer;
  tmp: TRMDSelectReportTypeForm;
begin
  if FReports.Count = 0 then Exit;

  for i := 0 to FReports.Count -1 do
  begin
    if FReports[i].Report <> nil then
      FReports[i].Report.Clear;
  end;

  FCurrentReport := nil;
  if FReports.Count = 1 then
  begin
    if (FReports[0].Report <> nil) and (RMDesignerComp <> nil) then
    begin
      FCurrentReport := FReports[0].Report;
      RMDesignerComp.OnSaveReport := OnSaveReportEvent;
    end;
  end
  else
  begin
    tmp := TRMDSelectReportTypeForm.Create(nil);
    try
      tmp.lstReportType.Items.Clear;
      for i := 0 to FReports.Count - 1 do
      begin
        if FReports[i].Report <> nil then
          tmp.lstReportType.Items.Add(FReports[i].Report.ReportCommon)
        else
          tmp.lstReportType.Items.Add('');
      end;

      if tmp.ShowModal = mrOK then
      begin
        i := tmp.lstReportType.ItemIndex;
        if (FReports[i].Report <> nil) and (RMDesignerComp <> nil) then
        begin
          FCurrentReport := FReports[i].Report;
          RMDesignerComp.OnSaveReport := OnSaveReportEvent;
        end;
      end;
    finally
      tmp.Free;
    end;
  end;

  if FCurrentReport <> nil then
  begin
    FCurrentFolderId := aFolderId;
    FCurrentItemName := GetNewReportName(aFolderId);
    FCurrentItemType := FCurrentReport.ReportClassType; // rmitReport;
    FInsertRecordFlag := True;
    FRefreshFlag := False;

    FCurrentReport.Clear;
    FCurrentReport.DesignReport;
    if FRefreshFlag then

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -