?? 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 '記錄集,存儲檢查部位表中的數(shù)據(jù)
Private strSQL As String '存儲SQL語句
Private IsUpOrDown As Boolean '判斷是否向上或者向下移動了檢查部位,False表示沒有移動,True表示移動了
Private RecNCheckPart As Integer '存儲記錄集的記錄數(shù)
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 '獲得記錄數(shù)
ListBCheckPart.Clear '列表框清空
For I = 0 To RecNCheckPart '循環(huán)添加檢查部位名稱到列表控件中
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 '如果列表框中有數(shù)據(jù)
CheckedNum = IsCheckedInList '調用函數(shù)判斷列表框中是否選中了一項檢查部位
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 '移項的時候,選中狀態(tài)也要同步移動
IsUpOrDown = True '移動數(shù)據(jù)后,標識變量要賦值
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 '如果列表框中有數(shù)據(jù)
CheckedNum = IsCheckedInList '調用函數(shù)判斷列表框中是否選中了一項檢查部位
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 '移項的時候,選中狀態(tài)也要同步移動
IsUpOrDown = True '移動數(shù)據(jù)后,標識變量要賦值
End If
Else
MsgBox "請選擇一項檢查部位!", vbOKOnly, "圖文工作站"
End If
End If
End Sub
Private Sub CmdBSure_Click() '確定按鈕,操作想法:檢查檢查部位表和列表框中的數(shù)據(jù)是否相同,一條一條比較,如果不同,做一個輪換
Dim FirstNum As Integer '存儲不相符和的部位的顯示順序數(shù)字,檢查部位表部分
Dim SecondNum As Integer '存儲不相符和的部位的顯示順序數(shù)字,列表框部分
Dim MaxNum As Integer '存儲檢查部位表中顯示順序數(shù)字的最大值再加1
Dim I As Integer
If IsUpOrDown Then '表示點擊了向上或者向下按鈕,列表框中的數(shù)據(jù)發(fā)生了變化
RecCheckPart.MoveLast '記錄集標識移動到最后一條數(shù)據(jù)
MaxNum = RecCheckPart.Fields("顯示順序").Value + 1 '獲得顯示順序數(shù)字的最大值
RecCheckPart.MoveFirst '記錄集標識移動到第一條數(shù)據(jù)
For I = 0 To RecNCheckPart '循環(huán)判斷檢查部位表中的數(shù)據(jù)是否和列表框中的數(shù)據(jù)相同,為方便說明,當發(fā)現(xiàn)不同數(shù)據(jù)時,記記錄集中的記錄為A,列表框中的數(shù)據(jù)為B
If RecCheckPart.Fields("部位名稱").Value <> ListBCheckPart.List(I) Then
FirstNum = RecCheckPart.Fields("顯示順序").Value '記錄A的顯示順序數(shù)值
RecCheckPart.Fields("顯示順序").Value = MaxNum '將A移動到整個記錄集的末尾
RecCheckPart.Update
Set RecCheckPart = New ADODB.Recordset '搜尋B記錄集中的位置,并記錄下來其顯示順序數(shù)值
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的顯示順序數(shù)值設置成A原先的位置
RecCheckPart.Update
Set RecCheckPart = New ADODB.Recordset '搜尋A現(xiàn)在的位置
strSQL = "SELECT * FROM 檢查部位表 WHERE Str(顯示順序) = '" & Str(MaxNum) & "'"
RecCheckPart.CursorLocation = adUseClient
RecCheckPart.Open strSQL, PACSDataConn, adOpenDynamic, adLockOptimistic, adCmdText
RecCheckPart.Fields("顯示順序").Value = SecondNum '將A的顯示順序數(shù)值設置成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 '設置循環(huán)變量I,重新開始循環(huán)
Else
RecCheckPart.MoveNext '如果記錄集的數(shù)據(jù)和列表框中的數(shù)據(jù)相同,那么記錄集下移,繼續(xù)循環(huán)
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) '循環(huán)列表框,查看是否有選中項
If ListBCheckPart.Selected(I) = True Then
IsCheckedInList = I + 1 '如果有選中項,那么函數(shù)的返回值表示選中項的個數(shù)
End If
Next I
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -