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

📄 rmd_rptexp.pas

📁 report machine 2.3 功能强大
💻 PAS
📖 第 1 页 / 共 3 页
字号:
    Result := True;
    List := TStringList.Create;
    GetChildFolders(aOldFolderId, List);
    for Index := 0 to List.Count - 1 do
    begin
      FolderInfo := TRMFolderInfo(List.Objects[Index]);
      if not MoveFolderToFolder(FolderInfo.FolderId, aNewFolderId) then
        Result := False;
      FolderInfo.Free;
    end;
    List.Free;
  end;

  function MoveItemsToFolder(aOldFolderId, aNewFolderId: Integer): Boolean;
  var
    List: TStringList;
    Index: Integer;
    ItemInfo: TRMItemInfo;
  begin
    Result := True;
    List := TStringList.Create;
    GetItems(aOldFolderId, itAllFolders, List);
    for Index := 0 to List.Count - 1 do
    begin
      ItemInfo := TRMItemInfo(List.Objects[Index]);
      if not MoveItemToFolder(ItemInfo.Name, ItemInfo.ItemType, ItemInfo.FolderId, aNewFolderId) then
        Result := False;
      ItemInfo.Free;
    end;
    List.Free;
  end;

begin
  Result := False;
  lsFolderName := GetFolderName(aFolderId);
  if FRecyclingItems then
  begin
    CollidingId := -2;
    MoveFoldersToFolder(aFolderId, CollidingId);
    MoveItemsToFolder(aFolderId, CollidingId);
    DeleteFolder(aFolderId);
    Result := True;
  end
  else if not (ValidFolderName(aNewParentId, lsFolderName)) then
  begin
    CollidingId := FFolderDataSet[FFolderFieldNames.FolderId];
    if not FYesToAll then
    begin
      lResult := mrYesToAll;
      case lResult of
        mrYesToAll: FYesToAll := True;
        mrNo: Exit;
        mrCancel: Exit;
      end;
    end;

    lbAllFoldersMoved := MoveFoldersToFolder(aFolderId, CollidingId);
    lbAllReportsMoved := MoveItemsToFolder(aFolderId, CollidingId);
    if (lbAllReportsMoved) and (lbAllFoldersMoved) 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);
begin
  FCurrentFolderId := aFolderId;
  FCurrentItemName := GetNewReportName(aFolderId);
  FCurrentItemType := itReport;
  FInsertRecordFlag := FALSE;
  FRefreshFlag := FALSE;

  RM_Class.CurReport := FReport;
  FReport.Clear;
  FReport.Pages.Add;
  FReport.Pages[FReport.Pages.Count - 1].CreateUniqueName;
  THackReport(FReport).FOnSaveReport := FOnSaveReport_1;
  FReport.DesignReport;
  if FRefreshFlag then
  begin
  	TRMDFormReportExplorer(FForm).RefreshCurrentListView;
  end;
end;

procedure TRMReportExplorer.FOnSaveReport_1(var Saved: Boolean);
begin
  if THackDeisgner(RMDesigner).Modify_flag then
  begin
    if not FInsertRecordFlag then
    begin
      FItemDataSet.Insert;
      FInsertRecordFlag := TRUE;
    end
    else
      FItemDataSet.Edit;

    FItemDataSet[FItemFieldNames.Name] := FCurrentItemName;
    FItemDataSet[FItemFieldNames.ItemType] := FCurrentItemType;
    FItemDataSet[FItemFieldNames.FolderId] := FCurrentFolderId;
    FItemDataSet[FItemFieldNames.Modified] := Now;
    FReport.SaveToBlobField(FItemDataSet.FindField(FItemFieldNames.Template));
    FItemDataSet[FItemFieldNames.Size] := TBlobField(FItemDataSet.FindField(FItemFieldNames.Template)).BlobSize;
    FItemDataSet.Post;
	  FRefreshFlag := TRUE;
  end;
end;

procedure TRMReportExplorer.FOnSaveReport_2(var Saved: Boolean);
begin
  if THackDeisgner(RMDesigner).Modify_flag then
  begin
    FItemDataSet.Edit;
    FReport.SaveToBlobField(FItemDataSet.FindField(FItemFieldNames.Template));
    FItemDataSet[FItemFieldNames.Size] := TBlobField(FItemDataSet.FindField(FItemFieldNames.Template)).BlobSize;
    FItemDataSet[FItemFieldNames.Modified] := Now;
    FItemDataSet.Post;
	  FRefreshFlag := TRUE;
  end;
end;

procedure TRMReportExplorer.Open(const aReportName: string; aFolderId: Integer);
begin
  if IsReport(aReportName, aFolderId) then
  begin
		FCurrentItemName := aReportName;
    FCurrentFolderId := aFolderId;
    FReport.LoadFromBlobField(FItemDataSet.FindField(FItemFieldNames.Template));
    FReport.FileName := aReportName;
	  FRefreshFlag := FALSE;
    THackReport(FReport).FOnSaveReport := FOnSaveReport_2;
    FReport.DesignReport;
		if FRefreshFlag then
		  TRMDFormReportExplorer(FForm).RefreshCurrentListItem;
  end;
end;

procedure TRMReportExplorer.Print(const aReportName: string; aFolderId: Integer);
begin
  if IsReport(aReportName, aFolderId) then
  begin
    FCurrentFolderId := aFolderId;
    FReport.LoadFromBlobField(FItemDataSet.FindField(FItemFieldNames.Template));
    FReport.PrintReport;
  end;
end;

procedure TRMReportExplorer.PrintPreview(const aReportName: string; aFolderId: Integer);
begin
  if IsReport(aReportName, aFolderId) then
  begin
    FCurrentFolderId := aFolderId;
    FReport.LoadFromBlobField(FItemDataSet.FindField(FItemFieldNames.Template));
    FReport.ShowReport;
  end;
end;

procedure TRMReportExplorer.Rename(const aItemName, aNewName: string; aItemType, aFolderId: Integer);
begin
  if LocateItemRecord(aItemName, aItemType, aFolderId) 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
  FolderInfo: TRMFolderInfo;
begin
  aList.Clear;
  FFolderDataSet.First;
  while not FFolderDataSet.EOF do
  begin
    FolderInfo := TRMFolderInfo.Create;
    FolderInfo.Name := FFolderDataSet[FFolderFieldNames.Name];
    FolderInfo.FolderId := FFolderDataSet[FFolderFieldNames.FolderId];
    FolderInfo.ParentId := FFolderDataSet[FFolderFieldNames.ParentId];
    aList.AddObject(FolderInfo.Name, FolderInfo);

    FFolderDataSet.Next;
  end;
end;

procedure TRMReportExplorer.GetItems(aFolderId, aItemType: Integer; aList: TStrings);
var
  ItemInfo: 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) and
      ((aItemType = 0) or (FItemDataSet[FItemFieldNames.ItemType] = aItemType)) then
    begin
      ItemInfo := TRMItemInfo.Create;
      if (FItemDataSet[FItemFieldNames.Deleted] <> Null) then
        ItemInfo.Deleted := FItemDataSet[FItemFieldNames.Deleted];

      if (FItemDataSet[FItemFieldNames.Modified] <> Null) then
        ItemInfo.Modified := FItemDataSet[FItemFieldNames.Modified];

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

function TRMReportExplorer.GetNewFolderName(aParentId: Integer): string;
var
  Folders: TStringList;
  Index: Integer;
  lsFolderName: string;
  Increment: Integer;
begin
  Folders := TStringList.Create;
  GetChildFolders(aParentId, Folders);
  lsFolderName := 'New Folder';
  Index := Folders.IndexOf(lsFolderName);
  Increment := 2;
  while (Index <> -1) do
  begin
    lsFolderName := 'New Folder' + ' (' + IntToStr(Increment) + ')';
    Index := Folders.IndexOf(lsFolderName);
    Inc(Increment);
  end;

  for Index := 0 to Folders.Count - 1 do
    TRMFolderInfo(Folders.Objects[Index]).Free;

  Folders.Free;
  Result := lsFolderName;
