frmreport.frm

中小型图书会员制租赁管理系统,采用ACCESS数据库。

'--------------------------------------------
If MsgBox("请插入 8 1/2"" by 13"" 纸张。 ", vbOKCancel, "插入纸张。") = vbCancel Then
       FlexMovie.SetFocus
       Exit Sub
End If
'--------------------------------------------
MousePointer = vbHourglass
Printer.Font = "Sans Serif"
    Printer.PaperSize = vbPRPSLegal ' 8.5 by 14 inc
    Printer.FontSize = 12
    Printer.Orientation = 1 'Portrait
    
Dim LeftMargin, PageCount, BlankLines As Integer
Dim loop1, loop2, Lines, Flag As Long
LeftMargin = 10

Lines = FlexMovie.Rows - 1
If Lines Mod 55 = 0 Then
   PageCount = Lines / 55
Else
   PageCount = Int(Lines / 55) + 1
End If
'START - HEADING
Printer.Print ""
Printer.Print ""
Printer.Print ""
Printer.Print Tab(LeftMargin); "MOVIE STATISTICS FROM " & UCase(Format(DTPickerStart.Value, "mmm. dd, yyyy")) & " TO " & UCase(Format(DTPickerEnd, "mmm. dd, yyyy"))
Printer.Print ""
Printer.Print Tab(LeftMargin); "No."; Tab(LeftMargin + 9); "标题"; Tab(LeftMargin + 45); "FREQUENCY"
Printer.Print Tab(LeftMargin); "======"; Tab(LeftMargin + 9); "=========================="; Tab(LeftMargin + 45); "=========="

'END - HEADING
For loop1 = 1 To PageCount
  For loop2 = 1 To 55
    Flag = Flag + 1
    Printer.Print Tab(LeftMargin); FlexMovie.TextMatrix(Flag, 0); Tab(LeftMargin + 9); FlexMovie.TextMatrix(Flag, 1); Tab(LeftMargin + 45); FlexMovie.TextMatrix(Flag, 2)
    If Flag = Lines Then
       If Lines Mod 55 > 0 Then
            For BlankLines = (Lines Mod 55) To 55
               Printer.Print ""
            Next BlankLines
       End If
       Exit For
    End If
  Next loop2

' START - FOOTER
Printer.Print ""
Printer.Print Tab(106 - Len("Page " & str(loop1) & " of " & str(PageCount))); "Page " & str(loop1) & " of " & str(PageCount)
' END - FOOTER
Next loop1
Printer.EndDoc
FlexMovie.SetFocus
MousePointer = vbDefault
End Sub
Private Sub cmdPrintSales_Click()
If Trim(FlexSales.TextMatrix(1, 0)) = "" Then
   FlexSales.SetFocus
   Exit Sub
End If
If MsgBox("请插入 8 1/2"" by 13""  paper. ", vbOKCancel, "插入纸张 ") = vbCancel Then
       FlexSales.SetFocus
       Exit Sub
End If
MousePointer = vbHourglass
  Dim c1, BlankLines, LoopBlankLines, AmntPos, PageCount, PrintedPageCount As Integer
  Dim loop1, loopPrintPage, Flag As Long
    c1 = 8
    Printer.Font = "Sans Serif"
    Printer.PaperSize = vbPRPSLegal ' 8.5 by 14 inc
    Printer.FontSize = 9
    Printer.Orientation = 2 'LandScape
    
    'Count No. of Pages
    If (FlexSales.Rows - 1) Mod 35 = 0 Then
        PageCount = (FlexSales.Rows - 1) / 35
    Else
        PageCount = Int((FlexSales.Rows - 1) / 35) + 1
    End If
    PrintedPageCount = 0
 '''''''''''''''' START PRINTING
 For loopPrintPage = 1 To PageCount
    'START Report Header
    Printer.Print ""
    Printer.Print ""
    Printer.Print ""
    Printer.Print Tab(c1); "Rental Sales Report - " & Format(Now, "mm/dd/yyyy hh:mm:ss AM/PM")
    Printer.Print Tab(c1); "Rental Period : " & Format(DTSalesStart.Value, "mm/dd/yyyy") & " to " & Format(DTSalesEnd.Value, "mm/dd/yyyy") & "  " & "TOTAL SALES   P " & Trim(txtTotalSales.Text)
    Printer.Print ""
    Printer.Print Tab(c1); "Item No."; Tab(c1 + 16); "Invoice No. "; Tab(c1 + 36); "Date" _
                  ; Tab(c1 + 55); "Cashier"; Tab(c1 + 96); "Borrower's Name" _
                  ; Tab(c1 + 141); "Item Code"; Tab(c1 + 167); "标题"; Tab(c1 + 216); "Amount"
    Printer.Print Tab(c1); "======="; Tab(c1 + 16); "========="; Tab(c1 + 36); "========" _
                  ; Tab(c1 + 55); "===================="; Tab(c1 + 96); "======================" _
                  ; Tab(c1 + 141); "============"; Tab(c1 + 167); "========================"; Tab(c1 + 216); "======"
    ' END REPORT HEADER
    
    ' START DETAILED SECTION
    
    For loop1 = 1 To 35
        Flag = Flag + 1
        AmntPos = (c1 + 224) - Len(FlexSales.TextMatrix(Flag, 7))
        Printer.Print Tab(c1); FlexSales.TextMatrix(Flag, 0); Tab(c1 + 16); FlexSales.TextMatrix(Flag, 1); Tab(c1 + 36); Format(FlexSales.TextMatrix(Flag, 2), "mm/dd/yyyy") _
                  ; Tab(c1 + 55); FlexSales.TextMatrix(Flag, 3); Tab(c1 + 96); FlexSales.TextMatrix(Flag, 4) _
                  ; Tab(c1 + 141); FlexSales.TextMatrix(Flag, 5); Tab(c1 + 167); FlexSales.TextMatrix(loop1, 6); Tab(AmntPos); FlexSales.TextMatrix(Flag, 7)
        If Flag = FlexSales.Rows - 1 Then
            Printer.Print Tab(c1 + 211); "--------------------"
            AmntPos = (c1 + 213) - Len("TOTAL SALES   " & Trim(txtTotalSales.Text))
            Printer.Print Tab(AmntPos); "TOTAL SALES   " & Trim(txtTotalSales.Text)
            If Flag Mod 35 <> 0 Then
               BlankLines = 35 - Flag Mod 35
               For LoopBlankLines = 1 To BlankLines
                   Printer.Print "" 'Print Blank line
               Next
            End If
            Exit For
        End If
    Next loop1
    ' END DETAILED SECTION
    
    ' START FOOTER
    PrintedPageCount = PrintedPageCount + 1
    If Flag < FlexSales.Rows - 1 Then Printer.Print ""
    If Flag < FlexSales.Rows - 1 Then Printer.Print ""
    Printer.Print ""
    Printer.Print Tab(c1 + 211); "Page " & str(PrintedPageCount) & " of " & str(PageCount)
    ' END FOOTER
    Printer.NewPage
Next loopPrintPage
    Printer.EndDoc
'''''''''''''''' END PRINTING
FlexSales.SetFocus
MousePointer = vbDefault
End Sub
Private Sub cmdRefresh_Click()
If Check1.Value = 1 Then
frameListofItemsToBeReturnedToday.Caption = "失损项目统计列表"
Else
frameListofItemsToBeReturnedToday.Caption = "今日到期返还项目列表"
End If
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Call InitializeFlexItemsToBeReturnedToday
MousePointer = vbHourglass
Call vr_engine.Report_LoadItemsToBeReturnedToday(FlexListOfItemsToBEReturnedToday, Check1.Value)
MousePointer = vbDefault
End Sub
Private Sub cmdTransferToExcel_Click()
If Trim(FlexMovie.TextMatrix(1, 0) = "") Then
   FlexMovie.SetFocus
   Exit Sub
End If
MousePointer = vbHourglass
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Call vr_engine.CopyFlexDataToExcel(FlexMovie)
MousePointer = vbDefault
FlexMovie.SetFocus
End Sub
Private Sub FlexSales_TotalSales()
Dim Total As Double
Dim loop1 As Long
Total = 0
For loop1 = 1 To FlexSales.Rows - 1
    Total = Total + Val(FlexSales.TextMatrix(loop1, 7))
Next loop1
txtTotalSales.Text = Total
End Sub
Private Sub DTSalesEnd_Change()
lblFlexSalesCaption.Caption = "从: " & Format(DTSalesStart.Value, "mmmm dd, yyyy") & " 到 " & Format(DTSalesEnd.Value, "mmmm dd, yyyy")
End Sub
Private Sub DTSalesStart_Change()
lblFlexSalesCaption.Caption = "从: " & Format(DTSalesStart.Value, "mmmm dd, yyyy") & " 到 " & Format(DTSalesEnd.Value, "mmmm dd, yyyy")
End Sub
Private Sub Form_Activate()
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
If FlexSales.Visible = True Then
   MousePointer = vbHourglass
   Call InitializeFlexSalesDetiled
   Call vr_engine.REPORT_GETMOVIESTAT_FillCBOcashier(cboCashier)
   Call vr_engine.REPORT_GETMOVIESTAT_FillCBO租阅者(Cbo租阅者)
   MousePointer = vbDefault
End If
End Sub
Private Sub OptAscending_Click()
If FlexMovie.Rows > 1 Then
  If Trim(FlexMovie.TextMatrix(1, 0)) <> "" Then Call cmdGenerateStat_Click
End If
End Sub
Private Sub optDescending_Click()
If FlexMovie.Rows > 1 Then
  If Trim(FlexMovie.TextMatrix(1, 0)) <> "" Then Call cmdGenerateStat_Click
End If
End Sub
Private Sub TabStrip1_Click()
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
'-------------------------------------------------
If TabStrip1.SelectedItem.Caption = "租赁销售记录" Then
    frmMovieStatistics.Visible = False
    frameListofItemsToBeReturnedToday.Visible = False
    frmIncome.Visible = True
    FlexSales.SetFocus
End If
'-------------------------------------------------
If TabStrip1.SelectedItem.Caption = "文籍租赁统计" Then
    frmIncome.Visible = False
    frameListofItemsToBeReturnedToday.Visible = False
    frmMovieStatistics.Visible = True
    Call vr_engine.REPORT_MOVIESTAT_FILLCBO(cboGenre, cboItemCode, cboActor)
    If FlexMovie.Row = 2 Then FlexMovie.SetFocus  '避免未知错误！！！的条件规避法子,本来没有if的。
End If
'-------------------------------------------------
If TabStrip1.SelectedItem.Caption = "今日到期/失损项目列表" Then
    frmIncome.Visible = False
    frmMovieStatistics.Visible = False
    frameListofItemsToBeReturnedToday.Visible = True
    Call InitializeFlexItemsToBeReturnedToday
    MousePointer = vbHourglass
    'Call vr_engine.Report_LoadItemsToBeReturnedToday(FlexListOfItemsToBEReturnedToday)   为保持浏览速度，暂时屏蔽了这句
    MousePointer = vbDefault
End If
'-------------------------------------------------
Dim StartDate As String
StartDate = "1/1/" & Format(Now, "yyyy")
DTPickerStart.Value = StartDate
DTPickerEnd.Value = Format(Now, "mm/dd/yyyy")

Call InitializeFlexMovie
Call InitializeFlexSalesDetiled
End Sub
Private Sub InitializeFlexItemsToBeReturnedToday()
    MousePointer = vbHourglass
    If Trim(FlexListOfItemsToBEReturnedToday.TextMatrix(0, 0)) = "" Then
       FlexListOfItemsToBEReturnedToday.ColWidth(0) = 600  ' No.
       FlexListOfItemsToBEReturnedToday.ColWidth(1) = 900 ' Item Code
       FlexListOfItemsToBEReturnedToday.ColWidth(2) = 3400 ' 标题
       FlexListOfItemsToBEReturnedToday.ColWidth(3) = 1300 ' Date Borrowed
       FlexListOfItemsToBEReturnedToday.ColWidth(4) = 1500 ' Date Due
       FlexListOfItemsToBEReturnedToday.ColWidth(5) = 1200 ' Overdue Charges
       FlexListOfItemsToBEReturnedToday.ColWidth(6) = 500
       FlexListOfItemsToBEReturnedToday.ColWidth(7) = 2100 ' Borrowed By
       
       FlexListOfItemsToBEReturnedToday.ColAlignment(3) = 5
       FlexListOfItemsToBEReturnedToday.ColAlignment(4) = 5
       FlexListOfItemsToBEReturnedToday.ColAlignment(5) = 5
       FlexListOfItemsToBEReturnedToday.ColAlignment(6) = 5
       
       FlexListOfItemsToBEReturnedToday.TextMatrix(0, 0) = "No."
       FlexListOfItemsToBEReturnedToday.TextMatrix(0, 1) = "项目编号"
       FlexListOfItemsToBEReturnedToday.TextMatrix(0, 2) = "标题"
       FlexListOfItemsToBEReturnedToday.TextMatrix(0, 3) = "租借日期"
       FlexListOfItemsToBEReturnedToday.TextMatrix(0, 4) = "到期时间"
       FlexListOfItemsToBEReturnedToday.TextMatrix(0, 5) = "过期支付"
       FlexListOfItemsToBEReturnedToday.TextMatrix(0, 6) = "数量"
       FlexListOfItemsToBEReturnedToday.TextMatrix(0, 7) = "项目标记"
    End If
    
    FlexListOfItemsToBEReturnedToday.SetFocus
    MousePointer = vbDefault
End Sub
Private Sub InitializeFlexMovie()
   If FlexMovie.TextMatrix(0, 0) = "" Then
        FlexMovie.ColWidth(0) = 550
        FlexMovie.ColWidth(1) = 3290
        FlexMovie.ColWidth(2) = 1200
        FlexMovie.ColAlignment(0) = 5
        'FlexMovie.ColAlignment(1) = 5
        FlexMovie.ColAlignment(2) = 5
        FlexMovie.TextMatrix(0, 0) = "No."
        FlexMovie.TextMatrix(0, 1) = "标题"
        FlexMovie.TextMatrix(0, 2) = "租借频率/次"
    'Start - Clear 2nd row
        FlexMovie.TextMatrix(1, 0) = ""
        FlexMovie.TextMatrix(1, 1) = ""
        FlexMovie.TextMatrix(1, 2) = ""
    'End - Clear 2nd row
   End If
End Sub
Sub InitializeFlexSalesDetiled()
If FlexSales.TextMatrix(0, 0) = "" Then
        FlexSales.ColWidth(0) = 500
        FlexSales.ColWidth(1) = 1100
        FlexSales.ColWidth(2) = 1300
        FlexSales.ColWidth(3) = 1250
        FlexSales.ColWidth(4) = 1400
        FlexSales.ColWidth(5) = 1000
        FlexSales.ColWidth(6) = 3000
        FlexSales.ColWidth(7) = 900
        FlexSales.ColAlignment(0) = 5
        FlexSales.ColAlignment(1) = 5
        FlexSales.ColAlignment(2) = 5
        FlexSales.ColAlignment(3) = 5
        FlexSales.ColAlignment(4) = 2
        FlexSales.ColAlignment(5) = 5
        FlexSales.ColAlignment(6) = 5
        FlexSales.ColAlignment(7) = 5
        FlexSales.ColAlignment(8) = 5
        
        FlexSales.TextMatrix(0, 0) = "No."
        FlexSales.TextMatrix(0, 1) = "发票连号"
        FlexSales.TextMatrix(0, 2) = "租借日期"
        FlexSales.TextMatrix(0, 3) = "经手出纳"
        FlexSales.TextMatrix(0, 4) = "租阅者"
        FlexSales.TextMatrix(0, 5) = "项目编号"
        FlexSales.TextMatrix(0, 6) = "标题"
        FlexSales.TextMatrix(0, 7) = "租金额"
        FlexSales.TextMatrix(0, 8) = "交易量"
        
    'Start - Clear 2nd row
        FlexSales.TextMatrix(1, 0) = ""
        FlexSales.TextMatrix(1, 1) = ""
        FlexSales.TextMatrix(1, 2) = ""
    'End - Clear 2nd row
    StartDate = "1/1/" & Format(Now, "yyyy")
    DTSalesStart.Value = StartDate
    DTSalesEnd.Value = Format(Now, "mm/dd/yyyy")
    lblFlexSalesCaption.Caption = "从: " & Format(DTSalesStart.Value, "mmmm dd, yyyy") & " 到 " & Format(DTSalesEnd.Value, "mmmm dd, yyyy")
    FlexSales.SetFocus
   End If

End Sub
Private Sub txtTotalSales_Change()
txtTotalSales.Text = Format(txtTotalSales.Text, "0.00")
End Sub