企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.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 
      Cancel          =   -1  'True
      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 VSFlex8Ctl.VSFlexGrid vsFlx_GridData 
      Height          =   4530
      Left            =   60
      TabIndex        =   0
      Top             =   90
      Width           =   3390
      _ExtentX        =   5980
      _ExtentY        =   7990
      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
'******************************************************************
'*    模 块 名 称 :排序窗体
'*    功 能 描 述 :实现人事信息查询的排序,生成Order By子句
'*    程序员姓名  :苗鹏
'*    最后修改人  :苗鹏
'*    最后修改时间:2002/01/10
'*    备        注:
'******************************************************************
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() '生成Order语句
    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
    '生成Order语句
    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()
    Dim str_TempSql As String
    Dim rs_Temp As New ADODB.Recordset
    '初始化网格及填充字段
    int_MaxOrderNum = 0
    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

						