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

📄 rmd_rptexp.pas

📁 report machine 2.3 功能强大
💻 PAS
📖 第 1 页 / 共 3 页
字号:

{*****************************************}
{                                         }
{   Report Machine v2.0 - Data storage    }
{            Report Explorer              }
{                                         }
{*****************************************}

unit RMD_RptExp;

interface

{$I RM.INC}

uses
  Windows, Classes, SysUtils, Forms, Controls, Graphics, Menus, Dialogs, ComCtrls,
  DB, RM_Class, RM_Desgn
{$IFDEF Delphi6}, Variants{$ENDIF};

const
  itAllFolders = 0;
  itReport = 1;
  itFolder = 4;
  itRecycleBin = -2;

type
  TRMRenameFolderEvent = procedure(Sender: TObject; aFolderId: Integer; const aNewName: string) of object;
  TRMReportExplorer = class;

  { TRMFolderFieldNames }
  TRMFolderFieldNames = class(TPersistent)
  private
    FName: string;
    FFolderId: string;
    FParentId: string;
    FReportExplorer: TRMReportExplorer;
  public
    constructor Create(aExplorer: TRMReportExplorer);
    procedure Assign(Source: TPersistent); override;
    property ReportExplorer: TRMReportExplorer read FReportExplorer;
  published
    property FolderId: string read FFolderId write FFolderId;
    property Name: string read FName write FName;
    property ParentId: string read FParentId write FParentId;
  end;

  { TRMItemFieldNames }
  TRMItemFieldNames = class(TPersistent)
  private
    FDeleted: string;
    FFolderId: string;
    FItemId: string;
    FModified: string;
    FName: string;
    FReportExplorer: TRMReportExplorer;
    FSize: string;
    FTemplate: string;
    FItemType: string;
  public
    constructor Create(aExplorer: TRMReportExplorer);
    procedure Assign(Source: TPersistent); override;
    property ReportExplorer: TRMReportExplorer read FReportExplorer;
  published
    property Deleted: string read FDeleted write FDeleted;
    property FolderId: string read FFolderId write FFolderId;
    property ItemId: string read FItemId write FItemId;
    property Modified: string read FModified write FModified;
    property Name: string read FName write FName;
    property Size: string read FSize write FSize;
    property Template: string read FTemplate write FTemplate;
    property ItemType: string read FItemType write FItemType;
  end;

  { TRMFolderInfo }
  TRMFolderInfo = class
  private
    FName: string;
    FFolderId: Integer;
    FParentId: Integer;
  public
    property Name: string read FName write FName;
    property FolderId: Integer read FFolderId write FFolderId;
    property ParentId: Integer read FParentId write FParentId;
  end;

  { TRMItemInfo }
  TRMItemInfo = class
  private
    FDeleted: TDateTime;
    FFolderId: Integer;
    FItemId: Integer;
    FModified: TDateTime;
    FName: string;
    FSize: Integer;
    FItemType: Integer;
  public
    property Deleted: TDateTime read FDeleted write FDeleted;
    property FolderId: Integer read FFolderId write FFolderId;
    property ItemId: Integer read FItemId write FItemId;
    property Modified: TDateTime read FModified write FModified;
    property Name: string read FName write FName;
    property Size: Integer read FSize write FSize;
    property ItemType: Integer read FItemType write FItemType;
  end;

  { TRMItemList }
  TRMItemList = class(TListView)
  private
    FAllFolders: Boolean;
    FFolderId: Integer;
    FItemTypeFilter: Integer;
    FOnDoubleClick: TNotifyEvent;
    FOnFolderChange: TNotifyEvent;
    FOnRenameFolder: TRMRenameFolderEvent;
    FOnSelectionChange: TNotifyEvent;
    FReportExplorer: TRMReportExplorer;
    FSelectionCount: Integer;
    FSelectionSize: Integer;
    FSortMode: Integer;

    procedure DoOnDoubleClick;
    procedure DoOnFolderChange;
    procedure DoOnRenameFolder(aFolderId: Integer; const aNewName: string);
    procedure DoOnSelectionChange;
    function GetItemId: Integer;
    function GetItemName: string;
    function GetItemType: Integer;
    procedure GetItemsForFolder;
    procedure GetSelectedItems(aList: TStrings);
    procedure SetFolderId(aFolderId: Integer);
    procedure SetItemName(aName: string);
    procedure SetReportExplorer(aExplorer: TRMReportExplorer);
    procedure SetSortMode(aSortMode: Integer);
    procedure SetSortModeDescription;

    procedure ChangeEvent(Sender: TObject; Item: TListItem; Change: TItemChange);
    procedure CompareEvent(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
    procedure ColumnClickEvent(Sender: TObject; Column: TListColumn);
    procedure DblClickEvent(Sender: TObject);
    procedure DragDropEvent(Sender, Source: TObject; X, Y: Integer);
    procedure DragOverEvent(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure EditedEvent(Sender: TObject; Item: TListItem; var S: string);
    procedure EditingEvent(Sender: TObject; Item: TListItem; var AllowEdit: Boolean);
  protected
    procedure SetParent(aParent: TWinControl); override;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure DeleteSelection;
    procedure EmptyRecycleBin;
    procedure MoveSelectionToFolder(aFolderId: Integer);
    procedure RenameItem;

    property AllFolders: Boolean read FAllFolders;
    property FolderId: Integer read FFolderId write SetFolderId;
    property ItemName: string read GetItemName write SetItemName;
    property ItemId: Integer read GetItemId;
    property ItemType: Integer read GetItemType;
    property ItemTypeFilter: Integer read FItemTypeFilter write FItemTypeFilter;
    property ReportExplorer: TRMReportExplorer read FReportExplorer write SetReportExplorer;
    property SelectionCount: Integer read FSelectionCount;
    property SelectionSize: Integer read FSelectionSize;
    property SortMode: Integer read FSortMode write SetSortMode;

    property OnDoubleClick: TNotifyEvent read FOnDoubleClick write FOnDoubleClick;
    property OnFolderChange: TNotifyEvent read FOnFolderChange write FOnFolderChange;
    property OnRenameFolder: TRMRenameFolderEvent read FOnRenameFolder write FOnRenameFolder;
    property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
  end;

  { TRMReportExplorer }
  TRMReportExplorer = class(TComponent)
  private
    FForm: TForm;
    FCurrentFolderId: Integer;
    FCurrentItemName: string;
    FCurrentItemType: Integer;
    FRecyclingItems: Boolean;
    FYesToAll: Boolean;
    FFolderFieldNames: TRMFolderFieldNames;
    FFolderDataSet: TDataSet;
    FItemFieldNames: TRMItemFieldNames;
    FItemDataSet: TDataSet;
    FReport: TRMReport;
    FRootKey: string;
    FInsertRecordFlag: Boolean;
    FRefreshFlag: Boolean;

    procedure SetFolderFieldNames(aFolderFieldNames: TRMFolderFieldNames);
    procedure SetItemFieldNames(aItemFieldNames: TRMItemFieldNames);
    procedure DeleteItemsInFolder(aFolderId: Integer);
    function LocateItemRecord(const aItemName: string; aItemType, aFolderId: Integer): Boolean;
    function IsReport(const aItemName: string; aFolderId: Integer): Boolean;
    function MoveFolderToFolder(aFolderId, aNewParentId: Integer): Boolean;
    function MoveItemToFolder(const aItemName: string; aItemType, aFolderId, aNewFolderId: Integer): Boolean;
    function GetNewReportName(aFolderId: Integer): string;
    function ValidFolderName(aParentId: Integer; aFolderName: string): Boolean;

    procedure FOnSaveReport_1(var Saved: Boolean);
    procedure FOnSaveReport_2(var Saved: Boolean);
  protected
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure Notification(aComponent: TComponent; Operation: TOperation); override;
    procedure Execute;
    procedure New(aFolderId: Integer);
    procedure Open(const aReportName: string; aFolderId: Integer);
    procedure Print(const aReportName: string; aFolderId: Integer);
    procedure PrintPreview(const aReportName: string; aFolderId: Integer);
    procedure Rename(const aItemName, aNewName: string; aItemType, aFolderId: Integer);

    function GetParentId(aFolderId: Integer): Integer;
    procedure GetFolders(aList: TStrings);
    procedure GetItems(aFolderId, aItemType: Integer; aList: TStrings);
    function GetNewFolderName(aParentId: Integer): string;
    function ChangeFolder(const aItemName: string; aItemType, aFolderId, aNewFolderId: Integer): Boolean;
    function ChangeParentFolder(aFolderId, aNewParentId: Integer): Boolean;
    procedure AddFolder(aParentId: Integer; aFolderName: string; var aFolderId: Integer);
    procedure RenameFolder(aFolderId: Integer; const aNewName: string);
    procedure Delete(const aItemName: string; aItemType, aFolderId: Integer);
    function DeleteFolder(aFolderId: Integer): Boolean;
    procedure GetChildFolders(aFolderId: Integer; aList: TStrings);
    function GetFolderName(aFolderId: Integer): string;

    property CurrentItemName: string read FCurrentItemName write FCurrentItemName;
    property CurrentFolderId: Integer read FCurrentFolderId write FCurrentFolderId;
    property RMReport: TRMReport read FReport;
  published
    property FolderFieldNames: TRMFolderFieldNames read FFolderFieldNames write SetFolderFieldNames;
    property FolderDataSet: TDataSet read FFolderDataSet write FFolderDataSet;
    property ItemFieldNames: TRMItemFieldNames read FItemFieldNames write SetItemFieldNames;
    property ItemDataSet: TDataSet read FItemDataSet write FItemDataSet;
    property RootKey: string read FRootKey write FRootKey;
  end;

implementation

uses RMD_ExpFrm, RM_Utils, RM_Const;

function RMGetTypeDesc(aItemType: Integer): string;
begin
  case aItemType of
    itReport: Result := RMLoadStr(rmRes + 3157); //'Report';
    itFolder: Result := RMLoadStr(rmRes + 3158); //'Folder';
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMFolderFieldNames}

constructor TRMFolderFieldNames.Create(aExplorer: TRMReportExplorer);
begin
  inherited Create;
  FReportExplorer := aExplorer;
  FFolderId := 'FolderId';
  FName := 'Name';
  FParentId := 'ParentId';
end;

procedure TRMFolderFieldNames.Assign(Source: TPersistent);
var
  lSource: TRMFolderFieldNames;
begin
  if not (Source is TRMFolderFieldNames) then Exit;
  lSource := TRMFolderFieldNames(Source);
  FFolderId := lSource.FolderId;
  FName := lSource.Name;
  FParentId := lSource.ParentId;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMItemFieldNames}

constructor TRMItemFieldNames.Create(aExplorer: TRMReportExplorer);
begin
  inherited Create;
  FReportExplorer := aExplorer;
  FDeleted := 'Deleted';
  FFolderId := 'FolderId';
  FItemId := 'ItemId';
  FItemType := 'ItemType';
  FModified := 'Modified';
  FName := 'Name';
  FSize := 'Size';
  FTemplate := 'Template';
end;

procedure TRMItemFieldNames.Assign(Source: TPersistent);
var
  lSource: TRMItemFieldNames;
begin
  if not (Source is TRMItemFieldNames) then Exit;
  lSource := TRMItemFieldNames(Source);
  FDeleted := lSource.Deleted;
  FFolderId := lSource.FolderId;
  FItemId := lSource.ItemId;
  FItemType := lSource.ItemType;
  FModified := lSource.Modified;
  FName := lSource.Name;
  FSize := lSource.Size;
  FTemplate := lSource.Template;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMItemList}

constructor TRMItemList.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FAllFolders := False;
  FFolderId := 0;
  FItemTypeFilter := itAllFolders;
  FOnDoubleClick := nil;
  FOnFolderChange := nil;
  FOnRenameFolder := nil;
  FOnSelectionChange := nil;
  FReportExplorer := nil;
  FSelectionCount := 0;
  FSelectionSize := 0;
  FSortMode := 1;

  OnChange := ChangeEvent;
  OnColumnClick := ColumnClickEvent;
  OnCompare := CompareEvent;
  OnDblClick := DblClickEvent;
  OnDragDrop := DragDropEvent;
  OnDragOver := DragOverEvent;
  OnEdited := EditedEvent;
  OnEditing := EditingEvent;

  DragCursor := crDefault;
  DragMode := dmAutomatic;
  SortType := stText;
