⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmagewizard.frm

📁 金算盘软件代码
💻 FRM
📖 第 1 页 / 共 5 页
字号:
Private Sub Form_Activate()
    SetHelpID 70003
End Sub

'窗体调用
Private Sub Form_Load()
On Error GoTo ErrHandle
'    SetHelpID  70003
    tabQueryWizard.Tab = 0
    loadResPic              '调用控件资源文件
    tvwFilter.ImageList = frmMain.ImageListFilter
    Set mclsHook = New Hook
    mclsHook.SetHook MsgFilter.hWnd
    cmdAgePrev.Enabled = False
    Exit Sub
ErrHandle:
    Unload Me
End Sub

'在类模块调用时初始化
Public Function SetAge(ByVal clsWizard As Age, Optional clsFromCond As FormCond) As Boolean
    MsgForm.PleaseWait
    Set mclsAgeWizard = clsWizard
    mstrOldName = mclsAgeWizard.AgeName
    Select Case mclsAgeWizard.AgeViewID
        Case 126, 1007
            Me.Caption = "应付帐龄分析汇总查询向导"
            frmAgeDataComment.Visible = True
            OptDetail3.Visible = True
            OptDetail3.Enabled = True
        Case 609, 1006
            Me.Caption = "应付帐龄分析明细查询向导"
            frmAgeDataComment.Visible = False
            fraAgeDataType.top = frmAgeDataComment.top - 100
            Frame4.top = Frame4.top + 100
            OptDetail3.Visible = False
            OptDetail3.Enabled = False
            optDetail2.Left = OptDetail3.Left - 300
        Case 610, 1005
            Me.Caption = "应收帐龄分析汇总查询向导"
            OptDetail3.Enabled = True
            OptDetail3.Visible = True
            frmAgeDataComment.Visible = True
        Case 611, 1004
            Me.Caption = "应收帐龄分析明细查询向导"
            OptDetail3.Visible = False
            OptDetail3.Enabled = False
            optDetail2.Left = OptDetail3.Left - 300
            fraAgeDataType.top = frmAgeDataComment.top - 100
            Frame4.top = Frame4.top + 100
            frmAgeDataComment.Visible = False
        Case Else
            Me.Caption = "帐龄分析查询向导"
            OptDetail3.Enabled = False
            OptDetail3.Visible = True
            frmAgeDataComment.Visible = True
    End Select
    If mclsAgeWizard.IsNewWizard Then
        txtAgeName.Text = "未定义"          '是新建报表则报表名称默认为 "未定义"
    Else
        txtAgeName.Text = mclsAgeWizard.AgeName
    End If
    mblnPeriodInsertFinish = True
    tabQueryWizard.Tab = 0
    
    If Not IsDate(mclsAgeWizard.AgeEndDate) Then        '修正 "截止日期"
        mclsAgeWizard.AgeEndDate = Format(gclsBase.BaseDate, "yyyy-mm-dd")
    End If
    
'初始化条件值
    Set mclsFilter = clsFromCond
    
'调用条件设置
    mclsFilter.ShowFilter Me, mclsAgeWizard.AgeReportID, 2
    
    If Trim(mclsAgeWizard.AgeDateDesc) = "到期日" Then   '初始化 "两清标志"
        OptDueDate.Value = True
    Else
        OptReceiptDate.Value = True
    End If
    
    #If conVersionType = 16 Then
        If gclsBase.ControlAccount = False Then
            fraAgeDataType.Left = Frame4.Left
            fraAgeDataType.top = Frame4.top
            fraAgeDataType.Height = fraAgeDataType.Height + 100
            fraAgeDataType.width = fraAgeDataType.width + 100
            fraAgeDataType.ZOrder 0
        End If
    #End If
    If mclsAgeWizard.DataType = 2 Then    '初始化 "数据范围"
        OptDetail3.Value = True
    ElseIf mclsAgeWizard.DataType = 1 Then
        optDetail2.Value = True
    Else
        optDetail1.Value = True
    End If
    InitPeriod                  '初始化区间
    
'    PeriodRefresh               '刷新区间数据网格
    
    InitColumns                 '初始化栏目
    AdjustDataLimit
    Unload MsgForm
    Me.Show vbModal                     '调用窗体
    
    SetAge = mblnOk
    
End Function
 

'根据当前“类模块” 进行区间显示的初始化
Private Sub InitPeriod()
    Dim i As Integer
    Dim strStr As String
    
    With msgPeriod
        .ColWidth(0) = 1800
        .ColWidth(1) = 1000
        .TextMatrix(0, 0) = "   帐龄分析区间    "
        .TextMatrix(0, 1) = "天数   "
        .ColAlignment(0) = flexAlignLeftCenter
        .ColAlignment(1) = flexAlignRightCenter
    End With
    
    mintCount = mclsAgeWizard.PeriodNumber
    msgPeriod.Rows = mintCount
    
    If mintCount > 0 Then
        With msgPeriod
            For i = 1 To mintCount - 1
                
                strStr = mclsAgeWizard.PeriodName(i)
                .col = 0
                .Row = i
                .Text = IIf(IsNull(strStr), "", strStr)                             '区间名称
                .CellAlignment = flexAlignLeftCenter
                
                strStr = str(mclsAgeWizard.PeriodDay(i))
                msgPeriod.col = 1
                msgPeriod.Text = IIf(IsNull(strStr), "", strStr)                    '区间天数
                msgPeriod.CellAlignment = flexAlignRightCenter
                
            Next i
            
        End With
    End If
    
End Sub

'根据所使用的类模块进行栏目初始化
Private Sub InitColumns()
    Dim i, j As Integer
    Dim strTemp(10) As String
    Dim temp As String
    If lstChooseCols.ListCount <> 0 Then
        For i = 1 To lstChooseCols.ListCount
            lstChooseCols.RemoveItem 0
        Next i
    End If
    
    If lstSelectCols.ListCount <> 0 Then                 '清除项目选择列表
        For i = 1 To lstSelectCols.ListCount
            lstSelectCols.RemoveItem 0
        Next i
    End If
    
    If mclsAgeWizard.ColNumber <= 0 Then
        Exit Sub
    End If
    
    ReDim mstrSort(mclsAgeWizard.ColNumber)
    With mclsAgeWizard                                  '调用类模块
        For i = 0 To mclsAgeWizard.ColNumber - 1
            strTemp(0) = IIf(IsNull(.colDesc(i)), "-", .colDesc(i)) & String(20, " ")       '字段描述
            strTemp(1) = IIf(IsNull(.ColName(i)), "-", .ColName(i)) & String(20, " ")       '字段名称
            strTemp(2) = IIf(IsNull(.ColTable(i)), "-", .ColTable(i)) & String(20, " ")     '字段所在表名
            strTemp(3) = str(.ColType(i)) & String(20, " ")                                 '是标准字段或分组字段
            strTemp(4) = str(.ColWidth(i)) & String(20, " ")                                '显示宽度
            strTemp(5) = str(.ColOrderType(i)) & String(20, " ")                            '字段排序方式
            strTemp(6) = str(.ColIsFixed(i)) & String(20, " ")                              '是否固定栏目
            strTemp(7) = str(.colFieldID(i)) & String(20, " ")                              '字段视图ID
            strTemp(8) = str(.ColFieldSize(i)) & String(20, " ")                            '字段宽度
            strTemp(9) = str(.ColIsChoosed(i)) & String(20, " ")                            '是否可选栏目
            strTemp(10) = str(.IsHeadCol(i)) & String(20, " ")                            '是否可选栏目中的数据栏目
            temp = ""
            For j = 0 To 10
                temp = temp & strTemp(j)
            Next j
            
            If .ColIsChoosed(i) Or .ColIsFixed(i) Then
                lstSelectCols.AddItem temp          '已选栏目
            Else
                lstChooseCols.AddItem temp          '可选栏目
            End If
            
            If .ColType(i) = 5 Then                 '汇总字段,对应于 GROUP BY 子句
                .ColGrouped(i) = True
            End If
            
            mstrSort(i) = CInt(.ColGrouped(i)) & String(20, " ") & .ColOrderType(i) & String(20, " ") & .colDesc(i) & String(20, " ")
            
        Next i
        If lstChooseCols.ListCount > 0 Then
            lstChooseCols.ListIndex = 0
            cmdAddColumn.Enabled = True
        End If
    End With
    
End Sub
                      

Private Sub Form_Unload(Cancel As Integer)
    Erase mintDay()
    Set mclsHook = Nothing
    Set mclsFilter = Nothing
    Set mclsAgeWizard = Nothing
    UnloadResPic
End Sub



Private Sub lstChooseCols_Click()
    chkGroup.Enabled = False
    lblSort.Enabled = False
    cboSort.Enabled = False
    cmdAddColumn.Enabled = True
End Sub

'双击鼠标添加栏目
Private Sub lstChooseCols_DblClick()
    cmdAddColumn_Click
End Sub

'检查栏目排序条件
Private Sub lstSelectCols_Click()
    Dim strTemp As String
    Dim i, intIndex As Integer
    With lstSelectCols
        strTemp = GetNoXString(.list(.ListIndex), 1, String(20, " "))
        If .ListIndex = 0 Then
            cmdSerial(0).Enabled = False
        Else
            cmdSerial(0).Enabled = True
        End If
        
        If .ListIndex = .ListCount - 1 Then
            cmdSerial(1).Enabled = False
        Else
            cmdSerial(1).Enabled = True
        End If
    End With
    
    intIndex = GetColIndex(strTemp)
    If lstSelectCols.ListIndex >= 0 Then
        If InStr(lstSelectCols.Text, "金额") = 0 And InStr(lstSelectCols.Text, "天数") = 0 Then
            lblSort.Enabled = True
            cboSort.Enabled = True
        Else
            lblSort.Enabled = False
            cboSort.Enabled = False
        End If
        chkGroup.Enabled = True
        cmdDelColumn.Enabled = True
    End If
    If Trim(GetNoXString(mstrSort(intIndex), 1, String(20, " "))) <> "0" Then   '分组
        chkGroup.Value = 1
    Else
        chkGroup.Value = 0
    End If
    
    i = CInt(GetNoXString(mstrSort(intIndex), 2, String(20, " ")))           '排序
    
    cboSort.Text = cboSort.list(i)

End Sub


'从 mstrSort 中寻找字段描述相符的记录号
Private Function GetColIndex(ByVal strStr1 As String) As Integer
    Dim i As Integer
    For i = 0 To mclsAgeWizard.ColNumber - 1
        If InStr(1, mstrSort(i), strStr1) > 0 Then
            Exit For
        End If
    Next i
    GetColIndex = i
End Function

'双击鼠标删除栏目
Private Sub lstSelectCols_DblClick()
    cmdDelColumn_Click
End Sub


Private Sub lstSelectCols_GotFocus()
    lstSelectCols_Click
End Sub


'检查区间允许修改条件
Private Sub msgPeriod_Click()
    
    txtInput.Visible = False
    mintPeriodCol = msgPeriod.ColSel
    mintPeriodRow = msgPeriod.RowSel
    msgPeriod.SetFocus
    mblnEnterClick = False
End Sub

'启动区间修改
Private Sub msgPeriod_DblClick()
    Dim intRowLoc As Integer
    mblnEnterClick = False
    If ((msgPeriod.ColSel <> 0) And (msgPeriod.RowSel <> 0)) Then
        
        With msgPeriod
            .Row = .RowSel
            .col = 1
            txtInput.Left = fraAgePeriod.Left + .CellLeft + .Left + 50 ' + 1900
            
            txtInput.top = fraAgePeriod.top + .CellTop + .top '+ .RowSel * .CellHeight + 100
            
            txtInput.Height = .CellHeight - 100
            txtInput.Visible = True
            txtInput.Text = Trim(.TextMatrix(.RowSel, .ColSel))
            txtInput.SetFocus
            txtInput.SelStart = 0
            txtInput.SelLength = Len(txtInput.Text)
        End With
        
    Else
        MsgBox "此处数据不可修改"
    End If
    
    mintPeriodCol = msgPeriod.ColSel
    mintPeriodRow = msgPeriod.RowSel
End Sub

Private Sub msgPeriod_GotFocus()
    Dim Index As Long
    For Index = msgPeriod.Rows - 1 To 1 Step -1
        If msgPeriod.TextMatrix(Index, 1) = "" Then
            msgPeriod.RowSel = Index
            cmdPeriodDelete_Click
            mblnPeriodInsert = False
        End If
    Next
    cmdPeriodInsert.Enabled = True
    Label2.Caption = "Enter :编辑区间天数" & Chr(13) & "Insert:在选定行上面添加一行" & Chr(13) & "Delete:删除选定行"
    msgPeriod.col = 1
    msgPeriod.ColSel = 1
    If msgPeriod.Rows > 1 Then
        cmdPeriodDelete.Enabled = True
        If msgPeriod.RowSel < 1 Then
            msgPeriod.Row = 1
            msgPeriod.RowSel = 1
        End If
    Else
        cmdPeriodDelete.Enabled = False
        msgPeriod.Row = 0
        msgPeriod.RowSel = 0
    End If
    mintPeriodRow = msgPeriod.RowSel
    mintPeriodCol = 1
 

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -