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

📄 rmd_reportexplorer.pas

📁 这是一个功能强大
💻 PAS
📖 第 1 页 / 共 4 页
字号:
      TRMDFormReportExplorer(FForm).RefreshCurrentListView;
  end;
end;

function TRMReportExplorer.GetCurrentReportIndex(aReportType: Byte): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to FReports.Count - 1 do
  begin
    if (FReports[i].Report <> nil) and (FReports[i].Report.ReportClassType = aReportType) then
    begin
      Result := i;
      Break;
    end;
  end;
end;

procedure TRMReportExplorer.Open(const aItemId, aFolderId, aItemType: Integer; aReportName: string);
var
  liIndex: Integer;
begin
  for liIndex := 0 to FReports.Count -1 do
  begin
    if FReports[liIndex].Report <> nil then
      FReports[liIndex].Report.Clear;
  end;

  if IsReport(aItemId) then
  begin
    liIndex := GetCurrentReportIndex(aItemType);
    if (liIndex >= 0) and (RMDesignerComp <> nil) then
    begin
      FCurrentReport := FReports[liIndex].Report;
      FCurrentItemName := aReportName;
      FCurrentFolderId := aFolderId;

      FCurrentReport.LoadFromBlobField(TBlobField(FItemDataSet.FindField(FItemFieldNames.Template)));
      FCurrentReport.FileName := aReportName;
      FInsertRecordFlag := False;
      FRefreshFlag := False;

      RMDesignerComp.OnSaveReport := OnSaveReportEvent;
      FCurrentReport.DesignReport;
      if FRefreshFlag then
        TRMDFormReportExplorer(FForm).RefreshCurrentListItem;
    end;
  end;
end;

procedure TRMReportExplorer.OnSaveReportEvent(Report: TRMReport; var ReportName: string; SaveAs: Boolean; var Saved: Boolean);
begin
  if SaveAs then
  begin
    Saved := False;
    Exit;
  end;

  if FInsertRecordFlag then
  begin
    FItemDataSet.Append;
    FItemDataSet[FItemFieldNames.Name] := FCurrentItemName;
    FItemDataSet[FItemFieldNames.ItemType] := FCurrentItemType;
    FItemDataSet[FItemFieldNames.FolderId] := FCurrentFolderId;
    FInsertRecordFlag := False;
  end
  else
  begin
    FItemDataSet.Edit;
  end;

  FCurrentReport.SaveToBlobField(TBlobField(FItemDataSet.FindField(FItemFieldNames.Template)));
  FItemDataSet[FItemFieldNames.Size] := TBlobField(FItemDataSet.FindField(FItemFieldNames.Template)).BlobSize;
  FItemDataSet[FItemFieldNames.Modified] := Now;
  FItemDataSet.Post;
  FRefreshFlag := TRUE;
end;

procedure TRMReportExplorer.Print(const aItemId, aFolderId, aItemType: Integer;
  const aReportName: string);
var
  liIndex: Integer;
begin
  if IsReport(aItemid) then
  begin
    liIndex := GetCurrentReportIndex(aItemType);
    if liIndex >= 0 then
    begin
      FCurrentReport := FReports[liIndex].Report;
      FCurrentFolderId := aFolderId;
      FCurrentReport.LoadFromBlobField(TBlobField(FItemDataSet.FindField(FItemFieldNames.Template)));
      FCurrentReport.PrintReport;
    end;
  end;
end;

procedure TRMReportExplorer.PrintPreview(const aItemId, aFolderId, aItemType: Integer;
  const aReportName: string);
var
  liIndex: Integer;
begin
  if IsReport(aItemid) then
  begin
    liIndex := GetCurrentReportIndex(aItemType);
    if liIndex >= 0 then
    begin
      FCurrentReport := FReports[liIndex].Report;
      FCurrentFolderId := aFolderId;
      FCurrentReport.LoadFromBlobField(TBlobField(FItemDataSet.FindField(FItemFieldNames.Template)));
      FCurrentReport.ShowReport;
    end;
  end;
end;

procedure TRMReportExplorer.Rename(aItemId: Integer; aNewName: string);
begin
  if LocateItemRecord(aItemId) then
  begin
    FItemDataSet.Edit;
    FItemDataSet[FItemFieldNames.Name] := aNewName;
    FItemDataset.Post;
  end;
end;

function TRMReportExplorer.GetParentId(aFolderId: Integer): Integer;
begin
  Result := -1;
  if FFolderDataSet.Locate(FFolderFieldNames.FolderId, aFolderId, [loCaseInsensitive]) then
    Result := FFolderDataSet[FFolderFieldNames.ParentId];
end;

procedure TRMReportExplorer.GetFolders(aList: TStrings);
var
  lFolderInfo: TRMFolderInfo;
begin
  aList.Clear;
  FFolderDataSet.First;
  while not FFolderDataSet.EOF do
  begin
    lFolderInfo := TRMFolderInfo.Create;
    lFolderInfo.Name := FFolderDataSet[FFolderFieldNames.Name];
    lFolderInfo.FolderId := FFolderDataSet[FFolderFieldNames.FolderId];
    lFolderInfo.ParentId := FFolderDataSet[FFolderFieldNames.ParentId];
    aList.AddObject(lFolderInfo.Name, lFolderInfo);

    FFolderDataSet.Next;
  end;
end;

procedure TRMReportExplorer.GetItems(aFolderId: Integer; aList: TStrings);
var
  lItemInfo: TRMItemInfo;
begin
  aList.Clear;
  if not Assigned(FItemDataSet) then Exit;

  if not FItemDataSet.Active then
    FItemDataSet.Active := TRUE;

  FItemDataSet.First;
  while not FItemDataSet.EOF do
  begin
    if (FItemDataSet[FItemFieldNames.FolderId] = aFolderId) then
//      ((aItemType = 0) or (FItemDataSet[FItemFieldNames.ItemType] >  aItemType)) then
    begin
      lItemInfo := TRMItemInfo.Create;
      if FItemDataSet[FItemFieldNames.Deleted] <> Null then
        lItemInfo.Deleted := FItemDataSet[FItemFieldNames.Deleted];

      if FItemDataSet[FItemFieldNames.Modified] <> Null then
        lItemInfo.Modified := FItemDataSet[FItemFieldNames.Modified];

      lItemInfo.FolderId := FItemDataSet[FItemFieldNames.FolderId];
      lItemInfo.ItemId := FItemDataSet[FItemFieldNames.ItemId];
      lItemInfo.ItemType := FItemDataSet[FItemFieldNames.ItemType];
      lItemInfo.Name := FItemDataSet[FItemFieldNames.Name];
      lItemInfo.Size := FItemDataSet[FItemFieldNames.Size];
      aList.AddObject(lItemInfo.Name, lItemInfo);
    end;
    FItemDataSet.Next;
  end;
end;

function TRMReportExplorer.GetNewFolderName(aParentId: Integer): string;
var
  liFolders: TStringList;
  i: Integer;
  liFolderName: string;
  liIncrement: Integer;
begin
  liFolders := TStringList.Create;
  try
    GetChildFolders(aParentId, liFolders);
    liFolderName := 'New Folder';
    i := liFolders.IndexOf(liFolderName);
    liIncrement := 1;
    while i <> -1 do
    begin
      liFolderName := 'New Folder' + ' (' + IntToStr(liIncrement) + ')';
      i := liFolders.IndexOf(liFolderName);
      Inc(liIncrement);
    end;

    for i := 0 to liFolders.Count - 1 do
      TRMFolderInfo(liFolders.Objects[i]).Free;
  finally
    liFolders.Free;
    Result := liFolderName;
  end;
end;

function TRMReportExplorer.ChangeFolder(aItemId, aNewFolderId: Integer): Boolean;
begin
  if aNewFolderId = rmitRecycleBin then
    FRecyclingItems := True;

  Result := MoveItemToFolder(aItemId, aNewFolderId);
  if aNewFolderId = rmitRecycleBin then
    FRecyclingItems := False;
end;

function TRMReportExplorer.ChangeParentFolder(aFolderId, aNewParentId: Integer): Boolean;

  procedure _RejectMoveFolder(const aFolderName: string);
  var
    str: string;
  begin
    str := Format('Error Moving Folder %s', [aFolderName]);
    Application.MessageBox(PChar(str), PChar(RMLoadStr(rmRes + 3168)),
      MB_ICONERROR + MB_OK);
  end;

begin
  Result := False;
  if aFolderId = aNewParentId then
  begin
    _RejectMoveFolder(GetFolderName(aFolderId));
    Exit;
  end;

  if aNewParentId = rmitRecycleBin then
    FRecyclingItems := True;

  FYesToAll := False;
  Result := MoveFolderToFolder(aFolderId, aNewParentId);
  if aNewParentId = rmitRecycleBin then
    FRecyclingItems := False;
end;

procedure TRMReportExplorer.AddFolder(aParentId: Integer; aFolderName: string; var aFolderId: Integer);

  function _LocateFolderRecord(const aFolderName: string; aParentId: Integer): Boolean;
  var
    lsFieldNames: string;
  begin
    lsFieldNames := FFolderFieldNames.Name + ';' + FFolderFieldNames.ParentId;
    Result := FFolderDataSet.Locate(lsFieldNames, VarArrayOf([aFolderName, aParentId]), [loCaseInsensitive]);
  end;

begin
  FFolderDataSet.Insert;
  FFolderDataSet[FolderFieldNames.Name] := aFolderName;
  FFolderDataSet[FFolderFieldNames.ParentId] := aParentId;
  FFolderDataSet.Post;
  if _LocateFolderRecord(aFolderName, aParentId) then
    aFolderId := FFolderDataSet[FFolderFieldNames.FolderId]
  else
    aFolderId := -1;

  if aFolderId = 0 then
  begin
    FFolderDataSet.Delete;
    FFolderDataSet.Insert;
    FFolderDataSet[FFolderFieldNames.Name] := aFolderName;
    FFolderDataSet[FFolderFieldNames.ParentId] := aParentId;
    FFolderDataSet.Post;
    if _LocateFolderRecord(aFolderName, aParentId) then
      aFolderId := FFolderDataSet[FFolderFieldNames.FolderId]
    else
      aFolderId := -1;
  end;
end;

procedure TRMReportExplorer.RenameFolder(aFolderId: Integer; const aNewName: string);
begin
  if FFolderDataSet.Locate(FFolderFieldNames.FolderId, aFolderId, [loCaseInsensitive]) then
  begin
    FFolderDataSet.Edit;
    FFolderDataSet[FFolderFieldNames.Name] := aNewName;
    FFolderDataSet.Post;
  end;
end;

procedure TRMReportExplorer.Delete(aItemId: Integer);
begin
  if LocateItemRecord(aItemId) then
    FItemDataSet.Delete;
end;

function TRMReportExplorer.DeleteFolder(aFolderId: Integer): Boolean;
begin
  Result := False;
  if (aFolderId = 0) or (aFolderId = -2) then Exit;

  while FFolderDataSet.Locate(FFolderFieldNames.ParentId, aFolderId, [loCaseInsensitive]) do
    DeleteFolder(FFolderDataSet[FFolderFieldNames.FolderId]);

  DeleteItemsInFolder(aFolderId);
  if FFolderDataSet.Locate(FFolderFieldNames.FolderId, aFolderId, [loCaseInsensitive]) then
    FFolderDataSet.Delete;
  Result := True;
end;

procedure TRMReportExplorer.GetChildFolders(aFolderId: Integer; aList: TStrings);
var
  lFolderInfo: TRMFolderInfo;
begin
  aList.Clear;
  if not Assigned(FFolderDataSet) then Exit;

  FFolderDataSet.First;
  while not FFolderDataSet.EOF do
  begin
    if FFolderDataSet[FFolderFieldNames.ParentId] = aFolderId then
    begin
      lFolderInfo := TRMFolderInfo.Create;
      lFolderInfo.Name := FFolderDataSet[FFolderFieldNames.Name];
      lFolderInfo.FolderId := FFolderDataSet[FFolderFieldNames.FolderId];
      lFolderInfo.ParentId := FFolderDataSet[FFolderFieldNames.ParentId];
      aList.AddObject(lFolderInfo.Name, lFolderInfo);
    end;
    FFolderDataSet.Next;
  end;
end;

function TRMReportExplorer.GetFolderName(aFolderId: Integer): string;
begin
  Result := '';
  if FFolderDataSet.Locate(FFolderFieldNames.FolderId, aFolderId, [loCaseInsensitive]) then
    Result := FFolderDataSet[FFolderFieldNames.Name];
end;

function TRMReportExplorer.MoveItemToFolder(aItemId, aNewFolderId: Integer): Boolean;
begin
  Result := False;
  if False {(not FRecyclingItems) and LocateItemRecord(aItemId)} then
  begin
    Self.Delete(aItemId);
  end
  else if LocateItemRecord(aItemId) then
  begin
    FItemDataSet.Edit;
    FItemDataSet[FItemFieldNames.FolderId] := aNewFolderId;
    FItemDataSet.Post;
    Result := True;
  end;
end;

function TRMReportExplorer.GetNewReportName(aFolderId: Integer): string;
var
  liReports: TStringList;
  liIndex: Integer;
  liReportName: string;
  liIncrement: Integer;
begin
  liReports := TStringList.Create;
  try
    GetItems(aFolderId, liReports);
    liReportName := 'New Report';
    liIndex := liReports.IndexOf(liReportName);
    liIncrement := 1;
    while liIndex <> -1 do
    begin
      liReportName := 'New Report' + ' (' + IntToStr(liIncrement) + ')';
      liIndex := liReports.IndexOf(liReportName);
      Inc(liIncrement);
    end;

    for liIndex := 0 to liReports.Count - 1 do
      TRMItemInfo(liReports.Objects[liIndex]).Free;
  finally
    liReports.Free;
    Result := liReportName;
  end;
end;

function TRMReportExplorer.ValidFolderName(aParentId: Integer; aFolderName: string): Boolean;
var
  str: string;
begin
  Result := False;
  if Length(aFolderName) = 0 then Exit;

  str := FFolderFieldNames.Name + ';' + FFolderFieldNames.ParentId;
  Result := not (FFolderDataSet.Locate(str, VarArrayOf([aFolderName, aParentId]), [loCaseInsensitive]));
end;

end.

⌨️ 快捷键说明

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