企业管理

开发平台：
Visual Basic

++：源码内容
							VERSION 5.00
Object = "{C5DE3F80-3376-11D2-BAA4-04F205C10000}#1.0#0"; "Vsflex6d.ocx"
Begin VB.Form Order_Frm 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "排序"
   ClientHeight    =   5055
   ClientLeft      =   45
   ClientTop       =   345
   ClientWidth     =   3540
   Icon            =   "排序.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5055
   ScaleWidth      =   3540
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Cmd_Cancel 
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   2355
      TabIndex        =   3
      Top             =   4695
      Width           =   1120
   End
   Begin VB.CommandButton Cmd_Clear 
      Caption         =   "全清(&L)"
      Height          =   300
      Left            =   15
      TabIndex        =   2
      Top             =   4695
      Width           =   1120
   End
   Begin VB.CommandButton Cmd_OK 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   300
      Left            =   1185
      TabIndex        =   1
      Top             =   4695
      Width           =   1120
   End
   Begin VSFlex6DAOCtl.vsFlexGrid vsFlx_GridData 
      Height          =   4530
      Left            =   60
      TabIndex        =   0
      Top             =   90
      Width           =   3390
      _ExtentX        =   5980
      _ExtentY        =   7990
      _ConvInfo       =   1
      Appearance      =   1
      BorderStyle     =   1
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      MousePointer    =   0
      BackColor       =   16777215
      ForeColor       =   0
      BackColorFixed  =   -2147483644
      ForeColorFixed  =   -2147483630
      BackColorSel    =   -2147483635
      ForeColorSel    =   -2147483634
      BackColorBkg    =   -2147483636
      BackColorAlternate=   16777215
      GridColor       =   -2147483633
      GridColorFixed  =   -2147483632
      TreeColor       =   -2147483632
      FloodColor      =   16777215
      SheetBorder     =   -2147483642
      FocusRect       =   4
      HighLight       =   1
      AllowSelection  =   -1  'True
      AllowBigSelection=   -1  'True
      AllowUserResizing=   0
      SelectionMode   =   0
      GridLines       =   1
      GridLinesFixed  =   2
      GridLineWidth   =   1
      Rows            =   50
      Cols            =   5
      FixedRows       =   1
      FixedCols       =   3
      RowHeightMin    =   0
      RowHeightMax    =   0
      ColWidthMin     =   0
      ColWidthMax     =   0
      ExtendLastCol   =   0   'False
      FormatString    =   ""
      ScrollTrack     =   0   'False
      ScrollBars      =   3
      ScrollTips      =   0   'False
      MergeCells      =   0
      MergeCompare    =   0
      AutoResize      =   -1  'True
      AutoSizeMode    =   0
      AutoSearch      =   0
      MultiTotals     =   -1  'True
      SubtotalPosition=   1
      OutlineBar      =   0
      OutlineCol      =   0
      Ellipsis        =   0
      ExplorerBar     =   0
      PicturesOver    =   0   'False
      FillStyle       =   0
      RightToLeft     =   0   'False
      PictureType     =   0
      TabBehavior     =   0
      OwnerDraw       =   0
      Editable        =   0   'False
      ShowComboButton =   -1  'True
      WordWrap        =   0   'False
      TextStyle       =   0
      TextStyleFixed  =   0
      OleDragMode     =   0
      OleDropMode     =   0
      DataMode        =   0
      VirtualData     =   -1  'True
   End
End
Attribute VB_Name = "Order_Frm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Pxsxhao As Integer                '排序顺序号
Dim NumTemp As Long
Dim Backrow As Long                      '上次操作行
Dim Csczbz As Boolean                    '初始操作标志
Public bOrder As Boolean
Public str_SQLOrderBy As String
Dim int_MaxOrderNum As Integer
Dim arrStr_Order() As String
Private Sub Cmd_Cancel_Click()
    bOrder = False
    Unload Me
End Sub
Private Sub Cmd_Clear_Click()
  Me.vsFlx_GridData.Clear 1
  Pxsxhao = 0
  NumTemp = 0
  Backrow = 0
  Csczbz = False
