partorderinotherform.frm

内窥镜图案工作站有说明 有文档 有应用程序

VERSION 5.00
Begin VB.Form PartOrderInOtherForm 
   BackColor       =   &H80000009&
   Caption         =   "部位顺序设定"
   ClientHeight    =   4950
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   3900
   LinkTopic       =   "Form1"
   ScaleHeight     =   4950
   ScaleWidth      =   3900
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton CmdBExit 
      Height          =   375
      Left            =   2160
      Picture         =   "PartOrderInOtherForm.frx":0000
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   4440
      Width           =   1335
   End
   Begin VB.CommandButton CmdBDown 
      DisabledPicture =   "PartOrderInOtherForm.frx":0609
      Height          =   495
      Left            =   3120
      Picture         =   "PartOrderInOtherForm.frx":0964
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   2640
      Width           =   495
   End
   Begin VB.CommandButton CmdBUp 
      BackColor       =   &H8000000B&
      CausesValidation=   0   'False
      DisabledPicture =   "PartOrderInOtherForm.frx":0C96
      DownPicture     =   "PartOrderInOtherForm.frx":0FE2
      Height          =   495
      Left            =   3120
      MaskColor       =   &H008080FF&
      Picture         =   "PartOrderInOtherForm.frx":132E
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   1200
      Width           =   495
   End
   Begin VB.CommandButton CmdBSure 
      Height          =   375
      Left            =   360
      Picture         =   "PartOrderInOtherForm.frx":167A
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   4440
      Width           =   1335
   End
   Begin VB.ListBox ListBCheckPart 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4140
      Left            =   120
      TabIndex        =   4
      TabStop         =   0   'False
      Top             =   120
      Width           =   2775
   End
End
Attribute VB_Name = "PartOrderInOtherForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private RecCheckPart As ADODB.Recordset    '记录集,存储检查部位表中的数据
Private strSQL As String    '存储SQL语句
Private IsUpOrDown As Boolean    '判断是否向上或者向下移动了检查部位,False表示没有移动,True表示移动了
Private RecNCheckPart As Integer    '存储记录集的记录数

Private Sub Form_Load()    '窗体初始化

    Dim I As Integer
    
    IsUpOrDown = False    '设置初值,表示没有移动
    Set RecCheckPart = New ADODB.Recordset    '查询检查部位表,提取记录集,并按显示顺序排序
    strSQL = "SELECT * FROM 检查部位表 ORDER BY 显示顺序"
    RecCheckPart.CursorLocation = adUseClient
    RecCheckPart.Open strSQL, PACSDataConn, adOpenDynamic, adLockOptimistic, adCmdText
    RecCheckPart.MoveFirst    '记录集指针移动到第一条记录
    RecNCheckPart = RecCheckPart.RecordCount - 1    '获得记录数
    ListBCheckPart.Clear    '列表框清空
    For I = 0 To RecNCheckPart    '循环添加检查部位名称到列表控件中
        ListBCheckPart.AddItem (RecCheckPart.Fields("部位名称").Value)
        RecCheckPart.MoveNext
    Next I

End Sub

Private Sub CmdBUp_Click()    '点击向上按钮

    Dim CheckPartItem As String    '用于存储被选中的检查部位
    Dim CheckedNum As Integer    '存储选中检查部位在列表框中对应的位置
    
    If (ListBCheckPart.ListCount > 0) Then    '如果列表框中有数据
        CheckedNum = IsCheckedInList    '调用函数判断列表框中是否选中了一项检查部位
        If CheckedNum > 0 Then    '如果选中
            If CheckedNum > 1 Then    '如果选中的不是第一项,那么做一个轮换,将选中项前移一次
                CheckPartItem = ListBCheckPart.List(CheckedNum - 1)
                ListBCheckPart.List(CheckedNum - 1) = ListBCheckPart.List(CheckedNum - 2)
                ListBCheckPart.List(CheckedNum - 2) = CheckPartItem
                ListBCheckPart.Selected(CheckedNum - 2) = True    '移项的时候,选中状态也要同步移动
                IsUpOrDown = True    '移动数据后,标识变量要赋值
            End If
        Else
            MsgBox "请选择一项检查部位!", vbOKOnly, "图文工作站"
        End If
    End If

End Sub

Private Sub CmdBDown_Click()    '点击向下按钮

    Dim CheckPartItem As String    '用于存储被选中的检查部位
    Dim CheckedNum As Integer    '存储选中检查部位在列表框中对应的位置
    
    If (ListBCheckPart.ListCount > 0) Then    '如果列表框中有数据
        CheckedNum = IsCheckedInList    '调用函数判断列表框中是否选中了一项检查部位
        If CheckedNum > 0 Then    '如果选中
            If CheckedNum < ListBCheckPart.ListCount Then     '如果选中的不是最后一项,那么做一个轮换,将选中项后移一次
                CheckPartItem = ListBCheckPart.List(CheckedNum - 1)
                ListBCheckPart.List(CheckedNum - 1) = ListBCheckPart.List(CheckedNum)
                ListBCheckPart.List(CheckedNum) = CheckPartItem
                ListBCheckPart.Selected(CheckedNum) = True    '移项的时候,选中状态也要同步移动
                IsUpOrDown = True    '移动数据后,标识变量要赋值
            End If
        Else
            MsgBox "请选择一项检查部位!", vbOKOnly, "图文工作站"
        End If
    End If

End Sub

Private Sub CmdBSure_Click()    '确定按钮,操作想法:检查检查部位表和列表框中的数据是否相同,一条一条比较,如果不同,做一个轮换

    Dim FirstNum As Integer    '存储不相符和的部位的显示顺序数字,检查部位表部分
    Dim SecondNum As Integer    '存储不相符和的部位的显示顺序数字,列表框部分
    Dim MaxNum As Integer    '存储检查部位表中显示顺序数字的最大值再加1
    Dim I As Integer
    
    If IsUpOrDown Then    '表示点击了向上或者向下按钮,列表框中的数据发生了变化
        RecCheckPart.MoveLast    '记录集标识移动到最后一条数据
        MaxNum = RecCheckPart.Fields("显示顺序").Value + 1    '获得显示顺序数字的最大值
        RecCheckPart.MoveFirst    '记录集标识移动到第一条数据
        For I = 0 To RecNCheckPart    '循环判断检查部位表中的数据是否和列表框中的数据相同,为方便说明,当发现不同数据时,记记录集中的记录为A,列表框中的数据为B
            If RecCheckPart.Fields("部位名称").Value <> ListBCheckPart.List(I) Then
                
                FirstNum = RecCheckPart.Fields("显示顺序").Value    '记录A的显示顺序数值
                RecCheckPart.Fields("显示顺序").Value = MaxNum    '将A移动到整个记录集的末尾
                RecCheckPart.Update
                
                Set RecCheckPart = New ADODB.Recordset    '搜寻B记录集中的位置,并记录下来其显示顺序数值
                strSQL = "SELECT * FROM 检查部位表 WHERE 部位名称 = '" & ListBCheckPart.List(I) & "'"
                RecCheckPart.CursorLocation = adUseClient
                RecCheckPart.Open strSQL, PACSDataConn, adOpenDynamic, adLockOptimistic, adCmdText
                SecondNum = RecCheckPart.Fields("显示顺序").Value
                RecCheckPart.Fields("显示顺序").Value = FirstNum    '将B的显示顺序数值设置成A原先的位置
                RecCheckPart.Update
                
                Set RecCheckPart = New ADODB.Recordset    '搜寻A现在的位置
                strSQL = "SELECT * FROM 检查部位表 WHERE Str(显示顺序) = '" & Str(MaxNum) & "'"
                RecCheckPart.CursorLocation = adUseClient
                RecCheckPart.Open strSQL, PACSDataConn, adOpenDynamic, adLockOptimistic, adCmdText
                RecCheckPart.Fields("显示顺序").Value = SecondNum    '将A的显示顺序数值设置成B原先的位置
                RecCheckPart.Update
                
                Set RecCheckPart = New ADODB.Recordset    '重新搜寻检查部位表,按显示顺序排列
                strSQL = "SELECT * FROM 检查部位表 ORDER BY 显示顺序"
                RecCheckPart.CursorLocation = adUseClient
                RecCheckPart.Open strSQL, PACSDataConn, adOpenDynamic, adLockOptimistic, adCmdText
                RecCheckPart.MoveFirst    '记录集标识移动到第一条
                I = -1    '设置循环变量I,重新开始循环
                
            Else
                RecCheckPart.MoveNext    '如果记录集的数据和列表框中的数据相同,那么记录集下移,继续循环
            End If
        Next I
    End If
    Unload Me    '完成之后卸载窗体

End Sub

Private Sub CmdBExit_Click()    '取消按钮

    Unload Me

End Sub

Private Function IsCheckedInList() As Integer    '检查列表框中是否选中一项检查部位

    Dim I As Integer
    
    IsCheckedInList = 0    '0表示没有选中
    For I = 0 To (ListBCheckPart.ListCount - 1)    '循环列表框,查看是否有选中项
        If ListBCheckPart.Selected(I) = True Then
            IsCheckedInList = I + 1    '如果有选中项,那么函数的返回值表示选中项的个数
        End If
    Next I

End Function