tbltreeview.~pas

pde专用vcl

unit TBLTreeView;

interface

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

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

    Procedure SetCB(T:string);
    function  TreeFindItem(NodeItem: TTreeNode; ID: String): TTreeNode;
    function GetValueBySQL(strSQL:string):string;
    function GetValuesBySQL(strSQL:string):TStrings;  
    { 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);
    procedure TreeCreateByUserPower(UserID:string);
    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;
  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; //是否拥有显示全部档案类别树权限
begin
  try
    sShowCTree:='0';
    sUserAdmin := GetValueBySQL('SELECT C_ADMIN FROM SYS_USERS WHERE ID = ' + FUserID);
    //建立档案室
    if FMMROOMCODE = '' then begin
      if sUserAdmin = '1' then
        strSql:='SELECT ID,C_MMROOMNAME FROM SYS_MMROOM 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 ORDER BY C_MMROOMCODE'
        else begin
          strSql:='SELECT ID,C_MMROOMNAME FROM SYS_MMROOM WHERE 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') 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]);
      if ThisNode <> nil then
      begin
        NewNode:=Self.items.AddChildObject(ThisNode, ItemList[2], FKey);
      end
      else begin
        //NewNode:=Self.items.AddObject(nil, ItemList[2], FKey);
        Exit;
      End;
    end;
    //节点类型
    if ItemList[1] = 'MMROOM' then
    begin
      NewNode.ImageIndex:=0;
      NewNode.SelectedIndex:=0;
    end;
    if ItemList[1] = 'CLSC' then
    begin
      NewNode.ImageIndex:=1;
      NewNode.SelectedIndex:=1;
    end;
    if ItemList[1] = 'USET' then
    begin
      NewNode.ImageIndex:=2;
      NewNode.SelectedIndex:=2;
    end;
    NewNode.Selected:=true;
  finally
    Self.Items.EndUpdate;
  end;
end;

function TTBLTreeView.GetValueBySQL(strSQL:string):string;
var adoRS:TADOQuery;
begin
  Result :='''';
  try
    adoRS := TADOQuery.Create(nil);
    adoRS.Connection := FADOconn;
    adoRS.SQL.Add(strSQL);
    adoRS.Open;
    if adoRS.RecordCount > 0 then
      if adoRS.Fields[0] = nil  then
        Result :=''
      else
        Result :=adoRS.Fields[0].AsString;
    adoRS.Close;
    adoRS.Free;
  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.GetValuesBySQL(strSQL:string):TStrings;
var
  adoRS:TADOQuery;
  ValueTs:TStrings;
  iLoop:Integer;
begin
  Result:=nil;
  ValueTs:=TStringList.Create;
  try
    adoRS := TADOQuery.Create(nil);
    adoRS.Connection := FADOconn;
    adoRS.SQL.Add(strSQL);
    adoRS.Open;
    if adoRS.RecordCount > 0 then
    begin
      for iLoop := 0 to adoRS.Fields.Count-1 do
      begin
        if adoRS.Fields[iLoop].IsNull then
          ValueTs.Add('')
        else
          ValueTs.Add(adoRS.Fields[iLoop].AsString);
      end;
    end;
    Result:= ValueTs; 
    adoRS.Close;
    adoRS.Free;
  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;

procedure TTBLTreeView.TreeModifyItem(ItemList: TStrings);
var
  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
    Self.Selected.Data:= FKey;