📄 帐户组.frm
字号:
VERSION 5.00
Begin VB.Form frmAccGrpLnk
Caption = "账户组定义"
ClientHeight = 4110
ClientLeft = 60
ClientTop = 345
ClientWidth = 6150
LinkTopic = "Form2"
MDIChild = -1 'True
ScaleHeight = 4110
ScaleWidth = 6150
Begin VB.ListBox Lst_SRC
Height = 2940
Left = 180
TabIndex = 7
Top = 120
Width = 2115
End
Begin VB.CommandButton Cmd_Sel
Caption = "选择 ->"
Height = 375
Left = 2400
TabIndex = 6
Top = 300
Width = 1335
End
Begin VB.CommandButton Cmd_SelAll
Caption = "全选 >>"
Height = 375
Left = 2400
TabIndex = 5
Top = 780
Width = 1335
End
Begin VB.CommandButton Cmd_UnSel
Caption = "取消 <-"
Height = 375
Left = 2400
TabIndex = 4
Top = 1740
Width = 1335
End
Begin VB.CommandButton Cmd_UnSelAll
Caption = "全消 <<"
Height = 375
Left = 2400
TabIndex = 3
Top = 2220
Width = 1335
End
Begin VB.ListBox Lst_Des
Height = 2940
Left = 3840
TabIndex = 2
Top = 120
Width = 2115
End
Begin VB.CommandButton Cmd_OK
Caption = "确定(&O)"
Default = -1 'True
Height = 375
Left = 3120
TabIndex = 1
Top = 3540
Width = 1335
End
Begin VB.CommandButton Cmd_Cancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 375
Left = 4620
TabIndex = 0
Top = 3540
Width = 1335
End
End
Attribute VB_Name = "frmAccGrpLnk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'--------------------------------
'时间:2002.03.04
'版权:北京用友软件股份有限公司
'设计:章景峰
'编码:章景峰
'说明:U8资金管理---账户组
'--------------------------------
Option Explicit
Public NodeKey As String
Private Sub Cmd_Cancel_Click()
Unload Me
End Sub
Private Sub Cmd_OK_Click()
'处理
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String
Dim i As Integer
con.Open g_sDataSourceName
If NodeKey <> "" Then
If Me.Lst_Des.ListCount > 0 Then
SQL = "Delete from fd_accgrplnk where accdef_id='" & NodeKey & "'"
con.Execute SQL
For i = 0 To Me.Lst_Des.ListCount - 1
SQL = "Insert into fd_accgrplnk (accdef_id,accgrp_id) Values ('" & NodeKey & "','" & Right(Me.Lst_Des.List(i), 15) & "')"
con.Execute SQL
Next
Else
SQL = "Delete from fd_accgrplnk where accdef_id='" & NodeKey & "'"
con.Execute SQL
End If
End If
frmAccMgr.RefreshUI 2
Set rs = Nothing
Set con = Nothing
Unload Me
End Sub
Private Sub LstSrcFill()
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String
If NodeKey <> "" Then
con.Open g_sDataSourceName
SQL = "Select accgrp_id,accgrp_code,accgrp_name from fd_accgrp where accgrp_id not in (Select accgrp_id from fd_accgrplnk where accdef_id ='" & NodeKey & "') and accgrp_id not in (select fd_accgrp.accgrp_id from fd_accgrp ,fd_accgrp fd_accgrp2 where fd_accgrp.accgrp_id=fd_accgrp2.parent_id group by fd_accgrp.accgrp_id) order by accgrp_code"
rs.Open SQL, con
Do Until rs.EOF
Me.Lst_SRC.AddItem "(" & rs("accgrp_code") & ")" & Chr(9) & rs("accgrp_name") & String(200, " ") & rs("accgrp_id")
rs.MoveNext
Loop
End If
Set rs = Nothing
Set con = Nothing
End Sub
Private Sub LstDesFill()
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String
If NodeKey <> "" Then
con.Open g_sDataSourceName
SQL = "Select accgrp_id,accgrp_code,accgrp_name from fd_accgrp where accgrp_id in (Select accgrp_id from fd_accgrplnk where accdef_id ='" & NodeKey & "') order by accgrp_code"
rs.Open SQL, con
Do Until rs.EOF
Me.Lst_Des.AddItem "(" & rs("accgrp_code") & ")" & Chr(9) & rs("accgrp_name") & String(200, " ") & rs("accgrp_id")
rs.MoveNext
Loop
End If
Set rs = Nothing
Set con = Nothing
End Sub
Private Sub Cmd_Sel_Click()
Dim Index As Integer
If Lst_SRC.ListCount > 0 Then
If Lst_SRC.ListIndex >= 0 Then
Lst_Des.AddItem Lst_SRC.List(Lst_SRC.ListIndex)
Lst_Des.Selected(Lst_Des.ListCount - 1) = True
Index = Me.Lst_SRC.ListIndex
Lst_SRC.RemoveItem Lst_SRC.ListIndex
If Lst_SRC.ListCount > 0 Then
If Index = 0 Then
Lst_SRC.Selected(0) = True
ElseIf Index = Lst_SRC.ListCount Then
Lst_SRC.Selected(Lst_SRC.ListCount - 1) = True
Else
Lst_SRC.Selected(Index) = True
End If
End If
End If
End If
SetBotton
End Sub
Private Sub Cmd_SelAll_Click()
Dim i As Integer
If Lst_SRC.ListCount > 0 Then
For i = 1 To Lst_SRC.ListCount 'To 1 Step -1
Lst_Des.AddItem Lst_SRC.List(0)
Lst_SRC.RemoveItem 0
Next
End If
Lst_Des.ListIndex = 0
SetBotton
End Sub
Private Sub Cmd_UnSel_Click()
Dim Index As Integer
If Lst_Des.ListCount > 0 Then
If Lst_Des.ListIndex >= 0 Then
Lst_SRC.AddItem Lst_Des.List(Lst_Des.ListIndex)
Lst_SRC.Selected(Lst_SRC.ListCount - 1) = True
Index = Me.Lst_Des.ListIndex
Lst_Des.RemoveItem Lst_Des.ListIndex
If Lst_Des.ListCount > 0 Then
If Index = 0 Then
Lst_Des.Selected(0) = True
ElseIf Index = Lst_Des.ListCount Then
Lst_Des.Selected(Lst_Des.ListCount - 1) = True
Else
Lst_Des.Selected(Index) = True
End If
End If
End If
End If
SetBotton
End Sub
Private Sub Cmd_UnSelAll_Click()
Dim i As Integer
If Lst_Des.ListCount > 0 Then
For i = 1 To Lst_Des.ListCount 'To 1 Step -1
Lst_SRC.AddItem Lst_Des.List(0)
Lst_Des.RemoveItem 0
Next
End If
Lst_SRC.ListIndex = 0
SetBotton
End Sub
Private Sub SetBotton()
If Me.Lst_SRC.ListCount > 0 Then
Me.Cmd_Sel.Enabled = True
Me.Cmd_SelAll.Enabled = True
Else
Me.Cmd_Sel.Enabled = False
Me.Cmd_SelAll.Enabled = False
End If
If Me.Lst_Des.ListCount > 0 Then
Me.Cmd_UnSel.Enabled = True
Me.Cmd_UnSelAll.Enabled = True
Else
Me.Cmd_UnSel.Enabled = False
Me.Cmd_UnSelAll.Enabled = False
End If
End Sub
Private Sub Form_Load()
LstSrcFill
If Me.Lst_SRC.ListCount > 0 Then
Lst_SRC.ListIndex = 0
End If
LstDesFill
If Me.Lst_Des.ListCount > 0 Then
Lst_Des.ListIndex = 0
End If
SetBotton
End Sub
Private Sub Form_Resize()
If Me.WindowState <> 1 Then
If Me.WindowState = 0 Then
If Me.Width < 5900 Then
Me.Width = 5900
End If
If Me.Height < 3800 Then
Me.Height = 3800
End If
End If
Me.Lst_SRC.Move 0, 0, Me.ScaleWidth / 2 - 803, Me.ScaleHeight - 500
Me.Lst_Des.Move Me.ScaleWidth / 2 + 803, 0, Me.ScaleWidth / 2 - 803, Me.ScaleHeight - 500
Me.Cmd_Sel.Move Me.ScaleWidth / 2 - 668
Me.Cmd_SelAll.Move Me.ScaleWidth / 2 - 668
Me.Cmd_UnSel.Move Me.ScaleWidth / 2 - 668
Me.Cmd_UnSelAll.Move Me.ScaleWidth / 2 - 668
Me.Cmd_OK.Move Me.ScaleWidth / 2 - 100 - Me.Cmd_OK.Width, Me.ScaleHeight - 450
Me.Cmd_Cancel.Move Me.ScaleWidth / 2 + 100, Me.ScaleHeight - 450
End If
End Sub
Private Sub Lst_Des_DblClick()
Cmd_UnSel_Click
End Sub
Private Sub Lst_SRC_DblClick()
Cmd_Sel_Click
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -