📄 frmtreedef.frm

📁 一个把自己的东西刻成光盘后自动查询和启动的原代码
💻 FRM
📖 第 1 页 / 共 4 页
字号:
   ElseIf TabMain.Tab = 2 Then '修改列表
      If OptListType(0).Value = True Then '案卷
         tStr = "0"
      Else
         If CbxViewList.ListIndex = 2 Then '仅文件
            tStr = "2"
         Else
            tStr = "1"
         End If
      End If
      gDbs.Execute "delete from list_defination where node_id=" + TxtNodeID + " and list_type=" + tStr
      gDbs.Execute "update tree_defination set view_list=" + CStr(CbxViewList.ListIndex) + " where node_id=" + TxtNodeID
      For i = 1 To LVResult.ColumnHeaders.Count
         Call GetValue(tFieldName, "field_name", LVResult.ColumnHeaders(i).key)
         Call GetValue(t_Dict_Type, "dict_type", LVResult.ColumnHeaders(i).key)
         'tSql = tSql + tFieldName + " as " + Trim(LVResult.ColumnHeaders(i).Text) + ","
         gDbs.Execute "insert into list_defination (node_id,field_en_name,field_cn_name,view_index,system_dict_type,order_by,type_code,list_type,data_type) " & _
           "values(" + TxtNodeID + ",'" + tFieldName + "','" + Trim(LVResult.ColumnHeaders(i).Text) + "'," + CStr(i) + "," + t_Dict_Type + ",'','" + TxtTypeCode + "'," + tStr + ",0)"
      Next i
      MsgBox "列表修改成功", vbExclamation, XTTS
   
   End If
End If

Err:

End Sub

Private Sub CmdSel_Click(Index As Integer)
On Error Resume Next
Dim i As Integer
If LVViewField.ListItems.Count < 1 Then Exit Sub
LVResult.ColumnHeaders.Clear
If Index = 0 Then '全选
   For i = 1 To LVViewField.ListItems.Count
       LVViewField.ListItems(i).Checked = True
       LVResult.ColumnHeaders.Add , LVViewField.ListItems(i).key, LVViewField.ListItems(i).Text
   Next i
ElseIf Index = 1 Then
   For i = 1 To LVViewField.ListItems.Count
       LVViewField.ListItems(i).Checked = False
   Next i
End If
End Sub

Private Sub Form_Load()

Set gRst = gDbs.OpenRecordset("select * from system_dict where type=51 order by code")
CbxDictType.Clear
CbxDictType.AddItem "无"
CbxDictType.ItemData(0) = 0
While Not gRst.EOF
   CbxDictType.AddItem Trim(gRst.Fields("name"))
   CbxDictType.ItemData(CbxDictType.ListCount - 1) = CInt(gRst.Fields("code"))
   gRst.MoveNext
Wend
If CbxDictType.ListCount > 0 Then CbxDictType.ListIndex = 0
'LVMain.ColumnHeaders.Add , "Node_ID", "节点序号"
'LVMain.ColumnHeaders.Add , "Tree_Type", "目录树类型"
'LVMain.ColumnHeaders.Add , "Tree_Name", "目录树显示名称"
'LVMain.ColumnHeaders.Add , "Tree_User_Name", "目录树使用者"
'LVMain.ColumnHeaders.Add , "Parent_Node_ID", "父节点序号"
'LVMain.ColumnHeaders.Add , "Node_Level_Index", "显示顺序"
'LVMain.ColumnHeaders.Add , "Field_En_Name", "字段名称"
'LVMain.ColumnHeaders.Add , "Field_Cn_Name", "字段显示名称"
'LVMain.ColumnHeaders.Add , "Is_Root", "是否是根节点"
'LVMain.ColumnHeaders.Add , "Field_Value", "字段值"
'LVMain.ColumnHeaders.Add , "Table_Name", "表名"
'LVMain.ColumnHeaders.Add , "Node_Type", "节点类型"
'LVMain.ColumnHeaders.Add , "View_List", "是否显示列表"
'LVMain.ColumnHeaders.Add , "Where_String", "查询语句"
'LVMain.ColumnHeaders.Add , "Type_Code", "档案类型"

End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Err
gWrks.CommitTrans
Err:
End Sub

Private Sub LVViewField_ItemCheck(ByVal Item As MSComctlLib.ListItem)
On Error GoTo Err
Dim i As Integer

gErrDescription = ""

If OptListType(0).Value = False And OptListType(1).Value = False Then Exit Sub
If Item.Checked = True Then
   LVResult.ColumnHeaders.Add , Item.key, Trim(Item.Text)
Else
   For i = 1 To LVResult.ColumnHeaders.Count
      If LVResult.ColumnHeaders(i).key = Item.key Then LVResult.ColumnHeaders.Remove i
   Next i
End If
Err:
End Sub

Private Sub m_Delete_Click()
On Error GoTo Err
Dim tNodeID As String

gErrDescription = ""

If TVTreeNode.SelectedItem Is Nothing Then Exit Sub
If GetValue(tNodeID, "Node_ID", TVTreeNode.SelectedItem.key) = False Then GoTo Err
Set gRst = gDbs.OpenRecordset("select * from TREE_DEFINATION where Node_ID=" + tNodeID)
If (gRst.EOF) Then Exit Sub
If MsgBox("您是否确认要删除该节点", vbQuestion + vbYesNo) = vbNo Then Exit Sub
'???????????????????????????????????????
gDbs.Execute "delete from list_defination where Node_ID=" + CStr(tNodeID)
gDbs.Execute "delete from tree_defination where Node_ID=" + CStr(tNodeID)
gDbs.Execute "delete from tree_defination where Parent_Node_ID=" + CStr(tNodeID)

Call SaveEventLog("6099", 0, "", "", "删除自定义节点:" + tNodeID)

Err:
End Sub

Private Sub m_Insert_Do_Click(Index As Integer)
On Error GoTo Err

Dim tNodeID As String

gErrDescription = ""

If TVTreeNode.Nodes.Count < 1 Then '无节点，第一次增加
    Set gRst = gDbs.OpenRecordset("select * from TREE_DEFINATION where Node_ID=" + TxtRootNodeID)
    If Not (gRst.EOF) Then
       TxtPTableName = ConvertNull(gRst.Fields("table_name"))
       TxtPTypeCode = ConvertNull(gRst.Fields("type_code"))
       TxtParentNodeID = TxtRootNodeID
       TxtLevelIndex = "1"
    End If

Else
    If TVTreeNode.SelectedItem Is Nothing Then GoTo Err
    If GetValue(tNodeID, "Node_ID", TVTreeNode.SelectedItem.key) = False Then GoTo Err
    Set gRst = gDbs.OpenRecordset("select * from TREE_DEFINATION where Node_ID=" + tNodeID)
    '父节点id
    tNodeID = ConvertNull(gRst.Fields("parent_node_id"))
    Select Case Index
       Case 0 '插入
            Set gRst = gDbs.OpenRecordset("select * from TREE_DEFINATION where Node_ID=" + tNodeID)
            If Not (gRst.EOF) Then
               TxtPTableName = ConvertNull(gRst.Fields("table_name"))
               TxtPTypeCode = ConvertNull(gRst.Fields("type_code"))
               TxtParentNodeID = ConvertNull(gRst.Fields("node_id"))
               If GetValue(tNodeID, "Node_ID", TVTreeNode.SelectedItem.key) = False Then GoTo Err
               Set gRst = gDbs.OpenRecordset("select * from TREE_DEFINATION where Node_ID=" + tNodeID)
               TxtLevelIndex = ConvertNull(gRst.Fields("node_level_index"))
            End If
       Case 1 '追加
            Set gRst = gDbs.OpenRecordset("select * from TREE_DEFINATION where Node_ID=" + tNodeID)
            If Not (gRst.EOF) Then
               TxtPTableName = ConvertNull(gRst.Fields("table_name"))
               TxtPTypeCode = ConvertNull(gRst.Fields("type_code"))
               TxtParentNodeID = ConvertNull(gRst.Fields("node_id"))
               Set gRst = gDbs.OpenRecordset("select * from TREE_DEFINATION where parent_Node_ID=" + tNodeID + " order by node_level_index desc")
               TxtLevelIndex = CStr(CInt(ConvertNull(gRst.Fields("node_level_index"))) + 1)
            End If
       Case 2 '子节点
            If GetValue(tNodeID, "Node_ID", TVTreeNode.SelectedItem.key) = False Then GoTo Err
            Set gRst = gDbs.OpenRecordset("select * from TREE_DEFINATION where Node_ID=" + tNodeID)
            If Not (gRst.EOF) Then
               TxtPTableName = ConvertNull(gRst.Fields("table_name"))
               TxtPTypeCode = ConvertNull(gRst.Fields("type_code"))
               TxtParentNodeID = ConvertNull(gRst.Fields("node_id"))
               TxtLevelIndex = "1"
            End If
    End Select
End If

TxtTableName = TxtPTableName
TxtTypeCode = TxtPTypeCode
If TxtPTypeCode <> "" Then
   If TxtTableName <> "" Then TxtTableName.Enabled = False
   TxtTypeCode.Enabled = False
Else
   TxtTableName.Enabled = True
   TxtTypeCode.Enabled = True
End If
If TxtTableName <> "" Then Call TxtTableName_LostFocus

'初始化
If CbxViewList.ListCount > 0 Then CbxViewList.ListIndex = 0
TxtFieldCnName = ""
OptNodeType(0).Value = True
If CbxFieldEnName.ListCount > 0 Then CbxFieldEnName.ListIndex = 0
TabMain.Tab = 1
gOperate_Type = 1
Frame1.Enabled = True
CmdOK.Caption = "添加(&I)"
CmdOK.Visible = True
Call OptNodeType_Click(0)
Err:
End Sub

Private Sub m_List_Click()
Call m_Modify_Click
Call CmdList_Click
End Sub

Private Sub m_Modify_Click()
On Error Resume Next
Dim tNodeID As String
Dim i As Integer
If TVTreeNode.SelectedItem Is Nothing Then GoTo Err
If GetValue(tNodeID, "Node_ID", TVTreeNode.SelectedItem.key) = False Then GoTo Err
Set gRst = gDbs.OpenRecordset("select * from TREE_DEFINATION where Node_ID=" + tNodeID)

'父节点id
tNodeID = ConvertNull(gRst.Fields("parent_node_id"))
Set gRst = gDbs.OpenRecordset("select * from TREE_DEFINATION where Node_ID=" + tNodeID)
If Not (gRst.EOF) Then
   TxtPTableName = ConvertNull(gRst.Fields("table_name"))
   TxtPTypeCode = ConvertNull(gRst.Fields("type_code"))
   TxtParentNodeID = ConvertNull(gRst.Fields("node_id"))
End If

'取子节点ID
If GetValue(tNodeID, "Node_ID", TVTreeNode.SelectedItem.key) = False Then GoTo Err
Set gRst = gDbs.OpenRecordset("select * from TREE_DEFINATION where Node_ID=" + tNodeID)
TxtLevelIndex = ConvertNull(gRst.Fields("node_level_index"))
TxtTypeCode = ConvertNull(gRst.Fields("type_code"))
TxtTableName = ConvertNull(gRst.Fields("table_name"))
TxtFieldCnName = ConvertNull(gRst.Fields("field_cn_name"))
TxtFieldValue = ConvertNull(gRst.Fields("field_value"))
TxtWhereString = ConvertNull(gRst.Fields("where_string"))
CbxViewList.ListIndex = CInt(gRst.Fields("view_list"))
TxtNodeID = tNodeID

OptNodeType(gRst.Fields("node_type")).Value = True
If Not IsNull(gRst.Fields("field_en_name")) Then
   For i = 0 To CbxFieldEnName.ListCount
      If LCase(Trim(CbxFieldEnName.List(i))) = LCase(Trim(gRst.Fields("field_en_name"))) Then
         CbxFieldEnName.ListIndex = i
         Exit For
      End If
   Next i
End If
For i = 0 To CbxDictType.ListCount
   If LCase(Trim(CbxDictType.ListIndex)) = LCase(Trim(gRst.Fields("system_dict_type"))) Then
      CbxDictType.ListIndex = i
      Exit For
   End If
Next i

TxtTypeCode.Enabled = False
TxtTableName.Enabled = False
Frame1.Enabled = False
Frame3.Enabled = False
TabMain.Tab = 1
CmdOK.Caption = "修改(&M)"
CmdOK.Visible = True
Err:
End Sub

Private Sub m_Refresh_Click()
Call ViewTreeRoot(CInt(TxtTreeType), "")
End Sub

Private Sub OptListType_Click(Index As Integer)
Dim tObjectName As String '对象名称
Dim i As Integer
Dim tSelfDefNum As Integer
On Error GoTo Err

gErrDescription = ""
 
Me.MousePointer = 11
If TxtTableName = "" Then
   TabMain.Tab = 0
   Exit Sub
End If
LVViewField.ListItems.Clear
LVResult.ColumnHeaders.Clear
If OptListType(0).Value = True Then '案卷
   
   '选择固定字段
   Set gRst = gDbs.OpenRecordset("select * from FIXED_FIELD_TABLE " & _
                    "where flag=2 and  view_flag=1 " & _
                    "order by view_index,field_name")
   While Not gRst.EOF
      LVViewField.ListItems.Add , "@F " + gRst.Fields("field_name") + " @D " + ConvertNull(gRst.Fields("system_dict_type")), Trim(gRst.Fields("display_name"))
      gRst.MoveNext
   Wend
   
   If Trim(TxtTypeCode) <> "" Then
        '选择可显示字段
        Set gRst = gDbs.OpenRecordset("select * from index_volume_defination " & _
                        "where type_code='" + TxtTypeCode + "' and  view_flag=1 " & _
                        "order by type_code")
        While Not gRst.EOF
          LVViewField.ListItems.Add , "@F " + gRst.Fields("field_name") + " @D " + ConvertNull(gRst.Fields("system_dict_type")), Trim(gRst.Fields("display_name"))
          gRst.MoveNext
        Wend
   End If