end;

destructor TRMItemList.Destroy;
begin
  inherited Destroy;
end;

procedure TRMItemList.SetParent(aParent: TWinControl);
var
  lColumn: TListColumn;
begin
  inherited SetParent(aParent);
  if (Columns.Count > 0) or (csDestroying in ComponentState) then Exit;
  lColumn := Columns.Add;
  lColumn.Width := 250;
  lColumn := Columns.Add;
  lColumn.Width := 120;
  lColumn.Alignment := taRightJustify;
  lColumn := Columns.Add;
  lColumn.Width := 100;
  lColumn := Columns.Add;
  lColumn.Width := 140;
end;

procedure TRMItemList.SetReportExplorer(aExplorer: TRMReportExplorer);
begin
  FReportExplorer := aExplorer;
end;

procedure TRMItemList.SetItemName(aName: string);
var
  lbFound: Boolean;
  liIndex: Integer;
  lItem: TListItem;
begin
  lItem := nil;
  lbFound := False;
  liIndex := 0;
  while not (lbFound) and (liIndex < Items.Count) do
  begin
    lItem := Items[liIndex];
    if (CompareText(lItem.Caption, aName) = 0) then
      lbFound := True
    else
      Inc(liIndex);
  end;
  if lbFound then
  begin
    Selected := lItem;
    DoOnSelectionChange;
  end;
