qq_39017726
qq_39017726
采纳率100%
2017-08-03 03:28 阅读 1.5k

vb中对listview1的数据进行双击 到listview2 怎么写 求各路大神指教 小弟有礼了

Option Explicit
Public gObjPY As New cls_com_PY
Private obj基础数据_添加套餐项目 As New cls基础数据_添加套餐项目

Public Function 加载添加套餐项目() As Long

On Error GoTo 加载添加套餐项目_error

Dim strsql As String, itemx As ListItem, lngI As Integer
Dim rst As New ADODB.Recordset
Dim lng As Long
lngI = 1


'首先判断是否不是空值
If frm基础数据_添加套餐项目.cbo套餐类型.Text = "" Then GoTo Proc_Exit

'根据用户选择项目类型进行加载类型项目
If frm基础数据_添加套餐项目.cbo套餐类型 = "全部" Then
    strsql = "select * from  基础数据_组合项目表 a ,基础数据_组合项目类型表 b   where a.组合项目类型 =b.组合项目类型名称  order by b.顺序 ,a.顺序 "
Else
    strsql = "select * from  基础数据_组合项目表 a ,基础数据_组合项目类型表 b   where a.组合项目类型 =b.组合项目类型名称 "
    strsql = strsql & " and a.组合项目类型 ='" & frm基础数据_添加套餐项目.cbo套餐类型 & "' order by b.顺序 ,a.顺序  "
End If


'加载项目
frm基础数据_添加套餐项目.lv项目.ListItems.Clear
 If gObjDatabase.GetOneRst(strsql, rst) <> 0 Then GoTo Proc_Exit
If Not rst.EOF Then
    Do Until rst.EOF
        Set itemx = frm基础数据_添加套餐项目.lv项目.ListItems.ADD(, , lngI)
        Call gObjControl.SetLvItemValue(frm基础数据_添加套餐项目.lv项目, itemx, "组合项目序号", Trim(rst("组合项目序号") & ""))
        Call gObjControl.SetLvItemValue(frm基础数据_添加套餐项目.lv项目, itemx, "组合项目名称", Trim(rst("组合项目名称") & ""))
        Call gObjControl.SetLvItemValue(frm基础数据_添加套餐项目.lv项目, itemx, "组合项目类型", Trim(rst("组合项目类型") & ""))
        lngI = lngI + 1
    rst.MoveNext
    Loop
End If


'增加项目类型
strsql = "select * from 基础数据_组合项目表 order by 顺序" & vbCrLf
If gObjDatabase.GetOneRst(strsql, rst) <> 0 Then GoTo Proc_Exit
If Not rst.EOF Then
    Do Until rst.EOF
         frm基础数据_添加套餐项目.cbo套餐类型.AddItem Trim(rst("组合项目类型名称") & "")
    rst.MoveNext
    Loop
End If

Proc_Exit:
Call RefreshMdiStb("就绪"): Exit Function
加载添加套餐项目_error:
加载添加套餐项目 = 1
Call RefreshMdiStb("就绪"): Call gObjError.RecordError("cls基础数据_添加套餐项目", "Form_Load", err.Number, err.Description)
End Function

Public Function 加载套餐类型() As Long
On Error GoTo 加载套餐类型_error

Dim rst As New ADODB.Recordset, itemx As ListItem
Dim strsql As String, str序号 As Long

'增加全部类型 ,让用户查看全部项目
frm基础数据_添加套餐项目.cbo套餐类型.Clear
frm基础数据_添加套餐项目.cbo套餐类型.AddItem ""
frm基础数据_添加套餐项目.cbo套餐类型.AddItem "全部"

'增加套餐类型
strsql = "select * from 基础数据_组合项目类型表 order by 顺序" & vbCrLf
If gObjDatabase.GetOneRst(strsql, rst) <> 0 Then GoTo Proc_Exit
If Not rst.EOF Then
    Do Until rst.EOF
         frm基础数据_添加套餐项目.cbo套餐类型.AddItem Trim(rst("组合项目类型名称") & "")
    rst.MoveNext
    Loop
End If

Proc_Exit:
Call RefreshMdiStb("就绪"): Exit Function
加载套餐类型_error:
加载套餐类型 = 1
Call RefreshMdiStb("就绪"): Call gObjError.RecordError("cls基础数据_添加套餐项目", "加载组合项目类型", err.Number, err.Description)
End Function

Public Function 加载列表头() As Long
On Error GoTo 加载列表头_error

frm基础数据_添加套餐项目.lv项目.ColumnHeaders.ADD , "序号", "序号", 5000
frm基础数据_添加套餐项目.lv项目.ColumnHeaders.ADD , "组合项目名称", "组合项目名称", 8000
Proc_Exit:
Call RefreshMdiStb("就绪"): Exit Function
加载列表头_error:
加载列表头 = -1
Call RefreshMdiStb("就绪"): Call gObjError.RecordError("cls基础数据_添加套餐项目", "加载列表头", err.Number, err.Description)
End Function

Public Function 加载lv项目信息() As Long
On Error GoTo 加载lv项目信息_error

End Function

Public Function 判断用户是否可以加载选中项目() As Long
On Error GoTo 判断用户是否可以加载选中项目_error

'用户没有选择项目
If frm基础数据_添加套餐项目.lv项目.SelectedItem Is Nothing Then
    判断用户是否可以加载选中项目 = -1
    GoTo Proc_Exit
End If

Proc_Exit:
Call RefreshMdiStb("就绪"): Exit Function
判断用户是否可以加载选中项目_error:
判断用户是否可以加载选中项目 = -1
Call RefreshMdiStb("就绪"): Call gObjError.RecordError("cls基础数据_组合项目维护", "判断用户是否可以加载选中项目", err.Number, err.Description)
End Function

Public Function 加载组合项目基本信息() As Long
On Error GoTo 加载组合项目基本信息_error

Dim rst As New ADODB.Recordset, itemx As ListItem
Dim strsql As String, lngI As Long
Dim str组合项目序号 As String
lngI = 1

If frm基础数据_添加套餐项目.lv项目.ListItems.Count = 0 Then GoTo Proc_Exit

'加载项目基本信息
str组合项目序号 = gObjControl.GetLvSelectedText(frm基础数据_添加套餐项目.lv项目, "组合项目序号")

'初始化项目基本信息
'If 清空组合项目基本信息 <> 0 Then GoTo 加载组合项目基本信息_error

strsql = "select * from 基础数据_组合项目表 where 组合项目序号 ='" & str组合项目序号 & "'" & vbCrLf

'
' If gObjDatabase.GetOneRst(strsql, rst) <> 0 Then GoTo Proc_Exit
' If Not rst.EOF Then
' Do Until rst.EOF
' frm基础数据_添加套餐项目.txt项目序号.Text = Trim(rst("组合项目序号") & "")
' frm基础数据_添加套餐项目.lv项目列表.Text = Trim(rst("组合项目名称") & "")
' rst.MoveNext
' Loop

' End If

Proc_Exit:
Call RefreshMdiStb("就绪"): Exit Function
加载组合项目基本信息_error:
加载组合项目基本信息 = -1
Call RefreshMdiStb("就绪"): Call gObjError.RecordError("cls基础数据_添加套餐项目", "加载组合项目基本信息", err.Number, err.Description)
End Function

Public Function 加载下拉控件() As Long
On Error GoTo 加载下拉控件_error

' frm基础数据_添加套餐项目.stb.item(0).Selected = True
frm基础数据_添加套餐项目.cbo套餐类型.AddItem " "
frm基础数据_添加套餐项目.cbo套餐类型.AddItem "全部"
frm基础数据_添加套餐项目.cbo套餐类型.AddItem "身高体重"
frm基础数据_添加套餐项目.cbo套餐类型.AddItem "电子血压"
frm基础数据_添加套餐项目.cbo套餐类型.AddItem "普通诊室"
frm基础数据_添加套餐项目.cbo套餐类型.AddItem "检验科室"
frm基础数据_添加套餐项目.cbo套餐类型.AddItem "超声诊室"
frm基础数据_添加套餐项目.cbo套餐类型.AddItem "影像科室"
frm基础数据_添加套餐项目.cbo套餐类型.AddItem "特检科室"

Proc_Exit:
Call RefreshMdiStb("就绪"): Exit Function
加载下拉控件_error:
加载下拉控件 = -1
Call RefreshMdiStb("就绪"): Call gObjError.RecordError("cls基础数据_添加套餐项目", "加载下拉控件", err.Number, err.Description)
End Function


  • 点赞
  • 写回答
  • 关注问题
  • 收藏
  • 复制链接分享

1条回答 默认 最新

  • 已采纳
    qq_39017726 qq_39017726 2017-08-03 05:53

    已经解决了
    这是frm的代码

    Public Function 加载列表头() As Long
    On Error GoTo 加载列表头_error

    frm基础数据_添加套餐项目.lv项目.ColumnHeaders.ADD , "序号", "序号", 5000
    frm基础数据_添加套餐项目.lv项目.ColumnHeaders.ADD , "组合项目名称", "组合项目名称", 8000
    Proc_Exit:
    Call RefreshMdiStb("就绪"): Exit Function
    加载列表头_error:
    加载列表头 = -1
    Call RefreshMdiStb("就绪"): Call gObjError.RecordError("cls基础数据_添加套餐项目", "加载列表头", err.Number, err.Description)
    End Function

    这是类的

    ublic Function 双击添加事件() As Long
    On Error GoTo 双击添加事件_error

        Dim ListX As ListItem
        Set ListX = frm基础数据_添加套餐项目.lv项目列表.ListItems.ADD
        ListX.Text = frm基础数据_添加套餐项目.lv项目.SelectedItem
    

    ' If frm基础数据_添加套餐项目.lv项目.ListIndex >= 0 Then
    ' frm基础数据_添加套餐项目.lv项目列表.AddItem List1.List(frm基础数据_添加套餐项目.lv项目.ListIndex)
    ' End If
    Proc_Exit:
    Call RefreshMdiStb("就绪"): Exit Function
    双击添加事件_error:
    双击添加事件 = 1
    Call RefreshMdiStb("就绪"): Call gObjError.RecordError("cls基础数据_添加套餐项目", "双击添加事件", err.Number, err.Description)
    End Function
    Public Function 双击删除事件() As Long
    On Error GoTo 双击删除事件_error

        Dim ListX As ListItem
    
        frm基础数据_添加套餐项目.lv项目列表.ListItems.Remove (frm基础数据_添加套餐项目.lv项目列表.SelectedItem.Index)
    

    Proc_Exit:
    Call RefreshMdiStb("就绪"): Exit Function
    双击删除事件_error:
    双击删除事件 = 1
    Call RefreshMdiStb("就绪"): Call gObjError.RecordError("cls基础数据_添加套餐项目", "双击删除事件", err.Number, err.Description)

    End Function

    点赞 评论 复制链接分享

相关推荐