ElseIf OptListType(1).Value = True Then '文件

   '选择固定字段
   Set gRst = gDbs.OpenRecordset("select * from FIXED_FIELD_TABLE " & _
                    "where flag=1 and  view_flag=1 " & _
                    "order by view_index,field_name")
   While Not gRst.EOF
      LVViewField.ListItems.Add , "@F " + gRst.Fields("field_name") + " @D " + ConvertNull(gRst.Fields("system_dict_type")), Trim(gRst.Fields("display_name"))
      gRst.MoveNext
   Wend
   
   If Trim(TxtTypeCode) <> "" Then
        '选择可显示字段
        Set gRst = gDbs.OpenRecordset("select * from index_file_defination " & _
                        "where type_code='" + TxtTypeCode + "' and  view_flag=1 " & _
                        "order by type_code")
        While Not gRst.EOF
          LVViewField.ListItems.Add , "@F " + gRst.Fields("field_name") + " @D " + ConvertNull(gRst.Fields("system_dict_type")), Trim(gRst.Fields("display_name"))
          gRst.MoveNext
        Wend
   End If

End If
Err:
Me.MousePointer = 0
End Sub

Private Sub OptNodeType_Click(Index As Integer)
On Error GoTo Err

gErrDescription = ""

If TxtPTableName <> "" Then TxtTableName = TxtPTableName
TxtTypeCode = TxtPTypeCode

If TxtPTypeCode <> "" Then
   If TxtTableName.Text <> "" Then TxtTableName.Enabled = False
   TxtTypeCode.Enabled = False
Else
   TxtTableName.Enabled = True
   TxtTypeCode.Enabled = True
End If
If TxtTableName <> "" Then
   Call TxtTableName_LostFocus
ElseIf Index <> 0 And TxtTableName = "" Then
   OptNodeType(0).Value = True
   Exit Sub
End If
If CbxDictType.ListCount > 0 Then CbxDictType.ListIndex = 0
TxtFieldValue = ""
TxtFieldCnName = ""
    
If Index = 0 Then '自定义
    
    Frame3.Enabled = False
    CbxFieldEnName.ListIndex = -1
    'TxtFieldCnName.Enabled = True
    
ElseIf Index = 2 Then '动态
  
    Frame3.Enabled = True
    CbxFieldEnName.ListIndex = 0
    'TxtFieldCnName.Enabled = False
    TxtFieldValue.Enabled = False
    
ElseIf Index = 1 Then '静态
    
    Frame3.Enabled = True
    If CbxFieldEnName.ListCount > 0 Then CbxFieldEnName.ListIndex = 0
    'TxtFieldCnName.Enabled = True
    TxtFieldValue.Enabled = True
    
End If

Err:
End Sub

Private Sub TabMain_Click(PreviousTab As Integer)
'If TabMain.Tab = 0 Then
   CmdOK.Visible = False
'Else
'   CmdOK.Visible = True
'End If
If TabMain.Tab = 2 Then Call CmdList_Click
End Sub

Private Sub Timer1_Timer()
 Picture3.Left = Picture3.Left + 50
   If Picture3.Left > Picture2.Left + Picture2.Width Then
      Picture3.Left = Picture2.Left - Picture3.Width
   End If
End Sub

Private Sub TVTreeNode_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
   m_Insert_Do(1).Visible = True
   m_Insert_Do(0).Visible = True
   m_Modify.Visible = True
   m_Delete.Visible = True
   
   If TVTreeNode.Nodes.Count < 1 Then '无节点
      m_Insert_Do(2).Visible = True
      m_Insert_Do(1).Visible = False
      m_Insert_Do(0).Visible = False
      m_Modify.Visible = False
      m_Delete.Visible = False
   ElseIf TVTreeNode.SelectedItem Is Nothing Then
      Exit Sub
   ElseIf TVTreeNode.SelectedItem.Children > 0 Then
      m_Insert_Do(2).Visible = False
   Else
      m_Insert_Do(2).Visible = True
   End If
   Me.PopupMenu p_Mnu
End If

End Sub

'###################################################################################
'窗体初始化
'###################################################################################
Public Function FrmInit() As Boolean
On Error GoTo Err

gErrDescription = ""

With g_Parent_Tree_Node
💿 文件大小 963 K
👤 上传用户 hwyzy
📂 所属分类其他
🏷️ 相关标签

#光盘 #代码 #自动 #查询
⌨️ 快捷键说明

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