end;

procedure TRMItemList.SetFolderId(aFolderId: Integer);
begin
  FFolderId := aFolderId;
  GetItemsForFolder;
end;

procedure TRMItemList.SetSortMode(aSortMode: Integer);
begin
  FSortMode := aSortMode;
  SetSortModeDescription;
end;

function TRMItemList.GetItemId: Integer;
var
  lItem: TListItem;
begin
  lItem := Selected;
  if (lItem <> nil) then
    Result := Integer(lItem.Data)
  else
    Result := -1;
end;

function TRMItemList.GetItemType: Integer;
var
  lItem: TListItem;
begin
  lItem := Selected;
  if (lItem <> nil) then
    Result := lItem.ImageIndex + 1
  else
    Result := -1;
end;

function TRMItemList.GetItemName: string;
var
  lItem: TListItem;
begin
  lItem := Selected;
  if (lItem <> nil) then
    Result := lItem.Caption
  else
    Result := '';
end;

procedure TRMItemList.DoOnDoubleClick;
begin
  if Assigned(FOnDoubleClick) then FOnDoubleClick(Self);
end;

procedure TRMItemList.DoOnFolderChange;
begin
  if Assigned(FOnFolderChange) then FOnFolderChange(Self);
end;

procedure TRMItemList.DoOnRenameFolder(aFolderId: Integer; const aNewName: string);
begin
  if Assigned(FOnRenameFolder) then FOnRenameFolder(Self, aFolderId, aNewName);
end;

procedure TRMItemList.DoOnSelectionChange;
begin
  if Assigned(FOnSelectionChange) then FOnSelectionChange(Self);
end;

procedure TRMItemList.ChangeEvent(Sender: TObject; Item: TListItem; Change: TItemChange);

⌨️ 快捷键说明

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