📄 rmd_rptexp.pas
字号:
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 + -