tbltreeview.pas

pde专用vcl

unit TBLTreeView;

interface

uses
  SysUtils, Classes, Controls, ComCtrls, DB, ADODB, Windows, Clipbrd, Dialogs;

type
  TTBLTreeView = class(TTreeView)
  private
    FADOconn: TADOConnection;
    FHowShow: string; //0:按照权限显示档案树;1:显示到档案类别;
    FUserID: string;
    FTBLProp: string; //档案库属性
    FTBLStyle: string; //档案库类型
    FMMROOMCODE: string;
    FQZCODE: string; //档案室

    procedure SetCB(T: string);
    function TreeFindItem(NodeItem: TTreeNode; ID: string): TTreeNode;
    function GetValueBySQL(strSQL: string): string;
    function GetValuesBySQL(strSQL: string): TStrings;
    function GetCreateTreeSql(Data: string): string;
    { Private declarations }
  protected
    { Protected declarations }
  public
    procedure TreeAddItem(ItemList: TStrings);
    procedure TreeModifyItem(ItemList: TStrings);
    procedure TreeRemoveItem(); overload;
    procedure TreeRemoveItem(ID: string); overload;
    procedure TreeCreate(DATA: string = 'MSSQL');
    procedure TreeCreateByRolePower(RoleCode: string; DATA: string);
    procedure TreeCreateByUserPower(UserID: string; DATA: string = 'MSSQL');
    procedure TreeLocation(ID: string);
    procedure TreeMoveItem(ParentID: string; ID: string);

    function GetTreeNodeID(): string; overload;
    function GetTreeNodeNODETYPE(): string; overload;
    function GetTreeNodeTBLNAME(): string; overload;
    function GetTreeNodeMMROOMID(): string; overload;
    function GetTreeNodeTBLPROPERTY(): string; overload;
    function GetTreeNodeTBLTYPE(): string; overload;
    function GetTreeNodePARENTID(): string; overload;

    function GetTreeNodeID(ID: string): string; overload;
    function GetTreeNodeNODETYPE(ID: string): string; overload;
    function GetTreeNodeTBLNAME(ID: string): string; overload;
    function GetTreeNodeMMROOMID(ID: string): string; overload;
    function GetTreeNodeTBLPROPERTY(ID: string): string; overload;
    function GetTreeNodeTBLTYPE(ID: string): string; overload;
    function GetTreeNodePARENTID(ID: string): string; overload;
    { Public declarations }
  published
    { Published declarations }
    property ADOconn: TADOConnection read FADOconn write FADOconn;
    property HowShow: string read FHowShow write FHowShow;
    property UserID: string read FUserID write FUserID;
    property TBLProp: string read FTBLProp write FTBLProp;
    property TBLStyle: string read FTBLStyle write FTBLStyle;
    property MMROOMCODE: string read FMMROOMCODE write FMMROOMCODE;
    property QZCODE: string read FQZCODE write FQZCODE;
  end;

procedure Register;

implementation
type
  PTNKEY = ^TTREENODEKEY;
  TTREENODEKEY = record
    ID: string;
    NODETYPE: string;
    TBLNAME: string;
    MMROOMID: string;
    TBLPROPERTY: string;
    TBLTYPE: string;
    PARENTID: string;
  end;

procedure Register;
begin
  RegisterComponents('PDE', [TTBLTreeView]);
end;

procedure TTBLTreeView.SetCB(T: string);
var
  cb: TClipboard;
begin
  cb := TClipboard.Create;
  cb.SetTextBuf(Pansichar(T));
  cb.Free;
end;

procedure TTBLTreeView.TreeCreate(DATA: string = 'MSSQL');
//档案主管和拥有建立档案类别权限的档案员可以看到整个树。
var
  adoquery: TADOQuery;
  itemList: TStrings;
  iLoop: integer;
  strSql: string;
  sUserAdmin: string; //用户身份 ,是否档案主管
  sShowCTree: string; //是否拥有显示全部档案类别树权限
  sWhereQZCode: string;
begin
  try
    sShowCTree := '0';
    sUserAdmin := GetValueBySQL('SELECT C_ADMIN FROM SYS_USERS WHERE ID = ' +
      FUserID);
    //建立档案室
    if Trim(FQZCode) <> '' then
      sWhereQZCode := ' where C_QZCODE=' + QuotedStr(FQZCode) + ' '
    else
      sWhereQZCode := '';
    if FMMROOMCODE = '' then
    begin
      if sUserAdmin = '1' then
        strSql := 'SELECT ID,C_MMROOMNAME FROM SYS_MMROOM ' + sWhereQZCode +
          ' ORDER BY C_MMROOMCODE '
      else
      begin
        if DATA = 'MSSQL' then
          sShowCTree :=
            GetValueBySQL('SELECT SUM(I_SET) AS S FROM (SELECT 1 AS I_SET FROM SYS_GROUPOP WHERE C_GROUPCODE IN (SELECT C_GROUPCODE FROM SYS_USERS WHERE ID = '
            + FUserID +
            ') AND C_OPCODE = ''ShowCTree'' UNION SELECT I_SET FROM SYS_USEROP WHERE I_USERID = ' + FUserID
            + ' AND C_OPCODE = ''ShowCTree''' + ') AS T');
        if DATA = 'ORACLE' then
          sShowCTree :=
            GetValueBySQL('SELECT SUM(I_SET) AS S FROM (SELECT 1 AS I_SET FROM SYS_GROUPOP WHERE C_GROUPCODE IN (SELECT C_GROUPCODE FROM SYS_USERS WHERE ID = '
            + FUserID +
            ') AND C_OPCODE = ''ShowCTree'' UNION SELECT I_SET FROM SYS_USEROP WHERE I_USERID = ' + FUserID
            + ' AND C_OPCODE = ''ShowCTree''' + ')');
        if sShowCTree = '' then
          sShowCTree := '0';
        if strtoint(sShowCTree) > 0 then
          strSql := 'SELECT ID,C_MMROOMNAME FROM SYS_MMROOM ' + sWhereQZCode +
            'ORDER BY C_MMROOMCODE'
        else
        begin
          if Trim(FQZCode) <> '' then
            sWhereQZCode := ' C_QZCODE=' + QuotedStr(FQZCode) + ' AND '
          else
            sWhereQZCode := '';
          strSql :=
            'SELECT ID,C_MMROOMNAME FROM SYS_MMROOM WHERE ' + sWhereQZCode +
            ' ID IN (SELECT DISTINCT I_MMROOMID FROM SYS_TBL WHERE ID IN (SELECT I_TBLID FROM ';
          strSql := strSql +
            '(SELECT 1 as I_SET,I_TBLID FROM SYS_GROUPAR WHERE C_GROUPCODE IN (SELECT C_GROUPCODE FROM SYS_USERS WHERE ID = ' + FUserID
            + ') ';
          if DATA = 'MSSQL' then
            strSql := strSql +
              'UNION SELECT I_SET,I_TBLID FROM SYS_USERAR WHERE I_USERID = ' + FUserID
              + ') as T GROUP BY I_TBLID HAVING SUM(I_SET) > 0))';
          if DATA = 'ORACLE' then
            strSql := strSql +
              'UNION SELECT I_SET,I_TBLID FROM SYS_USERAR WHERE I_USERID = ' + FUserID
              + ') GROUP BY I_TBLID HAVING SUM(I_SET) > 0))';
        end;
      end;
    end
    else
    begin
      strSql := 'SELECT ID,C_MMROOMNAME FROM SYS_MMROOM WHERE C_MMROOMCODE = '''
        + FMMROOMCODE + '''';
    end;

    adoquery := TADOQuery.Create(self);
    adoquery.Connection := FADOconn;

    adoquery.SQL.add(strSql);
    adoquery.Open;
    Self.Items.Clear;
    itemList := TStringList.Create;
    while not adoquery.Eof do
    begin
      itemList.Add('M' + adoquery.Fields[0].AsString);
      itemList.Add('MMROOM');
      itemList.Add(adoquery.Fields[1].AsString);
      itemList.Add(adoquery.Fields[0].AsString);
      itemList.Add('');
      itemList.Add('');
      itemList.Add('');
      TreeAddItem(itemList);
      itemList.Clear;
      adoquery.Next;
    end;
    adoquery.Close;
    adoquery.SQL.Clear;
    //建树
    if sUserAdmin = '1' then
    begin
      if FHowShow = '1' then
        strSql := 'SELECT ID,C_TYPE,C_TBLNAME,I_MMROOMID,C_PROPERTY,C_TBLTYPE,I_PARENTID FROM SYS_TBL WHERE C_TYPE = ''CLSC'' ORDER BY C_TYPE,I_LEVEL,I_ORDER,I_PARENTID'
      else
        strSql :=
          'SELECT ID,C_TYPE,C_TBLNAME,I_MMROOMID,C_PROPERTY,C_TBLTYPE,I_PARENTID FROM SYS_TBL WHERE (C_TYPE = ''CLSC'' OR C_TYPE = ''USET'') ORDER BY C_TYPE,I_LEVEL,I_ORDER,I_PARENTID';
    end
    else
    begin
      //if strtoint(sAddTClass) > 0 then
      if FHowShow = '1' then
      begin
        strSql :=
          'SELECT ID,C_TYPE,C_TBLNAME,I_MMROOMID,C_PROPERTY,C_TBLTYPE,I_PARENTID FROM SYS_TBL WHERE C_TYPE = ''CLSC'' ORDER BY C_TYPE,I_LEVEL,I_ORDER,I_PARENTID';
      end
      else
      begin
        strSql :=
          'Select ID,C_TYPE,C_TBLNAME,I_MMROOMID,C_PROPERTY,C_TBLTYPE,I_PARENTID,I_ORDER From (Select ID,C_TYPE,C_TBLNAME,I_MMROOMID,C_PROPERTY,C_TBLTYPE,I_PARENTID,I_ORDER,I_LEVEL from sys_tbl where c_type = ''CLSC'' Union ';
        strSql := strSql +
          'SELECT ID,C_TYPE,C_TBLNAME,I_MMROOMID,C_PROPERTY,C_TBLTYPE,I_PARENTID,I_ORDER,I_LEVEL FROM sys_tbl WHERE ID IN (SELECT I_TBLID FROM ';
        strSql := strSql +
          '(SELECT 1 as I_SET,I_TBLID FROM SYS_GROUPAR WHERE C_GROUPCODE IN (SELECT C_GROUPCODE FROM SYS_USERS WHERE ID = ' + FUserID
          + ') ';
        if DATA = 'MSSQL' then
          strSql := strSql +
            'UNION SELECT I_SET,I_TBLID FROM SYS_USERAR WHERE I_USERID = ' + FUserID
            + ') as T GROUP BY I_TBLID HAVING SUM(I_SET) > 0)) AS TT ORDER BY C_TYPE,I_LEVEL,I_ORDER,I_PARENTID';
        if DATA = 'ORACLE' then
          strSql := strSql +
            'UNION SELECT I_SET,I_TBLID FROM SYS_USERAR WHERE I_USERID = ' + FUserID
            + ') GROUP BY I_TBLID HAVING SUM(I_SET) > 0)) ORDER BY C_TYPE,I_LEVEL,I_ORDER,I_PARENTID';
      end;
    end;

    adoquery.SQL.add(strSql);
    adoquery.Open;
    //Self.Items.Clear;
    //itemList:=TStringList.Create;
    while not adoquery.Eof do
    begin
      itemList.Add(adoquery.Fields[0].AsString);
      itemList.Add(adoquery.Fields[1].AsString);
      itemList.Add(adoquery.Fields[2].AsString);
      itemList.Add(adoquery.Fields[3].AsString);
      itemList.Add(adoquery.Fields[4].AsString);
      itemList.Add(adoquery.Fields[5].AsString);
      itemList.Add(adoquery.Fields[6].AsString);
      if adoquery.Fields[1].AsString = 'USET' then
      begin
        if (FTBLProp = '') or (FTBLProp = adoquery.Fields[4].AsString) then
        begin
          if (FTBLStyle = '') or (FTBLStyle = adoquery.Fields[5].AsString) then
            TreeAddItem(itemList);
        end;
      end
      else
      begin
        TreeAddItem(itemList);
      end;

      itemList.Clear;
      adoquery.Next;
    end;
    adoquery.Close;
    adoquery.Destroy;
    // 如果不拥有显示全部档案类别树权限，则去除没有档案库的类别
    if (strtoint(sShowCTree) <= 0) and ((sUserAdmin = '0') or (sUserAdmin = '2'))
      and (FHowShow = '0') then
    begin
      for iLoop := Self.Items.Count - 1 downto 0 do
      begin
        //Messagebox(self.Handle,PAnsiChar(PTNKEY(Self.Items[iLoop].Data)^.TBLNAME),PAnsiChar('信息'),MB_OK+MB_ICONINFORMATION);
        if (PTNKEY(Self.Items[iLoop].Data)^.NODETYPE = 'CLSC') and (not
          Self.Items[iLoop].HasChildren) then
          Self.Items[iLoop].Delete;
      end;
    end;

    if Self.Items.Count > 0 then
    begin
      Self.Items.Item[0].Selected := true;
      Self.FullCollapse;
      Self.Items.Item[0].Expand(false);
      //Self.Items.Item[0].Selected:=true;
    end;
  except
    on E: Exception do
      Messagebox(self.Handle,
        PAnsiChar('数据库操作失败！请检查数据连接是否正常。' + chr(10) + chr(13)
        +
        '详细错误信息如下：' + chr(10) + chr(13) + E.Message),
        PAnsiChar('信息'),
        MB_OK + MB_ICONINFORMATION);
  end;
end;

function TTBLTreeView.TreeFindItem(NodeItem: TTreeNode; ID: string): TTreeNode;
begin
  if NodeItem = nil then
    NodeItem := Self.items.getfirstnode
  else
    NodeItem := NodeItem.getfirstchild;
  if (NodeItem <> nil) and (PTNKEY(NodeItem.Data)^.ID <> ID) then
    repeat
      NodeItem := NodeItem.GetNext;
    until (NodeItem = nil) or (PTNKEY(NodeItem.Data)^.ID = ID);
  Result := NodeItem;
end;

procedure TTBLTreeView.TreeAddItem(ItemList: TStrings);
var
  NewNode, ThisNode: TTreeNode;
  FKey: PTNKEY;
begin
  New(FKey);
  FKey^.ID := ItemList[0];
  FKey^.NODETYPE := ItemList[1];
  FKey^.TBLNAME := ItemList[2];
  FKey^.MMROOMID := ItemList[3];
  FKey^.TBLPROPERTY := ItemList[4];
  FKey^.TBLTYPE := ItemList[5];
  FKey^.PARENTID := ItemList[6];
  Self.Items.BeginUpdate;
  try
    if ItemList[1] = 'MMROOM' then
    begin
      NewNode := Self.items.AddObject(nil, ItemList[2], FKey);
    end
    else
    begin
      if ItemList[6] = '0' then
        ThisNode := TreeFindItem(nil, 'M' + ItemList[3])
      else
        ThisNode := TreeFindItem(nil, ItemList[6]);