thrzpreview.frm

酒店系统源码。为了学习和 研究软件内含的设计思想和原理

        .Height = IIf(ScaleHeight - .top > 0, ScaleHeight - .top, 0)
        preview1.Refresh
    End With
End Sub

Public Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    If Button = "退出" Then
       Unload Me
       Exit Sub
    End If
    Dim X
    Dim psm
    Dim zm
    Dim FS, ZFS
    
    On Error GoTo EXITERROR
    
    ZFS = Check1.Value + 1
    zm = Val(Combo1.Text)
    Sr = 1440
    If Button = "打印" Then
       CommonDialog1.ShowPrinter
       p.PrintStartDoc Printer, zm
    End If
    If Button = "预览" Then
       p.PrintStartDoc preview1, zm
    End If
    p.ForeColor = &H0&
    p.ForeColor = &HFF0000
    p.CurrentY = 1.2 * Sr
    
    For FS = 1 To ZFS
    
    p.CurrentX = 1.5 * Sr
    p.FontName = "宋体"
    p.FontItalic = True
    p.FontSize = 12
    p.PrintPrint STRBGNAME
    p.CurrentX = 2.2 * Sr
    p.CurrentY = p.CurrentY - 240.485 / 2
    p.FontSize = 18
    p.FontItalic = False
    p.PrintPrint THRZ.Label1(0).Caption
    p.FontSize = 11
    p.NewLine
    p.NewLine
    p.CurrentX = 2.2 * Sr
    p.PrintPrint "日期:" & Format(Now(), "LONG DATE") & Space(12) & THRZ.Label1(1).Caption & THRZ.Text6.Text
    p.NewLineBG 0
    p.CurrentY = p.CurrentY + 80
    p.CurrentX = 200
    p.BoxOut "团会名称", 1200, "C", 100, "1111"
    p.BoxOut " " & THRZ.Text2.Text, 4160, "L", 100, "1111"
    p.BoxOut "房号", 800, "C", 100, "1111"
    
    STRFH = ""
    If THRZ.Data2.Recordset.RecordCount > 0 Then
       THRZ.Data2.Recordset.MoveFirst
       While Not THRZ.Data2.Recordset.EOF
             If InStr(STRFH, CStr(THRZ.Data2.Recordset("房号"))) = 0 Then
                STRFH = STRFH + CStr(THRZ.Data2.Recordset("房号")) + "、"
             End If
             THRZ.Data2.Recordset.MoveNext
       Wend
       STRFH = left(STRFH, Len(STRFH) - 1)
    End If

    p.BoxOut STRFH, 2130, "C", 100, "1111"
    p.NewLineBG 0
    p.CurrentX = 200
    p.CurrentY = p.CurrentY + 100
    p.BoxOut "入住日期", 1200, "C", 100, "1111"
    p.BoxOut " " & Format(THRZ.DTPicker1.Value, "LONG DATE"), 2950, "L", 100, "1111"
    p.BoxOut "离住日期", 1200, "C", 100, "1111"
    p.BoxOut " ", 2940, "L", 100, "1111"
    p.NewLineBG 0
    p.CurrentX = 200
    p.CurrentY = p.CurrentY + 100
    p.BoxOut "团体人数", 1200, "C", 100, "1111"
    p.BoxOut " " & THRZ.Text3.Text, 2950, "L", 100, "1111"
    p.BoxOut "陪同人数", 1200, "C", 100, "1111"
    p.BoxOut " " & THRZ.Text4.Text, 2940, "L", 100, "1111"
    p.NewLineBG 0
    p.CurrentX = 200
    p.CurrentY = p.CurrentY + 100
    p.BoxOut "保 证 金", 1200, "C", 100, "1110"
    p.BoxOut " " & THRZ.Text5.Text & "    金额" & THRZ.Label2(7).Caption, 7110, "L", 100, "1110"
    p.NewLineBG 0
    p.CurrentX = 200
    p.CurrentY = p.CurrentY + 102
    p.BoxOut "团会成员基本情况", 8320, "C", 100, "1111"
    p.NewLineBG 0
    p.CurrentX = 200
    p.CurrentY = p.CurrentY + 100
    p.BoxOut "姓    名", 1200, "C", 100, "1111"
    p.BoxOut "性别", 700, "C", 100, "1111"
    p.BoxOut "房号", 1000, "C", 100, "1111"
    p.BoxOut "房价", 1225, "C", 100, "1111"
    p.BoxOut "姓    名", 1200, "C", 100, "1111"
    p.BoxOut "性别", 700, "C", 100, "1111"
    p.BoxOut "房号", 1000, "C", 100, "1111"
    p.BoxOut "房价", 1225, "C", 100, "1111"
    With THRZ.Data2.Recordset
        If .RecordCount > 0 And Check1.Value = 1 Then
           .MoveFirst
           While Not .EOF
               p.NewLineBG 0
               p.CurrentX = 200
               p.CurrentY = p.CurrentY + 100
               p.BoxOut IIf(Not IsNull(.Fields("姓名")), " " & .Fields("姓名"), " "), 1200, "L", 100, "1111"
               p.BoxOut IIf(Not IsNull(.Fields("性别")), .Fields("性别"), " "), 700, "C", 100, "1111"
               p.BoxOut IIf(Not IsNull(.Fields("房号")), .Fields("房号"), " "), 1000, "C", 100, "1111"
               p.BoxOut IIf(Not IsNull(.Fields("房价")), FormatNumber(.Fields("房价"), 2, vbTrue, , vbFalse), " ") & " ", 1225, "R", 100, "1111"
               .MoveNext
               If .EOF Then
                  p.BoxOut " ", 1200, "L", 100, "1111"
                  p.BoxOut " ", 700, "C", 100, "1111"
                  p.BoxOut " ", 1000, "C", 100, "1111"
                  p.BoxOut " ", 1225, "R", 100, "1111"
                  Else
                    p.BoxOut IIf(Not IsNull(.Fields("姓名")), " " & .Fields("姓名"), " "), 1200, "L", 100, "1111"
                    p.BoxOut IIf(Not IsNull(.Fields("性别")), .Fields("性别"), " "), 700, "C", 100, "1111"
                    p.BoxOut IIf(Not IsNull(.Fields("房号")), .Fields("房号"), " "), 1000, "C", 100, "1111"
                    p.BoxOut IIf(Not IsNull(.Fields("房价")), FormatNumber(.Fields("房价"), 2, vbTrue, , vbFalse), " ") & " ", 1225, "R", 100, "1111"
                   .MoveNext
               End If
           Wend
           Else
             p.NewLineBG 0
             p.CurrentX = 200
             p.CurrentY = p.CurrentY + 100
             p.BoxOut " ", 1200, "L", 100, "1111"
             p.BoxOut " ", 700, "C", 100, "1111"
             p.BoxOut " ", 1000, "C", 100, "1111"
             p.BoxOut " ", 1225, "R", 100, "1111"
             p.BoxOut " ", 1200, "L", 100, "1111"
             p.BoxOut " ", 700, "C", 100, "1111"
             p.BoxOut " ", 1000, "C", 100, "1111"
             p.BoxOut " ", 1225, "R", 100, "1111"
        End If
    End With
    p.NewLineBG 0
    p.CurrentX = 200
    p.CurrentY = p.CurrentY + 100
    p.BoxOut " 备注:", 800, "L", 100, "1100"
    p.BoxOut "", 7510, "L", 100, "0110"
    Dim HC1, HC2, HC3
    HC1 = 0
    START = 1
    While START < LenB(THRZ.Text1(8).Text)
          STRPRINT = MidB(THRZ.Text1(8).Text, START, 66)
          If InStrB(1, STRPRINT, Chr(13)) > 0 Then
             START = START + InStrB(1, STRPRINT, Chr(13)) + 3
             STRPRINT = MidB(STRPRINT, 1, InStrB(1, STRPRINT, Chr(13)))
             Else
               START = START + 66
          End If
          p.NewLineBG 0
          p.CurrentX = 200
          p.CurrentY = p.CurrentY + 100
          p.BoxOut " ", 800, "L", 100, "1000"
          p.BoxOut STRPRINT, 7510, "L", 100, "0010"
          HC1 = HC1 + 1
    Wend
    If HC1 < 2 Then
       For HC2 = 1 To 2 - HC1
           p.NewLineBG 0
           p.CurrentX = 200
           p.CurrentY = p.CurrentY + 100
           p.BoxOut " ", 800, "L", 100, "1000"
           p.BoxOut " ", 7510, "L", 100, "0010"
       Next
    End If
    p.NewLineBG 0
    p.CurrentX = 200
    p.CurrentY = p.CurrentY + 100
    p.BoxOut " ", 8320, "L", 100, "1011"
    p.NewLineBG 0
    p.CurrentX = 400
    p.CurrentY = p.CurrentY + 200
    p.PrintPrint "负责人：                      制表：" & frmLogin.CZYXM & Space(8 - LenB(frmLogin.CZYXM)) & "            总1页第1页"
    p.NewLine
    p.NewLine
    p.NewLine
    p.NewLine
    p.NewLine
    If FS = 1 Then
       p.PrintLine p.CurrentX, p.CurrentY, p.PaperWidth, p.CurrentY
       p.NewLine
       p.NewLine
       p.NewLine
       p.NewLine
       p.NewLine
    End If
    Next
    p.EndDoc
    Exit Sub
    
EXITERROR:
    If Err.Number = 32755 Then
        Exit Sub
        Else
          MsgBox CStr(Err.Number) & "-" & Err.Description, vbCritical, "错误信息"
          Exit Sub
    End If

End Sub

Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
    If ButtonMenu = "25%" Then
       Combo1.Text = "0.25"
       Else
         If ButtonMenu = "50%" Then
            Combo1.Text = "0.5"
            Else
              If ButtonMenu = "100%" Then
                 Combo1.Text = "1"
                 Else
                   If ButtonMenu = "200%" Then
                      Combo1.Text = "2"
                      Else
                        If ButtonMenu = "300%" Then
                           Combo1.Text = "3"
                        End If
                   End If
              End If
         End If
    End If

    Toolbar1_ButtonClick Toolbar1.Buttons(2)
End Sub