📄 帐户选择.frm
字号:
VERSION 5.00
Begin VB.Form frmAccSel
Caption = "账户选择"
ClientHeight = 3465
ClientLeft = 60
ClientTop = 345
ClientWidth = 5835
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 3465
ScaleWidth = 5835
Begin VB.CommandButton Cmd_Cancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 375
Left = 3000
TabIndex = 7
Top = 3060
Width = 1335
End
Begin VB.CommandButton Cmd_OK
Caption = "确定(&O)"
Default = -1 'True
Height = 375
Left = 1500
TabIndex = 6
Top = 3060
Width = 1335
End
Begin VB.ListBox Lst_Des
Height = 2940
Left = 3720
TabIndex = 5
Top = 8
Width = 2115
End
Begin VB.CommandButton Cmd_UnSelAll
Caption = "全消 <<"
Height = 375
Left = 2249
TabIndex = 4
Top = 2220
Width = 1336
End
Begin VB.CommandButton Cmd_UnSel
Caption = "取消 <-"
Height = 375
Left = 2249
TabIndex = 3
Top = 1740
Width = 1336
End
Begin VB.CommandButton Cmd_SelAll
Caption = "全选 >>"
Height = 375
Left = 2249
TabIndex = 2
Top = 780
Width = 1336
End
Begin VB.CommandButton Cmd_Sel
Caption = "选择 ->"
Height = 375
Left = 2249
TabIndex = 1
Top = 300
Width = 1336
End
Begin VB.ListBox Lst_SRC
Height = 2940
Left = 0
TabIndex = 0
Top = 8
Width = 2115
End
End
Attribute VB_Name = "frmAccSel"
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 accgrp_id='" & mID(NodeKey, 2, Len(NodeKey) - 1) & "'"
con.Execute SQL
For i = 0 To Me.Lst_Des.ListCount - 1
SQL = "Insert into fd_accgrplnk (accdef_id,accgrp_id) Values ('" & Right(Me.Lst_Des.List(i), 15) & "','" & mID(NodeKey, 2, Len(NodeKey) - 1) & "')"
con.Execute SQL
Next
Else
SQL = "Delete from fd_accgrplnk where accgrp_id='" & mID(NodeKey, 2, Len(NodeKey) - 1) & "'"
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
Dim objclsAccDefBI As New U8FDBso.clsAccDefBI
Dim objEO As U8FDEso.EntityObject
Set objEO = objclsAccDefBI.Init(g_sDataSourceName)
Set objclsAccDefBI = Nothing
If NodeKey <> "" Then
con.Open g_sDataSourceName
SQL = "Select " & objEO("accdef_id").SourceField & "," & objEO("accdef_code").SourceField & "," & objEO("accdef_name").SourceField & " from " & objEO.SourceTable & " where " & objEO("destroy_flag").SourceField & "=0 and " & objEO("accdef_id").SourceField & " not in (Select " & objEO("accdef_id").SourceField & " from fd_accgrplnk where accgrp_id ='" & mID(NodeKey, 2, Len(NodeKey) - 1) & "') order by " & objEO("accdef_code").SourceField
rs.Open SQL, con
Do Until rs.EOF
Me.Lst_SRC.AddItem "(" & rs.Fields(1).Value & ")" & Chr(9) & rs.Fields(2).Value & String(200, " ") & rs.Fields(0).Value
rs.MoveNext
Loop
End If
Set rs = Nothing
Set con = Nothing
Set objEO = Nothing
End Sub
Private Sub LstDesFill()
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String
Dim objclsAccDefBI As New U8FDBso.clsAccDefBI
Dim objEO As U8FDEso.EntityObject
Set objEO = objclsAccDefBI.Init(g_sDataSourceName)
Set objclsAccDefBI = Nothing
If NodeKey <> "" Then
con.Open g_sDataSourceName
SQL = "Select " & objEO("accdef_id").SourceField & "," & objEO("accdef_code").SourceField & "," & objEO("accdef_name").SourceField & " from " & objEO.SourceTable & " where " & objEO("destroy_flag").SourceField & "=0 and " & objEO("accdef_id").SourceField & " in (Select " & objEO("accdef_id").SourceField & " from fd_accgrplnk where accgrp_id ='" & mID(NodeKey, 2, Len(NodeKey) - 1) & "') order by " & objEO("accdef_code").SourceField
rs.Open SQL, con
Do Until rs.EOF
Me.Lst_Des.AddItem "(" & rs.Fields(1).Value & ")" & Chr(9) & rs.Fields(2).Value & String(200, " ") & rs.Fields(0).Value
rs.MoveNext
Loop
End If
Set rs = Nothing
Set con = Nothing
Set objEO = 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 + -