frmstandardbook.frm

金算盘软件代码

         If Not frmMain.ActiveForm Is Me Then Exit Sub
         StandardReport.CallReportPopMenu                      '装载窗体弹出菜单资源
         mlngCellTop = y
         mlngCellLeft = x
         mbytCellType = pos
         If pos = 1 Then
            blnAddCell = mclsCell.CanAddHead
         Else
            blnAddCell = False
         End If
         frmMain.mnuListReportMenu(3).Enabled = cmdSave.Enabled
         If ABook.FCLocked = 1 Then
            frmMain.mnuListReportMenu(8).Checked = True
            frmMain.mnuListReportMenu(9).Enabled = False
            frmMain.mnuListReportMenu(10).Enabled = False
         Else
            frmMain.mnuListReportMenu(8).Checked = False
            frmMain.mnuListReportMenu(9).Enabled = True
            frmMain.mnuListReportMenu(10).Enabled = True
         End If
         frmMain.mnuListReportMenu(9).Checked = IIf(ABook.FCPlace = 0, False, True)
         frmMain.mnuListReportMenu(13).Checked = mblnAutoRefresh
         If Not mblnStandard Then
            frmMain.mnuListReportMenu(11).Visible = True
            frmMain.mnuListReportMenu(11).Checked = mblnCrossSameWidth
         End If
         PopupMenu frmMain.mnuListReport
    End If
End Sub


Private Sub ABook_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
         If Not frmMain.ActiveForm Is Me Then Exit Sub
         StandardReport.CallReportPopMenu                '装载窗体弹出菜单资源
         frmMain.mnuListReportMenu(3).Enabled = cmdSave.Enabled
         If ABook.FCLocked = 1 Then
            frmMain.mnuListReportMenu(8).Checked = True
            frmMain.mnuListReportMenu(9).Enabled = False
            frmMain.mnuListReportMenu(10).Enabled = False
         Else
            frmMain.mnuListReportMenu(8).Checked = False
            frmMain.mnuListReportMenu(9).Enabled = True
            frmMain.mnuListReportMenu(10).Enabled = True
         End If
         frmMain.mnuListReportMenu(9).Checked = IIf(ABook.FCPlace = 0, False, True)
         frmMain.mnuListReportMenu(13).Checked = mblnAutoRefresh
         If Not mblnStandard Then
            frmMain.mnuListReportMenu(11).Visible = True
            frmMain.mnuListReportMenu(11).Checked = mblnCrossSameWidth
         End If
         PopupMenu frmMain.mnuListReport
    Else
    End If
End Sub

Private Sub ABook_RowHeightChange()
    If DispartPage Then                                   '分页
        SetData                                        '填充数据
    End If
End Sub

Private Sub ABook_RowScroll(ByVal Distance As Long)
Dim lngValue As Long
    lngValue = VScroll.Value + Distance
    If lngValue > VScroll.Max Then
        VScroll.Value = VScroll.Max
    ElseIf lngValue < VScroll.Min Then
        VScroll.Value = VScroll.Min
    Else
        VScroll.Value = lngValue
    End If
End Sub

Private Sub ABook_TableTopChanged(top As Integer)
    mclsStandard.GridTop = top * Screen.TwipsPerPixelY
    If DispartPage Then                                   '分页
        SetData                                        '填充数据
    End If
    mblnChanged = True
End Sub

Private Sub cboList_Choose(Index As Integer)
    If mblnRefresh And mblnAutoRefresh Then
         GetListCond                                    '得到列表框条件
         RefreshData                                    '刷新记录
    End If
End Sub

Private Sub cboList_ItemNotExist(Index As Integer)
    If LblList(Index).Caption = "保险号码(&" & Index + 1 & ")" Then Exit Sub
    Utility.ShowMsg Me.hWnd, GetNoXString(LblList(Index).Caption, 1, "(") & "“" & cboList(Index).Text & "”不存在!", vbInformation + vbOKOnly, App.title
    cboList(Index).SetFocus
End Sub
Private Sub cboList_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = vbKeyReturn And mblnAutoRefresh And Left(LblList(Index).Caption, 4) = "保险号码" Then
         GetListCond                                    '得到列表框条件
         RefreshData                                    '刷新记录
    End If
End Sub
Private Sub cboMonth_Choose()
    If Not cboMonth.Visible Then Exit Sub
    If mblnRefresh And mblnAutoRefresh Then
        GetDateCond                                    '得到列表框条件
        RefreshData                                    '刷新记录
    End If
End Sub

Private Sub cboYear_Choose()
    If Not cboYear.Visible Then Exit Sub
    If mblnRefresh And mblnAutoRefresh Then
        GetDateCond                                    '得到列表框条件
        RefreshData                                    '刷新记录
    End If
End Sub

Private Sub cmbDate_Choose()
    Dim D1 As Date
    Dim D2 As Date
    If Not cmbDate.Visible Then Exit Sub
    If cmbDate.Text = "所有" Then
        mstrOldDate = "$" & detEnd.Text
        detBegin.Text = ""
        mstrOldDate = "$"
        detEnd.Text = ""
    Else
        If cmbDate.Text = "自定义" Then
'            detBegin.SetFocus
            Exit Sub
        Else
            gclsBase.GetBeginAndEndDate cmbDate.Text, Format(gclsBase.BaseDate, "YYYY-MM-DD"), D1, D2
            mstrOldDate = Format(D1, "YYYY-MM-DD") & "$" & detEnd.Text
            detBegin.Value = Format(D1, "YYYY-MM-DD")
            mstrOldDate = detBegin.Text & "$" & Format(D2, "YYYY-MM-DD")
            detEnd.Value = Format(D2, "YYYY-MM-DD")
        End If
    End If
    mstrOldDate = detBegin.Text & "$" & detEnd.Text
    If mblnRefresh And mblnAutoRefresh Then
         GetDateCond                                    '得到列表框条件
         RefreshData                                    '刷新记录
    End If
End Sub

Private Sub cmbDate_LostFocus()
    If Not cmbDate.Visible Then Exit Sub
   If Not (Me.ActiveControl Is detBegin Or Me.ActiveControl Is detEnd) Then
     If Format(detBegin.Value, "YYYY-MM-DD") > Format(detEnd.Value, "YYYY-MM-DD") Then
         Utility.ShowMsg Me.hWnd, "开始时间不能大于终止时间!", vbOKOnly + vbInformation, App.title
         detBegin.SetFocus
     End If
   End If
End Sub

Private Sub detBegin_Change()
    If Not detBegin.Visible Then Exit Sub
    If mstrOldDate <> detBegin.Text & "$" & detEnd.Text And cmbDate.Text <> "自定义" And mblnRefresh Then
        cmbDate.Text = "自定义"
    End If
End Sub

Private Sub detBegin_KeyDown(KeyCode As Integer, Shift As Integer, bCancel As Long)
  Dim blnChange As Boolean
    If Not detBegin.Visible Then Exit Sub
    blnChange = True
    Select Case KeyCode
       Case vbKeyDelete
       Case vbKey0, vbKey1, vbKey2, vbKey3, vbKey4, vbKey5, vbKey6, vbKey7, vbKey8, vbKey9
       Case vbKeyNumpad0, vbKeyNumpad1, vbKeyNumpad2, vbKeyNumpad3, vbKeyNumpad4, vbKeyNumpad5
       Case vbKeyNumpad6, vbKeyNumpad7, vbKeyNumpad8, vbKeyNumpad9, vbKeySubtract, 189
       Case vbKeyReturn
            If detEnd.Visible Then
                detEnd.SetFocus
            Else
                detBegin_LostFocus
            End If
            Exit Sub
       Case Else
          blnChange = False
    End Select
    If blnChange Then
       If mstrOldDate <> detBegin.Text & "$" & detEnd.Text And cmbDate.Text <> "自定义" Then
          cmbDate.Text = "自定义"
       End If
    End If
End Sub

Private Sub detBegin_LostFocus()
  If Not detBegin.Visible Then
'        RefreshData                                    '刷新记录
        Exit Sub
  End If
  If Not (Me.ActiveControl Is detEnd Or Me.ActiveControl Is cmbDate) Then
     
     If Format(detBegin.Value, "YYYY-MM-DD") > Format(detEnd.Value, "YYYY-MM-DD") Then
         Utility.ShowMsg Me.hWnd, "开始时间不能大于终止时间!", vbOKOnly + vbInformation, App.title
         If Trim(detEnd.Text) <> "" Then
            detBegin.Value = Format(detEnd.Value, "YYYY-MM-DD")
         Else
            detEnd.Value = Format(detBegin.Value, "YYYY-MM-DD")
         End If
         detBegin.SetFocus
     Else
         If mblnRefresh And mblnAutoRefresh And mstrOldDate <> detBegin.Text & "$" & detEnd.Text Then
            GetDateCond                                    '得到日期条件
            RefreshData                                    '刷新记录
            mstrOldDate = detBegin.Text & "$" & detEnd.Text
         End If
     End If
  End If
End Sub

Private Sub detEnd_Change()
    If Not detEnd.Visible Then Exit Sub
    If mstrOldDate <> detBegin.Text & "$" & detEnd.Text And cmbDate.Text <> "自定义" And mblnRefresh Then
        cmbDate.Text = "自定义"
     End If
End Sub

Private Sub detEnd_KeyDown(KeyCode As Integer, Shift As Integer, bCancel As Long)
Dim blnChange As Boolean
    If detEnd.Visible = False Then Exit Sub
    blnChange = True
    Select Case KeyCode
       Case vbKeyDelete
       Case vbKey0, vbKey1, vbKey2, vbKey3, vbKey4, vbKey5, vbKey6, vbKey7, vbKey8, vbKey9
       Case vbKeyNumpad0, vbKeyNumpad1, vbKeyNumpad2, vbKeyNumpad3, vbKeyNumpad4, vbKeyNumpad5
       Case vbKeyNumpad6, vbKeyNumpad7, vbKeyNumpad8, vbKeyNumpad9, vbKeySubtract, 189
       Case vbKeyReturn
            detEnd_LostFocus
            Exit Sub
       Case Else
          blnChange = False
    End Select
    If blnChange Then
       If mstrOldDate <> detBegin.Text & "$" & detEnd.Text And cmbDate.Text <> "自定义" Then
          cmbDate.Text = "自定义"
       End If
    End If
End Sub

Private Sub detEnd_LostFocus()

  If Not detEnd.Visible Then Exit Sub
  If Not (Me.ActiveControl Is detBegin Or Me.ActiveControl Is cmbDate) Then
     
     If Format(detBegin.Value, "YYYY-MM-DD") > Format(detEnd.Value, "YYYY-MM-DD") Then
         Utility.ShowMsg Me.hWnd, "开始时间不能大于终止时间!", vbOKOnly + vbInformation, App.title
         If Trim(detEnd.Text) <> "" Then
            detBegin.Value = Format(detEnd.Value, "YYYY-MM-DD")
         Else
            detEnd.Value = Format(detBegin.Value, "YYYY-MM-DD")
         End If
         detBegin.SetFocus
     Else
          If mblnRefresh And mblnAutoRefresh And mstrOldDate <> detBegin.Text & "$" & detEnd.Text Then
            GetDateCond                                    '得到日期条件
            RefreshData                                    '刷新记录
            mstrOldDate = detBegin.Text & "$" & detEnd.Text
          End If
     End If
  End If
End Sub

Private Sub detStop_GotFocus()
    mstrPreStop = detStop.Text
End Sub

Private Sub detStop_KeyDown(KeyCode As Integer, Shift As Integer, bCancel As Long)
Dim blnChange As Boolean
    If detStop.Visible = False Then Exit Sub
    Select Case KeyCode
       Case vbKeyBack
       Case vbKey0, vbKey1, vbKey2, vbKey3, vbKey4, vbKey5, vbKey6, vbKey7, vbKey8, vbKey9
       Case vbKeyNumpad0, vbKeyNumpad1, vbKeyNumpad2, vbKeyNumpad3, vbKeyNumpad4, vbKeyNumpad5
       Case vbKeyNumpad6, vbKeyNumpad7, vbKeyNumpad8, vbKeyNumpad9, vbKeySubtract, 189
       Case vbKeyReturn
            detStop_LostFocus
            Exit Sub
       Case Else
    End Select
End Sub
Private Sub detStop_LostFocus()
    If Not detStop.Visible Then
          Exit Sub
    End If
     If mblnRefresh And mblnAutoRefresh And mstrPreStop <> detStop.Text Then
         GetDateCond                                    '得到日期条件
         RefreshData                                    '刷新记录
     End If
End Sub

Private Sub cmdAccSet_Click()
Dim blnIsOK As Boolean
Dim intOldLists As Integer, intDiff As Integer
    
    If Not MyReportExist(mclsStandard.ReportID) Then
        mblnFatalErr = True
        Unload Me
        Exit Sub
    End If
    '调用向导
    If mblnStandard Then
        intOldLists = mclsStandard.ListColumns
    Else
        intOldLists = mclsCross.ListColumns
    End If
    blnIsOK = frmStandard.SetStandard(mblnStandard, mclsFormCond, mclsStandard, mclsCross)
    If blnIsOK Then
         mblnRefresh = False
         If mblnStandard Then
            intDiff = mclsStandard.ListColumns - intOldLists
            mclsStandard.SetSQL
         Else
            intDiff = mclsCross.ListColumns - intOldLists
         End If
         If intDiff <> 0 Then
            mclsCell.ReSetCellNo intDiff
            mclsCell.ReSetDateCellLoc
         End If
         InitHeadList
         RefreshData blnIsOK                                        '刷新纪录
         mblnRefresh = True
         mblnChanged = True
         If blnIsOK = False And mblnFatalErr = False Then
            Utility.ShowMsg Me.hWnd, "固定列太多而超宽，程序将关闭窗体！", vbOKOnly + vbInformation, App.title
            Unload Me
         End If
    End If
End Sub

Private Sub CmdPrint_Click()
    If Not MyReportExist(mclsStandard.ReportID) Then
        mblnFatalErr = True
        Unload Me
        Exit Sub
    End If
    
    If mblnStandard Then
        ReportPrintStandard
    Else
        ReportPrintCross