form1.frm

小型企业进销存源代码 一款小型企业进销存源代码

Exit Sub
Err2:
Unload Me
End Sub

'每个表单的列印副程式皆取名为 PrintResult
'则 frmPrintPreview 这个表单可以支援所有表单的预览列印工作
'若是只有一个表单需要列印 ,则将 PrintResult 放至一般模组亦可
'参数 zoom 代表将资料列印到 PictureBox 时的比例,介于 0 ~ 无限大的数值
'通常传入0~100即可 ,详细的说明请参考 frmPrintPreview 表单宣告区之变数 lngZoom 的说明
'对于将资料列印到印表机时 ,zoom会被设定成1.0, 即使传入的数值不等于1.0
Public Sub PrintResult(Dest As Object, zoom As Long)
     On Error GoTo ErrorTrap
     Dim lngTM As Long, lngBM As Long, lngLM As Long, lngRM As Long '上、下、左、右边界
     Dim lngSW As Long, lngSH As Long ' 扣掉边界之后的可印范围
     Dim temp As Long, isPrinter As Boolean, i As Long, destParent As Form, r As Single
     isPrinter = Dest Is Printer
     'r 只取到小数以下1位 , 否则字型的输出将无法配何正确的比例
     '以下程式码中任何与大小、距离有关的设定都要乘上 r
     '对于印表机而言 , r=1.0
     If isPrinter Then r = 1 Else r = CSng(Format(zoom / 100, "0.0"))
     Printer.ScaleMode = vbTwips   '设置scalemode属性 vbtwips为缇
     Printer.Orientation = vbPRORPortrait '是横的还是纵的：以纸的短边为顶边打印
     Printer.PaperSize = vbPRPSA4  '设置纸型
     'VbPRPSLetter 1 信笺，81/2x11英寸   ;VbPRPSLetterSmall 2 小型信笺，81/2x11英寸
     'VbPRPSTabloid 3 小型报，11x17英寸 ;VbPRPSLedger 4分类帐，17x11英寸
     'VbPRPSLegal 5 法律文件，81/2x14英寸;VbPRPSStatement 6 声明书，51/2x81/2英寸 ;
     'VbPRPSExecutive 7 行政文件，71/2x101/2英寸 ;VbPRPSA3 8 A3,297x420毫米
     'VbPRPSA4 9 A4,210x297毫米 ;VbPRPSA4Small 10 A4小号，210x297毫米
     lngTM = glngTopMargin: lngBM = glngBottomMargin: lngLM = glngLeftMargin: lngRM = glngRightMargin
     lngSH = Printer.ScaleHeight - lngTM - lngBM
     lngSW = Printer.ScaleWidth - lngLM - lngRM
     If Not isPrinter Then
          temp = (Printer.Height - Printer.ScaleHeight) / 2
          lngTM = (lngTM + temp) * r
          lngBM = (lngBM + temp) * r
          temp = (Printer.Width - Printer.ScaleWidth) / 2
          lngLM = (lngLM + temp) * r
          lngRM = (lngRM + temp) * r
          lngSH = lngSH * r
          lngSW = lngSW * r
          Set destParent = Dest.Parent
          Dest.AutoRedraw = True
     End If
     For i = 1 To 1
          With Dest
               If Not isPrinter Then
                    Dest.Cls
                    Dest.Width = glngPAPERW * r
                    Dest.Height = glngPAPERH * r
                    '以下输出边界,列印时不会印出来
                    Dest.DrawStyle = 3    '点画线
                    Dest.Line (lngLM, lngTM)-Step(lngSW, lngSH), QBColor(7), B
               End If
          '***********************************************************************
         '以下为表头程序。
         lngLM = 567 * 8 / 5
         lngTM = 567 * 1.4
               .Font.Name = "黑体"
               .Font.Size = 15
               .CurrentX = lngLM * 5
               .CurrentY = lngTM
               Dest.Print "职工人事档案"
               Dest.DrawStyle = 2   '虚线
               Dest.Line (lngLM * 7.5, lngTM * 1.37)-(lngLM * 4.5, lngTM * 1.37)
               Dest.Line (lngLM * 7.5, lngTM * 1.43)-(lngLM * 4.5, lngTM * 1.43)
               
               Dim a As String
               a = Combo1.Text
               .Font.Name = "宋体"
               .Font.Size = 10
               .CurrentX = lngLM * 1.2
               .CurrentY = lngTM * 2
               Dest.Print "职工编号： " & Text3.Text & ""
               Dest.DrawStyle = 0         '实线
                Dest.Line (lngLM * 3.5, lngTM * 2.25)-(lngLM * 1.1, lngTM * 2.25)
               .Font.Name = "宋体"
               .Font.Size = 10
               .CurrentX = lngLM * 9.5
               .CurrentY = lngTM * 2
               Dest.Print "打印日期： " & Date & ""
               Dest.Line (lngLM * 9.4, lngTM * 2.25)-(lngLM * 11.9, lngTM * 2.25)
               
        '********************************************************************
        '***********************************************************************************
        '以下为第二行列表
               .CurrentX = lngLM * 1.2
               .CurrentY = lngTM * 3.1
               Dest.Print "出生日期  " & DTPicker1.Value & " "
               .CurrentX = lngLM * 3.6
               .CurrentY = lngTM * 3.1
               Dest.Print "年龄  " & Text5.Text & " "
               .CurrentX = lngLM * 5
               .CurrentY = lngTM * 3.1
               Dest.Print "婚否 " & Combo4.Text & " "
               .CurrentX = lngLM * 6.3
               .CurrentY = lngTM * 3.1
               Dest.Print "身份证号  " & Text6.Text & " "
    '*******************************************************************************
    '以下为第三行列表
             .CurrentX = lngLM * 1.2
               .CurrentY = lngTM * 3.5
               Dest.Print "文化程度    " & Combo7.Text & " "
               .CurrentX = lngLM * 3.7
               .CurrentY = lngTM * 3.5
               Dest.Print "政治面貌      " & Combo8.Text & " "
               .CurrentX = lngLM * 7.05
               .CurrentY = lngTM * 3.5
               Dest.Print "电话      " & Text10.Text & " "
    '*******************************************************************************
    '以下为第四行列表。
               .CurrentX = lngLM * 1.3
               .CurrentY = lngTM * 3.9
               Dest.Print "参加工作时间   " & DTPicker2.Value & " "
               .CurrentX = lngLM * 4.4
               .CurrentY = lngTM * 3.9
               Dest.Print "工 龄   " & Text8.Text & " "
              .CurrentX = lngLM * 7.05
               .CurrentY = lngTM * 3.9
               Dest.Print "电话      "; " "
    '********************************************************************************
    '以下为第五行列表
              .CurrentX = lngLM * 1.3
               .CurrentY = lngTM * 4.3
               Dest.Print "入本单位时间   " & DTPicker3.Value & " "
               .CurrentX = lngLM * 4.3
               .CurrentY = lngTM * 4.3
               Dest.Print "本厂工龄 " & Text8.Text & " "
                .CurrentX = lngLM * 7.05
               .CurrentY = lngTM * 4.3
               Dest.Print "手机      " & Text12.Text & " "
               .CurrentX = lngLM * 6.3
               .CurrentY = lngTM * 3.75
               Dest.Print "联系"
               .CurrentX = lngLM * 6.3
               .CurrentY = lngTM * 4.15
               Dest.Print "方式"
     '********************************************************************************
     '第6\7行
               .CurrentX = lngLM * 1.45
               .CurrentY = lngTM * 4.7
               Dest.Print "家庭住址     " & Text14.Text & " "
               .CurrentX = lngLM * 1.45
               .CurrentY = lngTM * 5.1
               Dest.Print "毕业学校     " & Text11.Text & " "
        
     '*******************************************************************************
     '第8、9\0行
              ' Dim a As String
               If Combo11.Text = "无" Then
               a = Combo10.Text
               Else
               a = Combo10.Text + Combo11.Text
               End If
                .CurrentX = lngLM * 2.88
               .CurrentY = lngTM * 5.5
               Dest.Print "隶属部门  " & a & " "
               .CurrentX = lngLM * 3.17
               .CurrentY = lngTM * 5.9
               Dest.Print "职务      " & Text13.Text & " "
               .CurrentX = lngLM * 5.5
               .CurrentY = lngTM * 5.5
               Dest.Print "职工类型     " & Combo9.Text & " "
               .CurrentX = lngLM * 8.6
               .CurrentY = lngTM * 5.5
               Dest.Print "工资类别         " & Combo6.Text & " "
              If Picture1.Picture = LoadPicture Then
               .CurrentX = lngLM * 11
               .CurrentY = lngTM * 3.5
               Dest.Print "照"
                .CurrentX = lngLM * 11
               .CurrentY = lngTM * 4.6
               Dest.Print "片"
               Else
                 Dest.PaintPicture Picture1.Picture, lngLM * 10.2, lngTM * 3, Picture1.Width * 0.8, Picture1.Height * 0.8
                End If
               .CurrentX = lngLM * 7.05
               .CurrentY = lngTM * 5.9
               Dest.Print "职 称         " & Combo12.Text & " "
               .CurrentX = lngLM * 1.45
               .CurrentY = lngTM * 5.7
               Dest.Print "职务信息"
               .CurrentX = lngLM * 1.7
               .CurrentY = lngTM * 10.5
               Dest.Print "个"
               .CurrentX = lngLM * 1.7
               .CurrentY = lngTM * 11
               Dest.Print "人"
                .CurrentX = lngLM * 1.7
               .CurrentY = lngTM * 11.5
             Dest.Print "简"
             .CurrentX = lngLM * 1.7
               .CurrentY = lngTM * 12
             Dest.Print "历"
              .CurrentX = lngLM * 2.2
               .CurrentY = lngTM * 10.2
               Dest.Print "∧"
             .CurrentX = lngLM * 2.2
               .CurrentY = lngTM * 10.5
               Dest.Print "工"
               .CurrentX = lngLM * 2.2
               .CurrentY = lngTM * 11
               Dest.Print "作"
                .CurrentX = lngLM * 2.2
               .CurrentY = lngTM * 11.5
             Dest.Print "经"
             .CurrentX = lngLM * 2.2
               .CurrentY = lngTM * 12
             Dest.Print "历"
              .CurrentX = lngLM * 2.2
               .CurrentY = lngTM * 12.3
               Dest.Print "∨"
             Dim l As Double
             Dim m As Integer
             l = 6.5
             linecount = SendMessageLong(Text16.hWnd, EM_GETLINECOUNT, 0&, 0&)


         For m = 0 To linecount - 1 Step 1
            l = 0.4 + l
              .CurrentX = lngLM * 3.5
              .CurrentY = lngTM * l
              Dim s As String
               Call TB_GetLine(Text16.hWnd, m, s)
              
             Dest.Print s
           
            Next m
    '***********************************************************
    '最后一行
              .CurrentX = lngLM * 2
               .CurrentY = lngTM * 17.5
             Dest.Print "核准："
                .CurrentX = lngLM * 4.5
               .CurrentY = lngTM * 17.5
             Dest.Print "审核："
               .CurrentX = lngLM * 7
               .CurrentY = lngTM * 17.5
             Dest.Print "填表人："
               .CurrentX = lngLM * 9.5
               .CurrentY = lngTM * 17.5
             Dest.Print "填表日期："
    '*******************************************************************************
    '**************************************************************************
               '以下为第一行显示程序。
               .Font.Name = "宋体"
               .Font.Size = 10
               .CurrentX = lngLM * 1
               .CurrentY = lngTM * 2.7
               Dest.Print "  工 号     " & Text3.Text & " "
            .CurrentX = lngLM * 3.8
               .CurrentY = lngTM * 2.7
               Dest.Print " 姓 名     " & Text4.Text & "   "
                .CurrentX = lngLM * 6.25
               .CurrentY = lngTM * 2.7
               Dest.Print "性别 　" & Combo5.Text & " "
               .CurrentX = lngLM * 7.45
               .CurrentY = lngTM * 2.7
               Dest.Print "民族 " & Combo3.Text & " "
               .CurrentX = lngLM * 8.6
               .CurrentY = lngTM * 2.7
               Dest.Print "籍 贯   " & Text7.Text & ""; ""
               .CurrentX = lngLM * 2
               .CurrentY = lngTM * 2.63
     
        '********************************************************************
       '以下这节程序为画表格两边的。
            
            Dest.Line (lngLM * 1.1, lngTM * 2.6)-(lngLM * 11.9, lngTM * 16.9), , B  '边框
            Dest.Line (lngLM * 1.1, lngTM * 3)-(lngLM * 11.9, lngTM * 3)           '第一行
            Dest.Line (lngLM * 1.1, lngTM * 3.4)-(lngLM * 10.2, lngTM * 3.4)
            Dest.Line (lngLM * 1.1, lngTM * 3.8)-(lngLM * 6.15, lngTM * 3.8)
            Dest.Line (lngLM * 6.8, lngTM * 3.8)-(lngLM * 10.2, lngTM * 3.8)
            Dest.Line (lngLM * 1.1, lngTM * 4.2)-(lngLM * 6.15, lngTM * 4.2)
            Dest.Line (lngLM * 6.8, lngTM * 4.2)-(lngLM * 10.2, lngTM * 4.2)
            Dest.Line (lngLM * 1.1, lngTM * 4.6)-(lngLM * 10.2, lngTM * 4.6)
            Dest.Line (lngLM * 1.1, lngTM * 5)-(lngLM * 10.2, lngTM * 5)
            Dest.Line (lngLM * 1.1, lngTM * 5.4)-(lngLM * 11.9, lngTM * 5.4)
            Dest.Line (lngLM * 2.8, lngTM * 5.8)-(lngLM * 11.9, lngTM * 5.8)
            Dest.Line (lngLM * 1.1, lngTM * 6.2)-(lngLM * 11.9, lngTM * 6.2)
            
            
            Dest.Line (lngLM * 2.1, lngTM * 2.6)-(lngLM * 2.1, lngTM * 3.8)
            Dest.Line (lngLM * 3.56, lngTM * 2.6)-(lngLM * 3.56, lngTM * 3.8)
            Dest.Line (lngLM * 4.2, lngTM * 3)-(lngLM * 4.2, lngTM * 3.4)
            Dest.Line (lngLM * 4.85, lngTM * 2.6)-(lngLM * 4.85, lngTM * 3.8)
            Dest.Line (lngLM * 6.15, lngTM * 2.6)-(lngLM * 6.15, lngTM * 4.6)
            Dest.Line (lngLM * 5.45, lngTM * 3)-(lngLM * 5.45, lngTM * 3.4)
            Dest.Line (lngLM * 7.3, lngTM * 2.6)-(lngLM * 7.3, lngTM * 3.4)
            Dest.Line (lngLM * 6.8, lngTM * 2.6)-(lngLM * 6.8, lngTM * 3)
            Dest.Line (lngLM * 7.9, lngTM * 2.6)-(lngLM * 7.9, lngTM * 3)
            Dest.Line (lngLM * 8.5, lngTM * 2.6)-(lngLM * 8.5, lngTM * 3)
            Dest.Line (lngLM * 9.2, lngTM * 2.6)-(lngLM * 9.2, lngTM * 3)
            Dest.Line (lngLM * 10.2, lngTM * 3)-(lngLM * 10.2, lngTM * 5.8)
            Dest.Line (lngLM * 6.8, lngTM * 3.4)-(lngLM * 6.8, lngTM * 4.6)
            Dest.Line (lngLM * 7.6, lngTM * 3.4)-(lngLM * 7.6, lngTM * 4.6)
            Dest.Line (lngLM * 5.2, lngTM * 3.8)-(lngLM * 5.2, lngTM * 4.6)
            Dest.Line (lngLM * 4.2, lngTM * 3.8)-(lngLM * 4.2, lngTM * 4.6)
            Dest.Line (lngLM * 2.8, lngTM * 3.8)-(lngLM * 2.8, lngTM * 16.9)
            Dest.Line (lngLM * 3.8, lngTM * 5.4)-(lngLM * 3.8, lngTM * 6.2)
            Dest.Line (lngLM * 5.4, lngTM * 5.4)-(lngLM * 5.4, lngTM * 5.8)
            Dest.Line (lngLM * 6.4, lngTM * 5.4)-(lngLM * 6.4, lngTM * 6.2)
            Dest.Line (lngLM * 8.2, lngTM * 5.4)-(lngLM * 8.2, lngTM * 6.2)
        '**************************************************************************
       
               
               
        '*************************************************************************************
                                 
               Dim b As String
               Dim c As String
               c = Mid(Text3.Text, 6, 1)
              If c <> "0" Then
                  b = Mid(Text3.Text, 6, 4)
                  
              ElseIf Mid(Text3.Text, 7, 1) <> "0" Then
                  b = Mid(Text3.Text, 7, 3)
                  
             ElseIf Mid(Text3.Text, 8, 1) <> "0" Then
                  b = Mid(Text3.Text, 8, 2)
            ElseIf Mid(Text3.Text, 9, 1) <> "0" Then
                  b = Mid(Text3.Text, 9, 1)
              End If
             
           
               .Font.Size = 12
               .CurrentX = lngLM / 2 + lngSW - .TextWidth("第 1 页")
               .CurrentY = lngTM / 2 + lngSH - .TextHeight("第 1 页")
               Dest.Print "第 " & b & " 页"
          End With
          If Not isPrinter Then Set destParent.imgView(i).Picture = destParent.picPrint.Image
          If i < 1 Then
               If isPrinter Then
                    Printer.NewPage
               Else
                    If destParent.imgView.count < i + 1 Then Load destParent.imgView(i + 1): destParent.imgView(i + 1).Visible = True
               End If
          End If
     Next
     If isPrinter Then Printer.EndDoc Else Dest.AutoRedraw = False
     Exit Sub
ErrorTrap:
     MsgBox "应用程式发生错误。" & vbCrLf & "错误代码：" & err.Number & vbCrLf & "错误讯息：" & err.Description
End Sub
Private Sub Text15_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Command23_Click
End If
End Sub