frmsalarymonney.frm

金算盘软件代码

    mintPageRows = GetGridheight                                '得到最大页行数
    intRecCount = msgAccount.Rows - msgAccount.FixedRows
    If mintPageRows <= msgAccount.FixedRows Then
         Utility.ShowMsg Me.hwnd, "数据行数太小,请增加行数!", vbOKOnly + vbInformation, App.title
         DispartPage = False
         cmdFormatSet_Click
         Exit Function
    End If
    If intRecCount = 0 Then
        mlngRowExpands = 1
    ElseIf intRecCount Mod (mintPageRows - msgAccount.FixedRows) = 0 Then
         mlngRowExpands = intRecCount \ (mintPageRows - msgAccount.FixedRows)
    Else
         mlngRowExpands = intRecCount \ (mintPageRows - msgAccount.FixedRows) + 1
    End If
    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
  Dim strReportName  As String
  
    ABook.NewPage                                                 '清除记录
    If mlngCurPage > mlngPages Then mlngCurPage = mlngPages
    
    '''''''''Added by Heing         !!!!
     SetCurContents mlngCurPage
    If mlngCurPage = 0 Then
        mlngCurPage = 1
    End If
    
    setMaxCol mlngColEnd(mlngCurPage - 1) - mlngColStart(mlngCurPage - 1) + 1
    SetDefColWidth 1110 / Screen.TwipsPerPixelX
    SetGridTop 90
    strReportName = Trim(Salary.MonneyReportName)
    If strReportName = "" Then
        strReportName = "工资配款表"
    End If
    '设置表头区
    Caption = "工资配款表"                   '窗体标题
    SetFreeCell 0, "", strReportName, 0, 0, Len(strReportName) * 30, 30, 0, True, 4, True                             '报表标题
    SetFixRow 1
    '设置栏目标题 (包括列宽)
    intCol = 0
    With msgAccount
    '第一行是栏目名称
    SetRowInfo 0, GetDefRowheight * 1.1
    intRow = 0
    For intCount = mlngColStart(mlngCurPage - 1) To mlngColEnd(mlngCurPage - 1)
        Select Case .TextMatrix(0, intCount)
        Case "部门编号", "部门名称", "职员编号", "职员姓名"
            blnIsData = False
        Case Else
            blnIsData = True
        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 .TextMatrix(0, intCount)
                Case "部门编号", "部门名称", "职员编号", "职员姓名"
                    SetCell intCol, intRow, .TextMatrix(intRow + mlngRowStart(mlngCurPage - 1) - 1, intCount), 2
                Case Else
                    SetCell intCol, intRow, .TextMatrix(intRow + mlngRowStart(mlngCurPage - 1) - 1, intCount), 8
                End Select
                intCol = intCol + 1
            Next intCount
        Next intRow
    End With
    
    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

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
   gclsSys.MainControls.Remove Me
   Set mclsMainControl = 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, 1429
    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 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
    Shape1.Left = lPage(0).Left + npos1
End Sub

Private Sub Lcaption_Click(Index As Integer)
    lPage_Click Index
End Sub

Private Sub lPage_Click(Index As Integer)
    If mintCurContents <> Index + 1 + VSpage.Value Then
        mlngCurPage = Index + 1 + VSpage.Value
        SetData
    End If
    Picpage.SetFocus
End Sub

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

Private Sub mclsMainControl_ToolRefresh()
    RefreshData
End Sub


Private Sub VScroll_Change()
    PicPaper.top = -Screen.TwipsPerPixelY * VScroll.Value + 90
    SetShapePos mlngCurPage
    PicPaper.SetFocus
End Sub

Private Sub CmdCurPage_Click()
    Dim frm As FrmCurrenPage
    Set frm = New FrmCurrenPage
    Dim i As Integer
    Dim nHeight As Integer
    nHeight = lPage(0).Height + Lcaption(0).Height + 90
    i = Picpage.Height / nHeight
    If i > 10 Then i = 10
    
    mlngCurPage = frm.ShowFrmCurrenPage(mlngCurPage, mlngPages)
    
    If mlngCurPage <= VSpage.Value Then
       VSpage.Value = mlngCurPage - 1
       SetPageContents VSpage.Value, mlngPages
    ElseIf mlngCurPage > VSpage.Value + i Then
        VSpage.Value = mlngCurPage - i
       SetPageContents VSpage.Value, mlngPages
    End If
    Set frm = Nothing
    SetData                        '设置数据
End Sub

Private Sub cmdFormatSet_Click()
Dim blnOK As Boolean
    clsFset.GPaperBorder(6) = ABook.GutterLineWidth
    clsFset.GetDefaultDateFromDB 1429
    blnOK = clsFset.ShowFrmFormatSet(1, 1429, mlngCurPage, mlngPages)
    If blnOK Then
        GetDefaultSet clsFset
        RefreshData
    End If
    cmdFormatSet.SetFocus
End Sub

Private Sub Form_Load()
    Me.Hide
    Me.Left = -30000
    MsgForm.PleaseWait
    mlngCurPage = 1                                                  '设置当前页
    mintCurContents = 1
    CmdPaper.ToolTipText = "纸张大小：" & Int(PicPaper.Width / 56.7) & "毫米×" & Int(PicPaper.Height / 56.7) & "毫米"
    ZoomIndex = 3
    PaperWidth = PicPaper.Width
    PaperHeight = PicPaper.Height
    CmdZoom.ToolTipText = "当前放缩比:100%"
    mblnLoaded = True
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Dim i As Integer
    
    If Me.Width < lngFormWidth Then Me.Width = lngFormWidth
    If Me.Height < lngFormHeight Then Me.Height = lngFormHeight
    If (Me.Left + Me.Width < 0 Or Me.Left > Screen.Width) And mblnLoaded Then
        Me.Left = 300
    End If
    vsPAcount.Width = ScaleWidth - VScroll.Width - vsPAcount.Left
    vsPAcount.Height = ScaleHeight - HScroll.Height - vsPAcount.top
    CmdSpliter.top = ScaleHeight - HScroll.Height
    CmdCurPage.top = ScaleHeight - HScroll.Height
    CmdZoom.top = ScaleHeight - HScroll.Height
    CmdPaper.top = ScaleHeight - HScroll.Height
    HScroll.top = ScaleHeight - HScroll.Height
    HScroll.Width = vsPAcount.ScaleWidth - (CmdCurPage.Width - 15) * 3 - CmdSpliter.Width
    VScroll.Height = vsPAcount.ScaleHeight - 4 * (CmdPage(0).Height - 15)