module1.bas

一个简单的公司进销存管理系统

    TempPrint Format(X1 * mm)
    TempPrint Format(Y1 * mm)
    TempPrint Format(MyCol)
    TempPrint "BF"

End Sub

Sub PrintBoxFill2(X As Single, Y As Single, X1 As Single, Y1 As Single, MyCol As Long, MyFil As Long, Dst As Integer)

    TempPrint "#fill"
    TempPrint Format(MyFil)
    TempPrint "#color"
    TempPrint Format(MyCol)
    TempPrint "#line"
    TempPrint Format(X * mm)
    TempPrint Format(Y * mm)
    TempPrint Format(X1 * mm)
    TempPrint Format(Y1 * mm)
    TempPrint ""
    TempPrint "B"

End Sub


Sub PrintBox(X As Single, Y As Single, X1 As Single, Y1 As Single, Dst As Integer)

    TempPrint "#fill"
    TempPrint "1"
    TempPrint "#color"
    TempPrint "0"
    TempPrint "#line"
    TempPrint Format(X * mm)
    TempPrint Format(Y * mm)
    TempPrint Format(X1 * mm)
    TempPrint Format(Y1 * mm)
    TempPrint ""
    TempPrint "B"

End Sub


Sub PrintImg(Nome As Control, X As Single, Y As Single, X1 As Single, Y1 As Single, Dst As Integer)

    Static RR As Single, RT As String, NI As String
    
    TempPrint "#img"
    RR = (899999 * Rnd) + 100000
    RT = Format(RR, "000000")
    NI = LocPerc + "_$$_" + RT + ".tmp"
    TempPrint NI
    SavePicture Nome, NI
    TempPrint Format(X * mm)
    TempPrint Format(Y * mm)
    TempPrint Format(X1 * mm)
    TempPrint Format(Y1 * mm)

End Sub

Sub SetA3()

    PrnPRV.Prv.Cls

    PrnPRV.Prv.Width = PrnPRV.Prv.Height * (29.7 / 42)
    PrnPRV.Prv.ScaleWidth = mm * 29.7
    PrnPRV.Prv.ScaleHeight = mm * 42
    
    Scala = PrnPRV.Prv.Height / PrnPRV.Prv.ScaleHeight

End Sub


Sub SetA4()

    PrnPRV.Prv.Cls

    PrnPRV.Prv.Width = PrnPRV.Prv.Height * (21 / 29.7)
    PrnPRV.Prv.ScaleWidth = mm * 21
    PrnPRV.Prv.ScaleHeight = mm * 29.7
    
    Scala = PrnPRV.Prv.Height / PrnPRV.Prv.ScaleHeight

End Sub


Sub SetB5()

    PrnPRV.Prv.Cls

    PrnPRV.Prv.Width = PrnPRV.Prv.Height * (15 / 21)
    PrnPRV.Prv.ScaleWidth = mm * 15
    PrnPRV.Prv.ScaleHeight = mm * 21
    
    Scala = PrnPRV.Prv.Height / PrnPRV.Prv.ScaleHeight

End Sub


Sub TempShow(X01 As Single, Y01 As Single, X02 As Single, Y02 As Single)

    PrnPRV.MousePointer = vbHourglass
    
    Static OldFill As Long, OldColo As Long
    Static l As Integer, Lung As Single, dX As Single, tmpX As Single
    Static pPnt As Integer, pRef As Integer
    pPnt = 0
    pRef = Val(PrnPRV.ePag.Text)
    Static A As String, B As String
    Static X As Single, Y As Single
    Static X1 As Single, Y1 As Single
    Static BoxColor As Long, BoxType As String
    
    PrnPRV.Prv.Cls
    'PrnPrv.Prv.Scale (X01, Y01)-(X02, Y02)
    PrnPRV.Prv.Left = (X01 * -1) + NM_PP_Ofs
    PrnPRV.Prv.Top = (Y01 * -1) + NM_PP_Ofs + PrnPRV.Cmd(0).Height
  Open LocPerc + LocName For Input As #26
        While Not EOF(26)
            Line Input #26, A
            If A = "#line" Then
                Line Input #26, A
                X = StripComma(A)
                Line Input #26, A
                Y = StripComma(A)
                Line Input #26, A
                X1 = StripComma(A)
                Line Input #26, A
                Y1 = StripComma(A)
                Line Input #26, A
                B = A
                BoxColor = StripComma(A)
                Line Input #26, A
                BoxType = A
                If pPnt = pRef Then
                    If B = "" And BoxType = "" Then
                        PrnPRV.Prv.Line (X, Y)-(X1, Y1)
                    ElseIf B <> "" Then
                        PrnPRV.Prv.Line (X, Y)-(X1, Y1), BoxColor, BF
                    Else
                        PrnPRV.Prv.Line (X, Y)-(X1, Y1), , B
                    End If
                End If
            ElseIf A = "#x" Then
                Line Input #26, A
                If pPnt = pRef Then
                    PrnPRV.Prv.CurrentX = StripComma(A)
                End If
            ElseIf A = "#y" Then
                Line Input #26, A
                If pPnt = pRef Then
                    PrnPRV.Prv.CurrentY = StripComma(A)
                End If
            ElseIf A = "#txt_c" Then
                Line Input #26, A
                If pPnt = pRef Then
                    dX = Int(PrnPRV.Prv.TextWidth(A) / 2)
                    tmpX = PrnPRV.Prv.CurrentX - dX
                    PrnPRV.Prv.Print A
                End If
            ElseIf A = "#txt_l" Then
                Line Input #26, A
                If pPnt = pRef Then
                    PrnPRV.Prv.Print A
                End If
            ElseIf A = "#txt_r" Then
                Line Input #26, A
                If pPnt = pRef Then
                    Lung = PrnPRV.Prv.TextWidth(A)
                    PrnPRV.Prv.CurrentX = PrnPRV.Prv.CurrentX - Lung
                    PrnPRV.Prv.Print A
                End If
            ElseIf A = "#fontname" Then
                Line Input #26, A
                If pPnt = pRef Then
                    PrnPRV.Prv.FontName = A
                End If
            ElseIf A = "#fontsize" Then
                Line Input #26, A
                If pPnt = pRef Then
                    PrnPRV.Prv.FontSize = StripComma(A) * Scala
                End If
            ElseIf A = "#fontbold" Then
                Line Input #26, A
                If pPnt = pRef Then
                    If A = "0" Then
                        PrnPRV.Prv.FontBold = False
                    Else
                        PrnPRV.Prv.FontBold = True
                    End If
                End If
            ElseIf A = "#fill" Then
                Line Input #26, A
                If pPnt = pRef Then
                    PrnPRV.Prv.FillStyle = CLng(Val(A))
                End If
            ElseIf A = "#color" Then
                Line Input #26, A
                If pPnt = pRef Then
                    PrnPRV.Prv.FillColor = CLng(Val(A))
                End If
            ElseIf A = "#img" Then
                Line Input #26, A
                If TempFileExists(A) = True Then
                    PrnPRV.Img.Picture = LoadPicture(A)
                End If
                Line Input #26, A
                X = StripComma(A)
                Line Input #26, A
                Y = StripComma(A)
                Line Input #26, A
                X1 = StripComma(A)
                Line Input #26, A
                Y1 = StripComma(A)
                If pPnt = pRef Then
                    PrnPRV.Prv.PaintPicture PrnPRV.Img.Picture, X, Y, X1, Y1
                End If
            ElseIf A = "#startpage" Then
                pPnt = pPnt + 1
            ElseIf A = "#endpage" Then
                If pPnt = pRef Then
                    GoTo BastaLeggere
                End If
            End If
        Wend
BastaLeggere:
    Close #26
    
    If PrnPRV.Prv.Width > PrnPRV.hBar.Width Then
        PrnPRV.hBar.Min = 0
        PrnPRV.hBar.Max = PrnPRV.Prv.Width - PrnPRV.hBar.Width
        PrnPRV.hBar.SmallChange = 20
        'PrnPrv.hBar.LargeChange = PrnPrv.hBar.Max / 10
        PrnPRV.hBar.LargeChange = (PrnPRV.hBar.Width * PrnPRV.hBar.Max) / PrnPRV.Prv.Width
    Else
        PrnPRV.hBar.Min = 0
        PrnPRV.hBar.Max = 0
    End If
    
    If PrnPRV.Prv.Height > PrnPRV.vBar.Height Then
        PrnPRV.vBar.Min = 0
        PrnPRV.vBar.Max = PrnPRV.Prv.Height - PrnPRV.vBar.Height
        PrnPRV.vBar.SmallChange = 20
        'PrnPrv.vBar.LargeChange = PrnPrv.vBar.Max / 10
        PrnPRV.vBar.LargeChange = (PrnPRV.vBar.Height * PrnPRV.vBar.Max) / PrnPRV.Prv.Height
    Else
        PrnPRV.vBar.Min = 0
        PrnPRV.vBar.Max = 0
    End If
    
    SistemaStatusBar
    
    PrnPRV.MousePointer = vbDefault
    
End Sub


Sub TempStampa(sP As Integer, eP As Integer)

    PrnPRV.MousePointer = vbHourglass
    'PrnPRN1.Command2.Font.Bold = True
    DoEvents
    
    'PrnPRN1.pBar.Width = 0
    
    Static DaStampare As Boolean
    DaStampare = False
    Static l As Integer, Lung As Single, dX As Single, tmpX As Single
    Static pPnt As Integer, pRef As Integer
    pPnt = 0
    pRef = Val(PrnPRV.ePag.Text)
    Static A As String, B As String
    Static X As Single, Y As Single
    Static X1 As Single, Y1 As Single
    Static BoxColor As Long, BoxType As String
    
    Open LocPerc + LocName For Input As #26
        While Not EOF(26)
            Line Input #26, A
            If A = "#line" Then
                Line Input #26, A
                X = StripComma(A)
                Line Input #26, A
                Y = StripComma(A)
                Line Input #26, A
                X1 = StripComma(A)
                Line Input #26, A
                Y1 = StripComma(A)
                Line Input #26, A
                B = A
                BoxColor = StripComma(A)
                Line Input #26, A
                BoxType = A
                If DaStampare = True Then
                    If B = "" And BoxType = "" Then
                        Printer.Line (X, Y)-(X1, Y1)
                    ElseIf B <> "" Then
                        Printer.Line (X, Y)-(X1, Y1), BoxColor, BF
                    Else
                        Printer.Line (X, Y)-(X1, Y1), , B
                    End If
                End If
            ElseIf A = "#x" Then
                Line Input #26, A
                If DaStampare = True Then
                    Printer.CurrentX = StripComma(A)
                End If
            ElseIf A = "#y" Then
                Line Input #26, A
                If DaStampare = True Then
                    Printer.CurrentY = StripComma(A)
                End If
            ElseIf A = "#txt_c" Then
                Line Input #26, A
                If DaStampare = True Then
                    dX = Int(Printer.TextWidth(A) / 2)
                    tmpX = Printer.CurrentX - dX
                    Printer.Print A
                End If
            ElseIf A = "#txt_l" Then
                Line Input #26, A
                If DaStampare = True Then
                    Printer.Print A
                End If
            ElseIf A = "#txt_r" Then
                Line Input #26, A
                If DaStampare = True Then
                    Lung = Printer.TextWidth(A)
                    Printer.CurrentX = Printer.CurrentX - Lung
                    Printer.Print A
                End If
            ElseIf A = "#fontname" Then
                Line Input #26, A
                If DaStampare = True Then
                    Printer.FontName = A
                End If
            ElseIf A = "#fontsize" Then
                Line Input #26, A
                If DaStampare = True Then
                    Printer.FontSize = StripComma(A)
                End If
            ElseIf A = "#fontbold" Then
                Line Input #26, A
                If DaStampare = True Then
                    If A = "0" Then
                        Printer.FontBold = False
                    Else
                        Printer.FontBold = True
                    End If
                End If
            ElseIf A = "#fill" Then
                Line Input #26, A
                If pPnt = pRef Then
                    Printer.FillStyle = CLng(Val(A))
                End If
            ElseIf A = "#color" Then
                Line Input #26, A
                If pPnt = pRef Then
                    Printer.FillColor = CLng(Val(A))
                End If
            ElseIf A = "#img" Then
                Line Input #26, A
                If TempFileExists(A) = True Then
                    PrnPRV.Img.Picture = LoadPicture(A)
                End If
                Line Input #26, A
                X = StripComma(A)
                Line Input #26, A
                Y = StripComma(A)
                Line Input #26, A
                X1 = StripComma(A)
                Line Input #26, A
                Y1 = StripComma(A)
                If DaStampare = True Then
                    Printer.PaintPicture PrnPRV.Img.Picture, X, Y, X1, Y1
                End If
            ElseIf A = "#startpage" Then
                If NM_AnnullaStampa = True Then GoTo BastaLeggere
                pPnt = pPnt + 1
                If pPnt > eP Then
                    GoTo BastaLeggere
                ElseIf pPnt >= sP And pPnt <= eP Then
                    DaStampare = True
                    SistemaBarra sP, eP, pPnt
                    DoEvents
                ElseIf pPnt < sP Then
                    DaStampare = False
                End If
            ElseIf A = "#endpage" Then
                If NM_AnnullaStampa = True Then GoTo BastaLeggere
                If pPnt >= eP Then GoTo BastaLeggere
                If DaStampare = True Then Printer.NewPage
            End If
        Wend
BastaLeggere:
    Printer.EndDoc
    Close #26
    
    'PrnPRN1.Command2.Font.Bold = False
    PrnPRV.MousePointer = vbDefault
    
End Sub