frmlistjobitem.frm

金算盘软件代码

VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form frmListJobItem 
   Caption         =   "Form1"
   ClientHeight    =   4500
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6765
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MDIChild        =   -1  'True
   ScaleHeight     =   4500
   ScaleWidth      =   6765
   Begin VB.CheckBox chkShowall 
      Caption         =   "全部显示"
      Height          =   350
      Left            =   5520
      TabIndex        =   10
      Top             =   3984
      Width           =   1035
   End
   Begin VB.ComboBox cboFindKind 
      Height          =   276
      Left            =   876
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   120
      Width           =   1515
   End
   Begin VB.CommandButton cmdAgain 
      BeginProperty Font 
         Name            =   "Arial Black"
         Size            =   10.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   6228
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1017"
      Top             =   120
      UseMaskColor    =   -1  'True
      Width           =   300
   End
   Begin VB.TextBox txtFind 
      Height          =   300
      Left            =   4416
      TabIndex        =   3
      Top             =   120
      Width           =   1815
   End
   Begin VB.PictureBox pctDataGrid 
      Height          =   3048
      Left            =   144
      ScaleHeight     =   2985
      ScaleWidth      =   6285
      TabIndex        =   5
      Top             =   672
      Width           =   6348
   End
   Begin MSForms.CommandButton cmdEAR 
      Height          =   348
      Index           =   3
      Left            =   2472
      TabIndex        =   8
      Top             =   3948
      Width           =   1212
      Caption         =   "发票(V)"
      PicturePosition =   196613
      Size            =   "2138;614"
      Accelerator     =   86
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin MSForms.CommandButton cmdEAR 
      Height          =   348
      Index           =   2
      Left            =   3684
      TabIndex        =   9
      Top             =   3948
      WhatsThisHelpID =   5010
      Width           =   1212
      Caption         =   "审批核对(N)"
      PicturePosition =   196613
      Size            =   "2138;614"
      Accelerator     =   78
      TakeFocusOnClick=   0   'False
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin MSForms.CommandButton cmdEAR 
      Height          =   348
      Index           =   1
      Left            =   1260
      TabIndex        =   7
      Top             =   3948
      WhatsThisHelpID =   5010
      Width           =   1212
      Caption         =   "拨入(P)"
      PicturePosition =   196613
      Size            =   "2138;614"
      Accelerator     =   80
      TakeFocusOnClick=   0   'False
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin MSForms.CommandButton cmdEAR 
      Height          =   348
      Index           =   0
      Left            =   50
      TabIndex        =   6
      Tag             =   "1018"
      Top             =   3948
      Width           =   1212
      Caption         =   "编辑"
      PicturePosition =   196613
      Size            =   "2143;617"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin VB.Label lblFind 
      Caption         =   "内容(&C)"
      Height          =   228
      Left            =   3636
      TabIndex        =   2
      Top             =   156
      Width           =   756
   End
   Begin VB.Label lblFindKind 
      Caption         =   "查找(&B)"
      DragMode        =   1  'Automatic
      Height          =   204
      Left            =   48
      TabIndex        =   0
      Top             =   168
      Width           =   684
   End
End
Attribute VB_Name = "frmListJobItem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private mclsList As ListGrid
Private WithEvents mclsMainControl As MainControl
Attribute mclsMainControl.VB_VarHelpID = -1
Private Const mintViewId = 1196
Private blnChange As Boolean '只能编辑和删除自己制作的单据
Private blnEdit As Boolean '编辑权限
Private mIsFind As Boolean
Private ComPleteLoad As Integer
Private mblnIsFindTextChange As Boolean
Private mIsShowEdit As Boolean
Private intFindCol As Integer
Private mblnEdit As Boolean
Private mblnNewProject As Boolean
Private mblnNewProjectOrder As Boolean
Private Function MakeListSql(ByVal intPageNo As Integer) As Boolean
    Dim BeginDate As Date
    Dim EndDate As Date
    Dim recTemp As rdoResultset
    Dim strSelect As String
    Dim strFrom   As String
    Dim strWhere  As String
    Dim strSql As String
    Dim strCWhere As String
    Dim strCSql As String
    Dim strSortName As String
    
    On Error Resume Next
    strSelect = mclsList.ListSet.SelectOfSql
    strFrom = mclsList.ListSet.FromOfSql
    strWhere = mclsList.ListSet.WhereOfSql
   strSortName = IIf(mclsList.ListSet.ColumnDesc(mclsList.SortCol) = "在建工程名称", "ProjectName.strProjectNameSort", "ProjectName.strProjectCodeSort") & Choose(mclsList.SortType, " Asc ", " Desc ")
   
    If Trim(strSelect) = "" Or Trim(strFrom) = "" Then
        Exit Function
    End If
    If Not mclsList.ShowAll Then
        If Trim(strWhere) <> "" Then
            strWhere = strWhere & " and  ProjectName.blnIsInActive=0"
            
        Else
            strWhere = " ProjectName.blnIsInActive=0"
        End If
    End If
    If Trim(strWhere) <> "" Then
        strCSql = " Select count(*)  As Num " & strFrom & " Where " & strWhere
        strWhere = " where " & strWhere & _
                     " ORDER BY " & strSortName '" ORDER BY ProjectName.lngProjectID"
    Else
        strCSql = " Select count(*)  As Num " & strFrom
        strWhere = " ORDER BY " & strSortName '" ORDER BY ProjectName.lngProjectID"
    End If
    
    strSelect = "Select ProjectName.lngProjectID As id,decode(ProjectName.blnIsInActive,1,'√','') As ""停用""," & strSelect
    
    strSql = strSelect & strFrom & strWhere
     Debug.Print " Sql2: " & Timer
    Set recTemp = gclsBase.BaseDB.OpenResultset(strCSql, rdOpenStatic)
    Set mclsList.Resultset(intPageNo) = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Debug.Print " Sql6: " & Timer
    If Not recTemp.EOF Then mclsList.TotalRow(intPageNo) = recTemp!Num
    mclsList.intTab = intPageNo
    If recTemp!Num = 0 Then
        cmdAgain.Enabled = False
    Else
        cmdAgain.Enabled = True
    End If
    recTemp.Close
    Set recTemp = Nothing
End Function

Public Function ListID() As Long
'    With mclsList.DbTabCtrl
'        If .CellValue(.Row, 0) <> "" Then
'            ListID = CLng(.CellValue(.Row, 0))
'        Else
'            ListID = 0
'        End If
'    End With
    Dim lngID As Long
    With mclsList
        If .TotalRow(.intTab) < 1 Then Exit Function
        If .DbTabCtrl.Row > .TotalRow(.intTab) + 1 Then .DbTabCtrl.Row = .TotalRow(.intTab) + 1
        .Resultset(.intTab).AbsolutePosition = .DbTabCtrl.Row
        lngID = .Resultset(.intTab).rdoColumns(0).Value
        If Trim(lngID) <> "" Then
            ListID = CLng(lngID)
        Else
            ListID = 0
        End If
    End With
End Function

'初始查找列
Public Sub intcboFindKind()
    Dim intSortCol As Integer
    Dim intCount As Integer
    Dim intItem As Integer
    
    cboFindKind.Clear
    For intCount = 1 To mclsList.ListSet.Columns
        If mclsList.ListSet.ColumnIsFind(intCount) Then
            cboFindKind.AddItem mclsList.ListSet.ColumnDesc(intCount)
            Select Case UCase(mclsList.ListSet.ColumnFieldType(intCount))
                Case "INTEGER", "LONG", "DOUBLE"
                    cboFindKind.ItemData(intItem) = 1
                Case Else
                    cboFindKind.ItemData(intItem) = 10 + mclsList.ListSet.ColumnFieldSize(intCount)
            End Select
            
            If mclsList.ListSet.ColumnOrderType(intCount) <> 0 Then
                intSortCol = intItem
                mclsList.SortCol = intCount
                mclsList.FindColName = mclsList.ListSet.ColumnFieldName(intCount)
                'ozj注释
                If mclsList.ListSet.ColumnOrderType(intCount) = 1 Then
                    mclsList.ListSet.ColumnOrderType(intCount) = 1
                    mclsList.SortType = 1
                Else
                    mclsList.ListSet.ColumnOrderType(intCount) = 2
                    mclsList.SortType = 2
                End If
            End If
            intItem = intItem + 1
        End If
    Next
    cboFindKind.ListIndex = intSortCol
