frmtablereport.frm

金算盘软件代码

    blnIsOK = frmFormat.SetFormat(mclsTable)
    If blnIsOK Then RefreshData
End Sub

Private Sub cmdSave_Click()
 Dim mblnIsOk As Boolean
    GetColWidth
    mblnIsOk = mclsTable.SaveTable
    If mblnIsOk Then
        mclsFormCond.KeyID = mclsTable.ReportID
        mclsFormCond.UpdateCond
        Caption = "列表查询" & " - " & mclsTable.ReportName
        LblTitle.Caption = mclsTable.ReportName
        LblTitle.Left = (msgAccount.Width - LblTitle.Width) \ 2
    End If
End Sub

Private Sub Form_Activate()
    CallReportPopMenu
End Sub

Private Sub Form_Load()
   mblnHaveHead = True
'   CallReportPopMenu
End Sub

Private Sub cmdHide_Click()
    mblnHaveHead = Not mblnHaveHead
    If mblnHaveHead Then
        cmdHide.Caption = "隐藏标题(&H)"
    Else
        cmdHide.Caption = "显示标题(&I)"
    End If
    Form_Resize
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Set mclsTable = Nothing
    Set mclsFormCond = Nothing
    gclsSys.MainControls.Remove Me
End Sub

Private Sub Form_Resize()
   msgAccount.Redraw = False
  
   If Me.WindowState = vbMinimized Then
       Exit Sub
   End If
   If Me.Width < lngFormWidth Then
       Me.Width = lngFormWidth
   End If

   If Me.Height < lngFormHeight Then
       Me.Height = lngFormHeight
   End If
   
   picAccount.Height = Me.Height - 1000
   picAccount.Width = Me.Width - 220
   LblShadow.Height = picAccount.Height
   LblShadow.Width = picAccount.Width
   msgAccount.Width = picAccount.Width - 450
 
   If mblnHaveHead Then
       msgAccount.top = lngAccountTop
       msgAccount.Height = Me.Height - 1600
       LblTitle.Visible = True
   Else
       msgAccount.top = lngAccountTop - 250
       msgAccount.Height = Me.Height - 1650 + 250
       LblTitle.Visible = False
   End If
   LblTitle.Left = (msgAccount.Width - LblTitle.Width) \ 2
   msgAccount.Redraw = True
End Sub


'重新得到列宽
Private Sub GetColWidth()
  Dim intCol  As Integer
    For intCol = 0 To msgAccount.Cols - 1
         mclsTable.ColumnWidth(intCol) = msgAccount.ColWidth(intCol)
    Next intCol
End Sub
'重新设置列宽
Private Sub ReSetColWidth()
  Dim intCol  As Integer
    For intCol = 0 To msgAccount.Cols - 1
         msgAccount.ColWidth(intCol) = mclsTable.ColumnWidth(intCol)
         msgAccount.FixedAlignment(intCol) = 4
    Next intCol
End Sub

'处理数据格式
 Private Sub DealFormat()
'   Dim intRow As Integer
'   Dim intCol As Integer
'   Dim intVisibleRow As Integer
'   Dim intEndRow As Integer
'
'   intVisibleRow = GetVisibleRow
'   With msgAccount
'        If .TopRow + intVisibleRow > .Rows - 1 Then
'          intEndRow = .Rows - 1
'        Else
'          intEndRow = .TopRow + intVisibleRow
'        End If
'   If mintMastDealRow <= intEndRow Then
'       .Redraw = False
'   For intRow = mintMastDealRow To intEndRow
'     For intCol = 0 To .Cols - 1
'      Select Case mclsTable.ColumnFieldType(intCol)
'      Case "Byte", "Integer", "Single", "Double", "Decimal", "Long", "Currency "
'     '数据格式的处理：是否除以1000，是否显示小数与是否显示零
'        If IsNumeric(.TextMatrix(intRow, intCol)) Or .TextMatrix(intRow, intCol) = "" Then
'            If mclsTable.Divide Then
'              .TextMatrix(intRow, intCol) = CStr(Val(.TextMatrix(intRow, intCol)) / 1000)
'            Else
'            End If
'            If mclsTable.ShowCent Then
'              .TextMatrix(intRow, intCol) = CStr(Format(.TextMatrix(intRow, intCol), "Standard"))
'            Else
'              .TextMatrix(intRow, intCol) = CStr(Format(.TextMatrix(intRow, intCol), "#,###,###,###"))
'            End If
'            If mclsTable.ShowZero = False Then
'              If Val(.TextMatrix(intRow, intCol)) = 0 Then .TextMatrix(intRow, intCol) = ""
'            Else
'              If Val(.TextMatrix(intRow, intCol)) = 0 Then .TextMatrix(intRow, intCol) = "0"
'            End If
'        End If
'
'        '对负数的处理
'         If Val(.TextMatrix(intRow, intCol)) < 0 Then
'          Select Case mclsTable.ShowNegivate
'          Case 0
'          Case 1
'            .Row = intRow
'            .col = intCol
'            .CellForeColor = vbRed
'          Case 2
'            .TextMatrix(intRow, intCol) = "(" & .TextMatrix(intRow, intCol) & ")"
'          Case 3
'            .TextMatrix(intRow, intCol) = "(-)" & Right(.TextMatrix(intRow, intCol), Len(.TextMatrix(intRow, intCol)) - 1)
'          End Select
'        End If    '对负数的处理
'
'       End Select      '对特殊列不处理
'       Next intCol
'  Next intRow
'     mintMastDealRow = intRow
'    .Redraw = True
'  End If
'  End With
End Sub

Private Function GetVisibleRow()
  Dim intRow As Integer
  If msgAccount.Rows = 1 Then Exit Function
   With msgAccount
        intRow = .TopRow
        Do While .RowIsVisible(intRow)
           GetVisibleRow = GetVisibleRow + 1
           intRow = intRow + 1
           If intRow > .Rows - 1 Then
              Exit Do
           End If
        Loop
   End With
End Function


Private Sub msgAccount_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
         PopupMenu frmMain.mnuListEdit, , msgAccount.Left + x, msgAccount.top + y
    Else
    End If
End Sub

Private Sub msgAccount_Scroll()
    DealFormat
End Sub
Private Sub CallReportPopMenu(Optional EditObject As String = " ")
  Dim intCount As Integer

    With frmMain
        For intCount = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCount)
        Next
        For intCount = 1 To 5
           Load .mnuListEditMenu(intCount)
        Next intCount
        
        .mnuListEditMenu(0).Caption = "报表设置" & EditObject & "(&S)"
        .mnuListEditMenu(0).Enabled = True
        .mnuListEditMenu(0).Visible = True
        
        .mnuListEditMenu(1).Caption = "显示格式" & EditObject & "(&F)"
        .mnuListEditMenu(1).Enabled = True
        .mnuListEditMenu(1).Visible = True
        
        If mblnHaveHead Then
        .mnuListEditMenu(2).Caption = "隐藏标题" & EditObject & "(&H)"
        Else
        .mnuListEditMenu(2).Caption = "显示标题" & EditObject & "(&I)"
        End If
        .mnuListEditMenu(2).Enabled = True
        .mnuListEditMenu(2).Visible = True
        
        .mnuListEditMenu(3).Checked = False
        .mnuListEditMenu(3).Enabled = True
        .mnuListEditMenu(3).Caption = "-"
        .mnuListEditMenu(3).Enabled = True
        .mnuListEditMenu(3).Visible = True
        
        .mnuListEditMenu(4).Caption = "报表保存" & EditObject & "(&M)"
        .mnuListEditMenu(4).Enabled = True
        .mnuListEditMenu(4).Visible = True
        
        .mnuListEditMenu(5).Caption = "打印" & Space(4) & EditObject & "(&P)"
        .mnuListEditMenu(5).Enabled = True
        .mnuListEditMenu(5).Visible = True
              
   End With
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
   Select Case intIndex
   Case 0
        cmdAccSet_Click
   Case 1
        cmdFormatSet_Click
   Case 2
        cmdHide_Click
   Case 4
        cmdSave_Click
   Case 5
        
   End Select
End Sub