End Sub
Private Sub Cmd_OK_Click()
  
  Dim str_temp As String
  Dim int_OrderCount As Integer
  
  str_temp = ""
  int_OrderCount = -1
  With Me.vsFlx_GridData
    For i = .FixedRows To .Rows - 1
      If Trim(.TextMatrix(i, 4)) <> "" Then
        int_OrderCount = int_OrderCount + 1
      End If
    Next i
    If int_OrderCount = -1 Then Exit Sub
    ReDim arrStr_Order(int_OrderCount, 1) As String
    
    For i = .FixedRows To .Rows - 1
      If Trim(.TextMatrix(i, 4)) <> "" Then
        j = Val(Trim(.TextMatrix(i, 4))) - 1
        arrStr_Order(j, 0) = Trim(.TextMatrix(i, 0))
        If Trim(.TextMatrix(i, 3)) = "升序" Then
          arrStr_Order(j, 1) = ""
        Else
          arrStr_Order(j, 1) = "DESC"
        End If
      End If
    Next i
  End With
  For i = 0 To UBound(arrStr_Order, 1)
    If Trim(str_temp) <> "" Then str_temp = str_temp + ","
    str_temp = str_temp & arrStr_Order(i, 0) & " " & arrStr_Order(i, 1)
  Next i
  If Trim(str_temp) <> "" Then str_temp = " order by " & str_temp
  Me.str_SQLOrderBy = str_temp
  bOrder = True
  Unload Me
  
End Sub
Private Sub Form_Load()
  int_MaxOrderNum = 0
  Dim str_TempSql As String
  Dim rs_Temp As New ADODB.Recordset
  
  str_TempSql = "select Rtrim(TableName)+'.'+Rtrim(FieldName) as FieldName ,ChName as FieldNameC from Rs_Items where (SID=1 or Rs=1) and FieldName<>'Pic' "
  Set rs_Temp = Cw_DataEnvi.DataConnect.Execute(str_TempSql)
  If rs_Temp.EOF() Then Exit Sub
  
  With Me.vsFlx_GridData
    i = .FixedRows - 1
    .Rows = rs_Temp.RecordCount + 1
    
    
    For j = 0 To .Cols - 1
      .ColAlignment(j) = flexAlignLeftCenter
      .FixedAlignment(i) = flexAlignCenterCenter
    Next j
    For j = .FixedRows To .Rows - 1
      .RowHeight(j) = 300
    Next j
    
    .ColHidden(0) = True
    .ColHidden(1) = True
    .ColWidth(2) = .Width / 3 - 150
    .ColWidth(3) = .Width / 3 - 150
    .ColWidth(4) = .Width / 3 - 150
    .TextMatrix(i, 2) = "项目"
    .TextMatrix(i, 3) = "排序"
    .TextMatrix(i, 4) = "顺序"
    .RowHeight(.FixedRows - 1) = 400
    Pxsxhao = 0
    Do While Not rs_Temp.EOF()
      i = i + 1
      .TextMatrix(i, 0) = Trim(rs_Temp.Fields("FieldName") & "")
      .TextMatrix(i, 2) = Trim(rs_Temp.Fields("FieldNameC") & "")
      rs_Temp.MoveNext
    Loop
  End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
Pxsxhao = 0
End Sub
Private Sub vsFlx_GridData_DblClick()
                  
  With Me.vsFlx_GridData
    
    '排序最大号
    If Not Backrow = .Row Then
       NumTemp = 0
       Pxsxhao = Pxsxhao + 1
    End If
    
    '添加排序
    If NumTemp = 0 Then
       .TextMatrix(.Row, .Cols - 2) = "升序"
       NumTemp = 1
    ElseIf NumTemp = 1 Then
       .TextMatrix(.Row, .Cols - 2) = "降序"
       NumTemp = 2
    Else
       .TextMatrix(.Row, .Cols - 2) = ""
       NumTemp = 0
    End If
    
    '设置排列顺序
    If Not Csczbz Then           '第一次操作网格
       If Not .TextMatrix(.Row, .Cols - 2) = "" Then    '排序
          Pxsxhao = 1
          .TextMatrix(.Row, .Cols - 1) = Pxsxhao
       Else
           Call Cmd_Clear_Click                              '不排序
       End If
    Else
       If .TextMatrix(.Row, .Cols - 1) = "" Then        '首次设置
          .TextMatrix(.Row, .Cols - 1) = Pxsxhao
       Else
          For jsqte = .FixedRows To .Rows - 1                  '更新大于单前排序号
            If Val(.TextMatrix(jsqte, .Cols - 1)) > Val(.TextMatrix(.Row, .Cols - 1)) Then
               .TextMatrix(jsqte, .Cols - 1) = Val(.TextMatrix(jsqte, .Cols - 1)) - 1
            End If
          Next jsqte
          
          If Not .TextMatrix(.Row, .Cols - 2) = "" Then     '重新设置
             If Backrow = .Row Then
                .TextMatrix(.Row, .Cols - 1) = Pxsxhao
             Else
                Pxsxhao = Pxsxhao - 1
                .TextMatrix(.Row, .Cols - 1) = Pxsxhao
             End If
             
          Else
             .TextMatrix(.Row, .Cols - 1) = ""
              
                Pxsxhao = Pxsxhao - 1
                        
             Backrow = .FindRow(Pxsxhao, .FixedRows, .Cols - 1)
             Exit Sub
          End If
       End If
    End If
    
    Backrow = .Row
    Csczbz = True
  End With
End Sub

						