customerinit.frm

金算盘软件代码

            SaveFlexColWidth
            GetList mstrWhere
            'SetFlexColWidth
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除往来期初改变消息
        End If
    Next
    mclsMainControl.Messages.Clear
    gclsSys.CurrFormName = Me.hwnd
    frmMain.mnuEditFilter.Enabled = True
    frmMain.mnuToolRefresh.Enabled = True
    frmMain.mnuFilePrint.Enabled = True
    frmMain.SetToolBar
    
End Sub

Private Sub Form_Deactivate()
    frmMain.mnuToolRefresh.Enabled = False
    frmMain.mnuEditFilter.Enabled = False
End Sub

'
'窗体Form事件处理
'
Private Sub Form_Load()
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If Me.Left + Me.width < 0 Or Me.Left > Screen.width Then
        Me.Left = 300
    End If
    RedrawForm
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    SaveFlexColWidth
    mclsListSet.SaveList
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    Set mclsListSet = Nothing
    If Not mrstData Is Nothing Then
       mrstData.Close
    End If
    Set mGrid = Nothing
End Sub

Private Sub mclsMainControl_ChildActive()
    Form_Activate
End Sub

Private Sub mclsMainControl_EditFilter()
    cmdCustomerInit_Click 0
End Sub

Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    mclsMainControl_ToolRefresh
    Set myPrintclass = New PrintClass
    myPrintclass.PrintNewList gclsBase.BaseDB, mrstData, mGrid.TableHandle, 77, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Set myPrintclass = Nothing
End Sub

Private Sub mclsMainControl_FilePrintSetup()
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    myPrintclass.PrintNewSetUp gclsBase.BaseDB, mGrid.TableHandle, , , , 77, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Set myPrintclass = Nothing
End Sub

Private Sub mclsMainControl_ToolRefresh()
    GetList mstrWhere
End Sub

Private Sub mGrid_AfterRowChange(ByVal Row As Long)
  Dim intFindCol As Integer, intLen As Integer
    
    intFindCol = cboCustomerInit.ListIndex
    mblnNotFind = True
    If mGrid.Rows > 1 And mGrid.Row > 0 Then
        intLen = Len(txtCustomerInit.Text)
        txtCustomerInit.Text = mGrid.CellValue(mGrid.Row, intFindCol)
        txtCustomerInit.SelStart = intLen
        If Len(txtCustomerInit.Text) - intLen > 0 Then
           txtCustomerInit.SelLength = Len(txtCustomerInit.Text) - intLen
        End If
    Else
        txtCustomerInit.Text = ""
    End If
    mlngLastPosition = mGrid.Row
    mblnNotFind = False
End Sub

