frmtablebook.frm

金算盘软件代码

    End If
    mlngRowExpands = intRecCount \ (mintPageRows - msgAccount.FixedRows) + 1
    
    mlngPages = mlngRowExpands * mlngColExpands
    ReDim mlngColStart(mlngPages - 1)
    ReDim mlngColEnd(mlngPages - 1)
    ReDim mlngRowStart(mlngPages - 1)
    ReDim mlngRowEnd(mlngPages - 1)
    For intRow = 0 To mlngRowExpands - 2
        For intCol = 0 To mlngColExpands - 1
            mlngColStart(intRow * mlngColExpands + intCol) = intColStart(intCol)
            mlngColEnd(intRow * mlngColExpands + intCol) = intColEnd(intCol)
            mlngRowStart(intRow * mlngColExpands + intCol) = intRow * (mintPageRows - msgAccount.FixedRows) + 1
            mlngRowEnd(intRow * mlngColExpands + intCol) = (intRow + 1) * (mintPageRows - msgAccount.FixedRows)
        Next intCol
    Next intRow
    '有最后一行记录的页
    For intCol = 0 To mlngColExpands - 1
            mlngColStart(intRow * mlngColExpands + intCol) = intColStart(intCol)
            mlngColEnd(intRow * mlngColExpands + intCol) = intColEnd(intCol)
            mlngRowStart(intRow * mlngColExpands + intCol) = intRow * (mintPageRows - msgAccount.FixedRows) + 1
            mlngRowEnd(intRow * mlngColExpands + intCol) = intRecCount
    Next intCol
    DispartPage = True
    '''''''''''
    'Added by Hebing!!!!!
    '
    ''''''''''''''''
'    mlngCurPage = 1
    CheckPages mlngPages
    SetPageContents VSpage.Value, mlngPages
    SetCurContents mlngCurPage
    
End Function
'填充数据
Private Sub SetData()
  Dim intRow As Integer, intCol As Integer
  Dim intCount As Integer
  Dim blnIsData As Boolean
    ABook.NewPage                                                 '清除记录
    If mlngCurPage > mlngPages Then mlngCurPage = mlngPages
    
    '''''''''Added by Heing         !!!!
     SetCurContents mlngCurPage
    
    
    setMaxCol mlngColEnd(mlngCurPage - 1) - mlngColStart(mlngCurPage - 1) + 1
    SetDefColWidth 1110 / Screen.TwipsPerPixelX
    
    '设置表头区
    Caption = mclsTable.ReportName            '窗体标题
    
    SetFixRow 1
    '设置栏目标题 (包括列宽)
    intCol = 0
    With msgAccount
    '第一行是栏目名称
    SetRowInfo 0, GetDefRowheight * 1.1
    For intCount = mlngColStart(mlngCurPage - 1) To mlngColEnd(mlngCurPage - 1)
        Select Case UCase(mclsTable.ColumnFieldType(intCount))
        Case "BYTE", "INTEGER", "SINGLE", "DOUBLE", "DECIMAL", "LONG", "CURRENCY "
            blnIsData = True
        Case Else
            blnIsData = False
        End Select
        SetColumnInfo intCol, .ColWidth(intCount) / Screen.TwipsPerPixelX, blnIsData
        SetCell intCol, intRow, .TextMatrix(0, intCount), 4, vbRed, True
        intCol = intCol + 1
    Next intCount
    '设置数据区
    
        For intRow = 1 To mlngRowEnd(mlngCurPage - 1) - mlngRowStart(mlngCurPage - 1) + 1
            intCol = 0
            For intCount = mlngColStart(mlngCurPage - 1) To mlngColEnd(mlngCurPage - 1)
                Select Case UCase(mclsTable.ColumnFieldType(intCount))
                Case "BYTE", "INTEGER", "SINGLE", "DOUBLE", "DECIMAL", "LONG", "CURRENCY "
                    SetCell intCol, intRow, .TextMatrix(intRow + mlngRowStart(mlngCurPage - 1) - 1, intCount), 8
                Case Else
                    SetCell intCol, intRow, .TextMatrix(intRow + mlngRowStart(mlngCurPage - 1) - 1, intCount), 2
                End Select
                intCol = intCol + 1
            Next intCount
        Next intRow
    End With
    SetGridTitle mclsTable.ReportName                     '报表标题
    AddHeadTail                                           '加表头表尾
    Dim strTemp As String
    For intCount = 0 To 5
        strTemp = strReplace(mstrHF(intCount), "&[页码]", str(mlngCurPage))
        strTemp = strReplace(strTemp, "&[总页数]", str(mlngPages))
        ABook.PageHF(intCount) = strTemp
    Next
    ABook.Refresh
End Sub

'设置GRID标题
Private Sub SetGridTitle(str As String)
    With mclsTable
        If .TitleHeight = 0 Then
            .TitleAlign = 4
            .TitleHeight = 22 * Screen.TwipsPerPixelX
        End If
        If .TitleWidth = 0 Then .TitleWidth = strLen(str) * 11 * Screen.TwipsPerPixelX + 180
        SetFreeCell 0, "", str, .TitleLeft / Screen.TwipsPerPixelX, .TitleTop / Screen.TwipsPerPixelY, _
                .TitleWidth / Screen.TwipsPerPixelX, .TitleHeight / Screen.TwipsPerPixelY, , True, .TitleAlign
    End With
End Sub
'加表头表尾
Private Sub AddHeadTail()
Dim intCount As Integer, intIndex As Integer
Dim lngTailTop As Long
Dim strName As String, strTitle As String
    With mclsTable
    '设置表头表尾
    intIndex = 1
    For intCount = 0 To .HeadColumns - 1
        Select Case .HeadFuncIndex(intCount)
        Case 0
            strName = .HeadDesc(intCount)
            strTitle = ""
        Case 1
            strName = mstrDateData
            strTitle = .HeadDesc(intCount) & ":"
        Case 5
            strName = mlngCurPage
            strTitle = .HeadDesc(intCount) & ":"
        Case Else
            strName = ReportFunc(.HeadFuncIndex(intCount))
            strTitle = .HeadDesc(intCount) & ":"
        End Select
        SetFreeCell intIndex, strTitle, strName, _
                    IIf(.HeadLeft(intCount) <> -1, .HeadLeft(intCount) / Screen.TwipsPerPixelX, intCount * 200 + 20), _
                    IIf(.HeadTop(intCount) <> -1, .HeadTop(intCount) / Screen.TwipsPerPixelX, GetGridTop - 30 - intIndex \ 3 * 18), _
                    IIf(.HeadWidth(intCount) <> -1, .HeadWidth(intCount) / Screen.TwipsPerPixelY, 150), _
                    IIf(.HeadHeight(intCount) <> -1, .HeadHeight(intCount) / Screen.TwipsPerPixelY, 15), , , _
                    .HeadAlign(intCount), True
        intIndex = intIndex + 1
    Next intCount
    ABook.GridBottom = clsFset.GPaperBorder(1) + 60
    For intCount = 0 To .TailColumns - 1
        Select Case .TailFuncIndex(intCount)
        Case 0
            strName = .TailDesc(intCount)
            strTitle = ""
        Case 1
            strName = mstrDateData
            strTitle = .TailDesc(intCount) & ":"
        Case 5
            strName = mlngCurPage
            strTitle = .TailDesc(intCount) & ":"
        Case Else
            strName = ReportFunc(.TailFuncIndex(intCount))
            strTitle = .TailDesc(intCount) & ":"
        End Select
        SetFreeCell intIndex, strTitle, strName, _
                    IIf(.TailLeft(intCount) <> -1, .TailLeft(intCount) / Screen.TwipsPerPixelX, intCount * 200 + 20), _
                    IIf(.TailTop(intCount) <> -1, .TailTop(intCount) / Screen.TwipsPerPixelX, GetGridheight + GetGridTop + 1), _
                    IIf(.TailWidth(intCount) <> -1, .TailWidth(intCount) / Screen.TwipsPerPixelY, 150), _
                    IIf(.TailHeight(intCount) <> -1, .TailHeight(intCount) / Screen.TwipsPerPixelY, 15), , , _
                    .TailAlign(intCount), False
        intIndex = intIndex + 1
    Next intCount
    End With
End Sub

'取日期数据
Private Sub GetDateStr()
Dim strTemp As String, strName As String
Dim strDate As String
    strTemp = GetNoXString(mstrDateCond, 7, "|")
    strName = StringOut(strTemp, ",")
    strDate = StringOut(strTemp, ",")
    If Trim(strTemp) <> "" Then
        strDate = StringOut(strTemp, ",")
        If strDate = "" Then
            mstrDateWhere = ""
            mstrDateData = "帐套启用日至今"
'            mstrDateData = Format(gclsBase.BaseDate, "YYYY-MM-DD") & "至" & Format(Date, "YYYY-MM-DD")
        Else
            mstrDateData = Format(strDate, "YYYY-MM-DD") & "--" & Format(strTemp, "YYYY-MM-DD")
            mstrDateWhere = strName & ">=#" & Format(strDate, "YYYY-MM-DD") & "# And " & strName & "<=#" & Format(strTemp, "YYYY-MM-DD") & "#"
        End If
    Else
        If strDate = "" Then
            mstrDateWhere = ""
            mstrDateData = "帐套启用日至今"
'            mstrDateData = Format(gclsBase.BaseDate, "YYYY-MM-DD") & "至" & Format(Date, "YYYY-MM-DD")
        Else
            mstrDateWhere = strName & "=#" & Format(strDate, "YYYY-MM-DD") & "#"
            mstrDateData = Format(strDate, "YYYY-MM-DD")
        End If
    End If
End Sub

'重新设置列宽
Private Sub ReSetColWidth()
  Dim intCol  As Integer
    For intCol = 0 To msgAccount.Cols - 1
         msgAccount.ColWidth(intCol) = IIf(mclsTable.ColumnWidth(intCol) = 0, Len(mclsTable.ColumnDesc(intCol)) * TextWidth("A") * 2.2, mclsTable.ColumnWidth(intCol))
    Next intCol
End Sub

Private Sub lblPage_Click(Index As Integer)
    mlngCurPage = Index + 1
    SetData
End Sub



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'底层接口       Author:    Hebing    1998.7
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Unload(Cancel As Integer)
Dim intType As Integer
   If mblnChanged Then
        intType = Utility.ShowMsg(Me.hwnd, "报表已改变,是否保存?", vbYesNo + vbQuestion, App.title)
        If intType = 6 Then
            cmdSave_Click
        End If
   End If
   Set mclsTable = Nothing
   If mblnLoaded Then gclsSys.MainControls.Remove Me
   Set mclsFormCond = Nothing
   Set ABook = Nothing
   Set clsFset = Nothing
End Sub

Private Sub CmdPaper_Click()
    Dim nWidth As Long
    Dim nHeight As Long
    Dim frm As FrmSetPaper
    Set frm = New FrmSetPaper
    nWidth = PicPaper.ScaleWidth / (56.7 * GetZoomRate(ZoomIndex))
    nHeight = PicPaper.ScaleHeight / (56.7 * GetZoomRate(ZoomIndex))
    frm.ShowFrmSetPaper nWidth, nHeight, mclsTable.ReportID
    Set frm = Nothing
    PaperWidth = nWidth * 56.7
    PaperHeight = nHeight * 56.7
    PicPaper.Width = nWidth * 56.7 * GetZoomRate(ZoomIndex)
    PicPaper.Height = nHeight * 56.7 * GetZoomRate(ZoomIndex)
    CmdPaper.ToolTipText = "纸张大小：" & nWidth & "毫米×" & nHeight & "毫米"
    mlngCurPage = 1
    VSpage.Value = 0
    DispartPage
    SetData                      '设置数据
    InitScrollbar
    
End Sub

Private Sub CmdSpliter_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    ReleaseCapture
    SetCapture Me.hwnd
    mbResizeing = True
End Sub

Private Sub CmdZoom_Click()
    InitMenu
    PopupMenu frmMain.mnuListEdit
    endmenu
End Sub

Private Sub Command1_Click()
    ABook.ZoomRate = 150
    ABook.Refresh
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If mbResizeing And Button = 1 Then
        If x < 0 Then x = 0
        If x > ScaleWidth / 2 Then
            LSpliter.Left = ScaleWidth / 2
        Else
            LSpliter.Left = x
        End If
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim tmp As Integer
    If mbResizeing Then
        mbResizeing = False
        tmp = LSpliter.Left - Picpage.Left - VSpage.Width
        If tmp > 0 Then
            Picpage.Visible = True
            VSpage.Visible = True
            HSpage.Visible = True
            Picpage.Width = tmp
            VSpage.Left = LSpliter.Left - VSpage.Width
            HSpage.Width = tmp
        Else
            Picpage.Visible = False
            VSpage.Visible = False
            HSpage.Visible = False
            
        End If
        vsPAcount.Left = LSpliter.Left + LSpliter.Width
        CmdSpliter.Left = LSpliter.Left + LSpliter.Width
        CmdCurPage.Left = CmdSpliter.Left + CmdSpliter.Width
        CmdZoom.Left = CmdCurPage.Left + CmdCurPage.Width
        CmdPaper.Left = CmdZoom.Left + CmdZoom.Width
        HScroll.Left = CmdPaper.Left + CmdPaper.Width
        Form_Resize
        If lPage(0).Width < Picpage.Width Then
            HSpage.Enabled = False
            HSpage.Value = 0
            
        Else
            HSpage.Enabled = True
            HSpage.Max = (lPage(0).Width - Picpage.Width) / Screen.TwipsPerPixelX
            HSpage.SmallChange = 1
            HSpage.LargeChange = 5
        End If
   End If
End Sub

Private Sub grdAcntBook_Scroll()
'    ClearZero
End Sub

Private Sub HScroll_Change()
    PicPaper.Left = -Screen.TwipsPerPixelX * HScroll.Value + 90
    SetShapePos mlngCurPage
    PicPaper.SetFocus
End Sub


Private Sub HSpage_Change()
    Dim i As Integer
    Dim nleft As Long
    Dim npos As Integer
    Dim npos1 As Integer
    On Error Resume Next
    nleft = HSpage.Value * Screen.TwipsPerPixelX
    npos = (lPage(0).Width - Lcaption(0).Width) / 2
    npos1 = lPage(0).Left - Shape1.Left
    For i = 0 To mlngPages - 1
        lPage(i).Left = -nleft
        Lcaption(i).Left = lPage(i).Left + npos
    Next