End Sub

'重新刷新当前页
Public Function ToolRefresh() As Boolean
    mclsList.DbTabCtrl.Clear
    MakeListSql 0
    mclsList.SetGridFormate
    UpdateEditMenuStatus
End Function
'重新构造数据
Private Function ReMakeData()
     With mclsList
        .ListSet.ViewId = mintViewId
        intcboFindKind
        mclsList.DbTabCtrl.Clear
        MakeListSql 0
        mclsList.SetGridFormate
    End With
    UpdateEditMenuStatus
End Function

Private Sub RedrawForm()
    On Error Resume Next
    With pctDataGrid
        .top = 500
        .Left = ListFormLeft
        .width = Me.ScaleWidth - ListFormLeft - ListFormRight
        .Height = Me.ScaleHeight - ListUpAreaHeight - ListDownAreaHeight
    End With
    '重画其余控件
    txtFind.width = Me.ScaleWidth - txtFind.Left - ListFormBottom - cmdAgain.width - 15
    cmdAgain.Left = txtFind.Left + txtFind.width
    cmdEAR(0).top = Me.ScaleHeight - cmdEAR(0).Height - ListFormBottom
    cmdEAR(1).top = cmdEAR(0).top
    cmdEAR(2).top = cmdEAR(0).top
    cmdEAR(3).top = cmdEAR(0).top
    chkShowall.top = cmdEAR(0).top
    chkShowall.Left = Me.ScaleWidth - chkShowall.width - ListFormBottom
End Sub

Private Sub cboFindKind_Click()
    Dim intCount As Integer
    Dim blnFindKindIsChange As Boolean
    Dim strOldText As String
    
    blnFindKindIsChange = False
    strOldText = txtFind.Text
    With mclsList.ListSet
        For intCount = 1 To .Columns
            If .ColumnIsFind(intCount) Then
                If .ColumnDesc(intCount) = cboFindKind.Text Then
                    If mclsList.SortCol <> intCount Then
                        .ColumnOrderType(mclsList.SortCol) = 0
                         .ColumnOrderType(intCount) = 1
                         mclsList.SortCol = intCount
                         mclsList.FindColName = .ColumnDesc(intCount)
                         blnFindKindIsChange = True
                         Exit For
                    End If
                End If
            End If
        Next
    End With
    If blnFindKindIsChange And mIsFind Then
        ToolRefresh 'ReSortGrid '重新排序查找
    With mclsList
        If .DbTabCtrl.Row < .DbTabCtrl.Rows Then
            If Not .Resultset(.intTab).EOF And Not .Resultset(.intTab).BOF Then
                '.Resultset(.intTab).Move .DbTabCtrl.Row - 1, 1
                .Resultset(.intTab).AbsolutePosition = .DbTabCtrl.Row
            End If
        Else
            .DbTabCtrl.Row = .DbTabCtrl.Rows - 1
            If Not mclsList.Resultset(.intTab).EOF And Not mclsList.Resultset(.intTab).BOF Then
                '.Resultset(.intTab).Move .DbTabCtrl.Row - 1, 1
                .Resultset(.intTab).AbsolutePosition = .DbTabCtrl.Row
            End If
        End If
    
        If Not .Resultset(.intTab).EOF And Not .Resultset(.intTab).BOF Then txtFind.Text = IIf(IsNull(.Resultset(.intTab).rdoColumns(.SortCol + 1).Value), "", .Resultset(.intTab).rdoColumns(.SortCol + 1).Value)
    End With
    End If
End Sub

Private Sub chkShowAll_Click()
    'mclsList.DoShowAll chkShowall.Value
    Debug.Print "Chk1:" & Timer
    mclsList.ShowAll = Not mclsList.ShowAll
    Debug.Print "Chk2:" & Timer
    ToolRefresh
    Debug.Print "Chk3:" & Timer
    frmMain.mnuEditShowAll.Checked = Not frmMain.mnuEditShowAll.Checked