Private Sub mGrid_WindowProc(ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
End Sub

Private Sub mGrid_AfterWindowProc(ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
  Dim lngFlag As Long
  Dim lngCount As Long
     If Message = WM_VSCROLL Then
        lngFlag = 0
        With mGrid
        For lngCount = .TopRow To .BottomRow
            If .CellValue(lngCount, 8) <> lngFlag Then
                lngFlag = .CellValue(lngCount, 8)
            Else
                .CellFormula(lngCount, 0) = " "
                .CellFormula(lngCount, 1) = " "
            End If
        Next lngCount
        End With
     End If
End Sub

'
'FLEXGRID控件事件处理
'
Private Sub picInit_DblClick()
  Dim intCol As Integer, lngRow As Long
  
   mGrid.MouseCell lngRow, intCol
   
   If mGrid.Rows <= 1 Or lngRow <= 0 Then
      Exit Sub
   End If
   
   With mGrid
        Me.MousePointer = vbHourglass
        If gclsBase.ControlAccount Then
            Load frmCustomerInitDetail
            frmCustomerInitDetail.ShowInitDetail .CellValue(lngRow, 8), IIf(IsNull(.CellValue(lngRow, 7)), 0, .CellValue(lngRow, 7)), mstrPrice, mintYear, mblnClose, mstrDec
        Else
            Load frmCustomerInitDetail1
            frmCustomerInitDetail1.ShowInitDetail .CellValue(lngRow, 8), IIf(IsNull(.CellValue(lngRow, 7)), 0, .CellValue(lngRow, 7)), mstrPrice, mintYear, mblnClose, mstrDec
        End If
        Me.MousePointer = vbDefault
        Me.SetFocus
   End With
End Sub

Private Sub picInit_GotFocus()
    If mGrid.Rows > 1 Then
       If mintOldRow < mGrid.Rows Then
          If mintOldRow = 0 Then
             mGrid.Row = 1
          Else
             mGrid.Row = mintOldRow
          End If
       Else
          mGrid.Row = mGrid.Rows - 1
       End If
    End If
End Sub

Private Sub picInit_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeySpace Then
       picInit_DblClick
    End If
End Sub

Private Sub picInit_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then
        Unload Me
    End If
End Sub

Private Sub picInit_LostFocus()
    mintOldRow = mGrid.Row
End Sub

Private Function FindText(ByVal strFind As String, Optional FromNow As Boolean = False)
  Dim lngBegin As Long, lngEnd As Long, lngFindRow As Long, lngPrev As Long
  Dim intFindCol As Integer
  Dim strCell As String
  Dim blnFound As Boolean
  Dim lngStopRow As Long
  
    If strFind = "" Or mblnNotFind Then
       Exit Function
    End If
    
    intFindCol = cboCustomerInit.ListIndex
    If FromNow Then
      lngBegin = mlngLastPosition + 1
    Else
      lngBegin = 1
    End If
    lngStopRow = lngBegin
    lngEnd = mrstData.RowCount
    With mrstData
        Do While lngEnd - lngBegin >= 0
            .AbsolutePosition = lngBegin + (lngEnd - lngBegin) \ 2
            
            If InStr(.rdoColumns(intFindCol).Value, strFind) = 1 Then
               lngFindRow = lngBegin + (lngEnd - lngBegin) \ 2
               If lngFindRow < 10 And lngFindRow > lngStopRow Then
                    lngPrev = lngBegin + (lngEnd - lngBegin) \ 2 - 1
                    If lngPrev >= 0 Then
                        .AbsolutePosition = lngPrev
                        Do While lngPrev >= lngStopRow - 1 And Not .BOF
                           If InStr(.rdoColumns(intFindCol).Value, strFind) <> 1 Then
                             Exit Do
                           Else
                             lngFindRow = lngPrev
                             lngPrev = lngPrev - 1
                             If Not .EOF Then
                                .MovePrevious
                             End If
                           End If
                        Loop
                    End If
                    blnFound = True
                    lngBegin = lngPrev
                    Exit Do
               End If
               blnFound = True
            End If
            
            If .rdoColumns(intFindCol).Value >= strFind Then
                 If lngEnd - lngBegin > 1 Then
                    lngEnd = lngBegin + (lngEnd - lngBegin) \ 2
                 Else
                    lngEnd = lngEnd - 1
                 End If
            Else
                 If lngEnd - lngBegin > 1 Then
                    lngBegin = lngBegin + (lngEnd - lngBegin) \ 2
                 Else
                    lngBegin = lngBegin + 1
                 End If
            End If
        Loop
    End With
    If blnFound Then
        If mGrid.Row = lngFindRow Then
            mGrid_AfterRowChange lngFindRow
        End If
        mGrid.Row = lngFindRow
        mlngLastPosition = lngFindRow
    End If
End Function

'
'查找内容TextBox控件事件处理
'
Private Sub txtCustomerInit_Change()
    FindText txtCustomerInit.Text
End Sub

Private Sub txtCustomerInit_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim intSelLen As Integer
    
    If KeyCode = 8 Then
        If txtCustomerInit.SelStart > 0 Then
            intSelLen = txtCustomerInit.SelLength
            txtCustomerInit.SelStart = txtCustomerInit.SelStart - 1
            txtCustomerInit.SelLength = intSelLen + 1
        End If
    End If
End Sub

'
'再找按钮事件处理
'
Private Sub cmdCustomerInit_Click(Index As Integer)
    Dim strWhere As String
    Dim blnFlag As Boolean
    
    Select Case Index
        Case 0
            If mclsListSet.ListID < 1 Then mclsListSet.SaveList
            Filter.ShowFilter mclsListSet.ListID, 1, , , , , blnFlag, , , , , , strWhere, mstrHaveing
            If blnFlag Then
                mstrWhere = strWhere
                SaveFlexColWidth
                GetList mstrWhere
            End If
        Case 1
            frmMain.Enabled = False
            Me.MousePointer = vbHourglass
            frmARAPInitEqual.EditCard mintYear, mstrDate, mstrDec
            Me.MousePointer = vbDefault
            frmMain.Enabled = True
            
        Case 2
            FindAgain
        Case 3
            mclsMainControl_FilePrint
    End Select
End Sub


Public Function ShowCusInit()
    If Me.Visible Then
        Me.ZOrder
    Else
        mblnLoad = False
        Set mGrid = New WINCTRLLib.DBTableCtrl
        mGrid.hwnd = picInit.hwnd
        mGrid.SelectionMode = 4
        mintOldRow = 1
        Me.HelpContextID = 30105
        SetHelpID 30105
        GetYearPeriod
        Set mclsListSet = New ListSet
        mclsListSet.ViewId = ViewId
        cboCustomerInit.AddItem "单位编码"
        cboCustomerInit.AddItem "单位名称"
        cboCustomerInit.ListIndex = 0
        mstrWhere = Filter.GetInitWhere(mclsListSet.ListID, 1, , , , , mstrHaveing)
        GetList mstrWhere
        Me.Show
        SetFlexColWidth
        Set mclsMainControl = gclsSys.MainControls.Add(Me)
        mblnLoad = True
    End If
End Function