end;

function TRMReportExplorer.ChangeFolder(const aItemName: string; aItemType, aFolderId, aNewFolderId: Integer): Boolean;
begin
  if aNewFolderId = itRecycleBin then
    FRecyclingItems := True;

  Result := MoveItemToFolder(aItemName, aItemType, aFolderId, aNewFolderId);
  if aNewFolderId = itRecycleBin then
    FRecyclingItems := False;
end;

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

  procedure RejectMoveFolder(const aFolderName: string);
  var
    lsCaption: string;
    lsMessage: string;
  begin
    lsCaption := 'Error'; {Error Moving Folder}
    lsMessage := '%s';
    lsMessage := Format(lsMessage, [aFolderName]);
  end;

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

  if aNewParentId = itRecycleBin then
    FRecyclingItems := True;

  FYesToAll := False;
  Result := MoveFolderToFolder(aFolderId, aNewParentId);
  if (aNewParentId = itRecycleBin) 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(const aItemName: string; aItemType, aFolderId: Integer);
begin
  if LocateItemRecord(aItemName, aItemType, aFolderId) 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
  FolderInfo: 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
      FolderInfo := TRMFolderInfo.Create;
      FolderInfo.Name := FFolderDataSet[FFolderFieldNames.Name];
      FolderInfo.FolderId := FFolderDataSet[FFolderFieldNames.FolderId];
      FolderInfo.ParentId := FFolderDataSet[FFolderFieldNames.ParentId];
      aList.AddObject(FolderInfo.Name, FolderInfo);
    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(const aItemName: string; aItemType, aFolderId, aNewFolderId: Integer): Boolean;
var
  lbUpdateFolder: Boolean;
  lbDeleteReport: Boolean;
begin
  Result := False;
  lbUpdateFolder := True;
  if not (FRecyclingItems) and (LocateItemRecord(aItemName, aItemType, aNewFolderId)) then
  begin
    lbDeleteReport := True;
    if lbDeleteReport then
      Delete(aItemName, aItemType, aNewFolderId)
    else
      lbUpdateFolder := False;
  end;

  if lbUpdateFolder and (LocateItemRecord(aItemName, aItemType, aFolderId)) then
  begin
    FItemDataSet.Edit;
    FItemDataSet[FItemFieldNames.FolderId] := aNewFolderId;
    FItemDataSet.Post;
    Result := True;
  end;
end;

function TRMReportExplorer.GetNewReportName(aFolderId: Integer): string;
var
  Reports: TStringList;
  Index: Integer;
  lsReportName: string;
  Increment: Integer;
begin
  Reports := TStringList.Create;
  GetItems(aFolderId, itReport, Reports);
  lsReportName := 'New Report';
  Index := Reports.IndexOf(lsReportName);
  Increment := 2;
  while Index <> -1 do
  begin
    lsReportName := 'New Report' + ' (' + IntToStr(Increment) + ')';
    Index := Reports.IndexOf(lsReportName);
    Inc(Increment);
  end;

  for Index := 0 to Reports.Count - 1 do
    TRMItemInfo(Reports.Objects[Index]).Free;

  Reports.Free;
  Result := lsReportName;
end;

function TRMReportExplorer.ValidFolderName(aParentId: Integer; aFolderName: string): Boolean;
var
  lsFieldNames: string;
begin
  Result := False;
  if (Length(aFolderName) = 0) then Exit;
  lsFieldNames := FFolderFieldNames.Name + ';' + FFolderFieldNames.ParentId;
  Result := not (FFolderDataSet.Locate(lsFieldNames, VarArrayOf([aFolderName, aParentId]), [loCaseInsensitive]));
end;

end.

⌨️ 快捷键说明

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