📄 frmagewizard.frm
字号:
Height = 1860
ItemData = "frmAgeWizard.frx":0250
Left = 270
List = "frmAgeWizard.frx":0252
TabIndex = 40
TabStop = 0 'False
Top = 420
Width = 1905
End
Begin VB.Label lblSort
AutoSize = -1 'True
Caption = "排序(&O)"
Enabled = 0 'False
Height = 180
Left = 3270
TabIndex = 49
Top = 2820
Width = 630
End
End
Begin VB.Frame fraAgePeriodComment
Caption = "说明"
Height = 1005
Left = -73005
TabIndex = 35
Top = 2940
Width = 5880
Begin VB.Label Label2
Height = 540
Left = 840
TabIndex = 36
Top = 315
Width = 2850
End
End
Begin VB.Frame fraAgePeriod
Caption = "帐龄分析区间(&V)"
Height = 2175
Left = -73005
TabIndex = 30
Top = 630
Width = 5880
Begin MSFlexGridLib.MSFlexGrid msgPeriod
Height = 1695
Left = 270
TabIndex = 31
TabStop = 0 'False
Top = 360
Width = 3915
_ExtentX = 6906
_ExtentY = 2990
_Version = 393216
Rows = 6
BackColorFixed = -2147483639
ForeColorFixed = -2147483640
BackColorSel = -2147483627
BackColorBkg = 16777215
FocusRect = 2
GridLinesFixed = 1
End
Begin MSForms.CommandButton cmdPeriodDelete
Height = 390
Left = 4410
TabIndex = 34
TabStop = 0 'False
Top = 1380
Width = 885
Caption = "删除"
Size = "1561;688"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton cmdPeriodInsert
Height = 390
Left = 4380
TabIndex = 33
TabStop = 0 'False
Top = 660
Width = 885
Caption = "插入"
Size = "1561;688"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
End
Begin VB.Frame fraAgeNameComment
Caption = "说明"
Height = 1470
Left = -72810
TabIndex = 39
Top = 2460
Width = 5715
Begin VB.Label lblAgeNameComment
Caption = " 录入帐龄分析报表的名称"
Height = 540
Left = 525
TabIndex = 8
Top = 510
Width = 3930
End
End
Begin VB.Frame fraAgeName
Caption = "报表名称(&R)"
Height = 1605
Left = -72810
TabIndex = 6
Top = 615
Width = 5715
Begin VB.TextBox txtAgeName
Height = 315
Left = 810
TabIndex = 7
TabStop = 0 'False
Text = "未定义"
Top = 720
Width = 3945
End
End
End
End
Attribute VB_Name = "frmAgeWizard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************************
'*************** 帐龄分析查询向导窗体代码 ***********************
'作者：周成坤
'时间：1998-07-03
'
'接口：Public Function SetAge(ByVal clsWizard As Age) As Boolean
' 功 能： 设置帐龄分析的报表名称、查询条件、查询区间、显示栏目和分析方式等
' 参数说明： clsWizard: 帐龄分析类模块的实例
' 返 回： 确认则返回真，取消则返回假
'*******************************************************************************
Option Explicit
Private mclsFilter As New FormCond '查询条件类
Private WithEvents mclsHook As Hook '响应msgFilter中vbUp 和vbDown 事件
Attribute mclsHook.VB_VarHelpID = -1
'**************************************
Dim mclsAgeWizard As Age '类模块
Dim mintCount As Integer '记录数
Dim mintPeriodCol, mintPeriodRow As Integer '数据网格中的列、行号
Dim mblnOk As Boolean
Dim mintDay() As Integer '保存帐龄区间的数值
Dim mstrSort() As String '保存各栏目的分组排序方式： 排序方式 + " " + 栏目描述
Dim mblnPeriodInsert As Boolean
Dim mblnPeriodInsertFinish As Boolean
Dim mblnEnterClick As Boolean
Dim mstrOldName As String
'栏目排序方式改变
Private Sub cboSort_Changed()
Dim intIndex, i As Integer
Dim strTemp As String
strTemp = GetNoXString(lstSelectCols.list(lstSelectCols.ListIndex), 1, String(20, " "))
intIndex = GetColIndex(strTemp)
i = CInt(GetNoXString(mstrSort(intIndex), 1, String(20, " ")))
mstrSort(intIndex) = str(i) & String(20, " ") & str(cboSort.ListIndex) & String(20, " ") & strTemp & String(20, " ")
End Sub
Private Sub cboSort_Click()
cboSort_Changed
End Sub
'设置分组字段
Private Sub chkGroup_Click()
Dim intIndex As Integer
Dim i As Integer
Dim strTemp As String
strTemp = GetNoXString(lstSelectCols.list(lstSelectCols.ListIndex), 1, String(20, " "))
intIndex = GetColIndex(strTemp)
i = CInt(GetNoXString(mstrSort(intIndex), 2, String(20, " ")))
If i > 2 Or i < 0 Then i = 0
If chkGroup.Value = 1 Then
mstrSort(intIndex) = "1" & String(20, " ") & str(i) & String(20, " ") & strTemp & String(20, " ")
Else
mstrSort(intIndex) = "0" & String(20, " ") & str(i) & String(20, " ") & strTemp & String(20, " ")
End If
End Sub
'添加所有可选栏目
Private Sub cmdAddAllColumns_Click()
Dim i As Integer
Dim intCount As Integer
intCount = lstChooseCols.ListCount
If intCount > 0 Then
For i = 1 To intCount
lstSelectCols.AddItem lstChooseCols.list(i - 1)
Next i
End If
If intCount > 0 Then
For i = 1 To intCount
lstChooseCols.RemoveItem 0
Next i
End If
cmdAddAllColumns.Enabled = False
cmdAddColumn.Enabled = False
lstSelectCols.ListIndex = 0
If lstSelectCols.ListIndex < 0 Then
cmdDelColumn.Enabled = False
chkGroup.Enabled = False
cboSort.Enabled = False
lblSort.Enabled = False
Else
cmdDelColumn.Enabled = True
chkGroup.Enabled = True
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
End If
cmdDelAllColumns.Enabled = True
AdjustDataLimit
End Sub
'添加所选可选栏目
Private Sub cmdAddColumn_Click()
Dim intIndex As Integer
With lstChooseCols
If .ListCount > 0 Then
If .ListIndex >= 0 Then
lstSelectCols.AddItem .list(.ListIndex)
lstSelectCols.ListIndex = lstSelectCols.ListCount - 1
intIndex = .ListIndex
.RemoveItem (.ListIndex)
' intIndex = .ListIndex
End If
End If
If intIndex < .ListCount Then
.ListIndex = intIndex
ElseIf intIndex = .ListCount Then
If .ListCount > 0 Then
.ListIndex = .ListCount - 1
End If
End If
End With
If lstChooseCols.ListIndex < 0 Then
cmdAddColumn.Enabled = False
Else
cmdAddColumn.Enabled = True
End If
If lstChooseCols.ListCount <= 0 Then
cmdAddAllColumns.Enabled = False
Else
cmdAddAllColumns.Enabled = True
End If
cmdDelAllColumns.Enabled = True
If lstSelectCols.ListIndex >= 0 Then
cmdDelColumn.Enabled = True
chkGroup.Enabled = True
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
Else
cmdDelColumn.Enabled = False
chkGroup.Enabled = False
cboSort.Enabled = False
lblSort.Enabled = False
End If
AdjustDataLimit
End Sub
'退出查询向导
Private Sub cmdAgeCancel_Click()
mclsFilter.ResumeSelectd
Unload Me
End Sub
'向导完成
Private Sub cmdAgeFinish_Click()
Dim strStr1 As String
Dim i As Integer
Dim blnHaveSumColumn As Boolean
Dim strMsg, strTitle As String
mclsAgeWizard.AgeName = Trim(txtAgeName.Text) '向导名称
If mclsAgeWizard.AgeName = "" Then
strMsg = "报表名称不允许为空，请重新设置报表名称。"
strTitle = "错误操作：参数不足"
ShowMsg Me.hWnd, strMsg, vbOKOnly + vbCritical, strTitle
tabQueryWizard.Tab = 0
txtAgeName.SetFocus
txtAgeName.SelStart = 0
txtAgeName.SelLength = Len(txtAgeName.Text)
Exit Sub
End If
If StrLen(mclsAgeWizard.AgeName) > 40 Then
strMsg = "报表名称太长，请重新设置报表名称。"
strTitle = "错误操作"
ShowMsg Me.hWnd, strMsg, vbOKOnly + vbCritical, strTitle
tabQueryWizard.Tab = 0
txtAgeName.SetFocus
txtAgeName.SelStart = 0
txtAgeName.SelLength = Len(txtAgeName.Text)
Exit Sub
End If
' If (mclsAgeWizard.IsNewWizard) Or (mclsAgeWizard.AgeName <> mstrOldName) Then
' strStr1 = "SELECT * FROM Report WHERE strReportName = '" & mclsAgeWizard.AgeName _
' & "' AND bytGroup = " & mclsAgeWizard.GroupNo & " AND lngReportID<>" & mclsAgeWizard.AgeReportID & " And BytControl = " & IIf(gclsBase.ControlAccount, 1, 2) '.ParentId
' Set rstTemp = gclsBase.BaseDB.OpenRecordset(strStr1, dbOpenDynaset)
' If rstTemp.RecordCount > 0 Then
' strMsg = "数据库中已有同名报表，请重新设置报表名称"
' strTitle = "错误操作"
' ShowMsg Me.hwnd, strMsg, vbOKOnly + vbCritical, strTitle
' tabQueryWizard.Tab = 0
' txtAgeName.SetFocus
' txtAgeName.SelStart = 0
' txtAgeName.SelLength = Len(txtAgeName.Text)
' Exit Sub
' End If
' End If
If lstSelectCols.ListCount <= 0 Then
strMsg = "必须有至少一个已选栏目，请进行栏目设置。"
strTitle = "错误操作：参数不足"
ShowMsg Me.hWnd, strMsg, vbOKOnly + vbCritical, strTitle
tabQueryWizard.Tab = 3
lstChooseCols.SetFocus
lstChooseCols.ListIndex = 0
Exit Sub
End If
SetColumns '修改栏目
If msgPeriod.Rows = 1 Then
strMsg = "必须有至少一个帐龄分析区间，请设置帐龄分析区间。"
strTitle = "错误操作：参数不足"
ShowMsg Me.hWnd, strMsg, vbOKOnly + vbCritical, strTitle
tabQueryWizard.Tab = 2
msgPeriod.SetFocus
Exit Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -