printdlg.frm

金算盘软件代码

Dim devs As DEVMODE
Dim devd As DEVMODE
Dim hh As Long
    If CboPrinterName.Text = "" Then
        Utility.ShowMsg Me.hWnd, "没有可用的打印机", vbInformation, "打印"
        Exit Sub
    End If

    l = GetdevMode(CboPrinterName.Text)
    hh = GlobalLock(l)
    Call CopyMemory(devd, ByVal hh, 122)
    InitPrintObj devd   '初始化打印对象
    GlobalUnlock l
    hh = GlobalLock(l)
    Call CopyMemory(ByVal hh, devd, 122)
    GlobalUnlock l
    l1 = GetdevMode1(hWnd, CboPrinterName.Text, l)
    If l1 = 0 Then
        Exit Sub
    End If
''根据打印设置的返回值更改打印属性的公共变量
    Dim hh1 As Long
    hh1 = GlobalLock(l1)
    CopyMemory devs, ByVal hh1, 122
    GlobalUnlock l
    GlobalUnlock l1
    GlobalFree l
    GlobalFree l1

    SaveToDB devs  '把所修该的设置回存数据库
End Sub

Private Sub CmdCancel_Click()
    blnIsOK = False
    Unload Me
End Sub

Private Sub cmdOK_Click()
Dim x As Printer
    If Val(SpiCount(1).Text) < Val(SpiCount(0).Text) Then
        SpiCount(1).Text = Val(SpiCount(0).Text)
    End If
    If OptPrinter.Value = True Then  '输出到打印机
        mIsPrintOnPrinter = True
        RedefineProperty
        SaveToDataBase
        blnIsOK = True
    Else   '输出到文件
        mIsPrintOnPrinter = False
        DlgPrint.Filter = StrFileName(CboFile.ListIndex)
        Dim TempString As String
        TempString = StringOut(StrFileName(CboFile.ListIndex), "|")
        TempString = StringOut(StrFileName(CboFile.ListIndex), "|")
        DlgPrint.FileName = TempString
        DefineFileType   '定义文件类型
        DlgPrint.ShowSave
        mStrFileName = DlgPrint.FileName
        If mStrFileName = TempString Then   '如果在另存窗体按取消
            blnIsOK = False
        Else
            blnIsOK = True
        End If
    End If
    Unload Me
End Sub
Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_Load()

    SpiNumbersCopies.Text = "1"
    SpiCount(0).Text = "1"
    SpiCount(1).Text = "1"
    Me.HelpContextID = 10021

    InitArray  '初始化数组
    LoadResMap
    Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    
    OptPrinter.Value = True
    OptPrintAll.Value = True
    InitCboFile
    InitPropertyByDataBase
    InitObject
    CboFile.ListIndex = 0
    SpiCount(0).Min = mBeginPagePrint
    SpiCount(1).Max = mEndPagePrint
    If mintType = 1 Then  '报表
        ChkCatenaPrint.Visible = False
    Else  '帐册
        ChkCatenaPrint.Visible = True
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set cmdOk.Picture = Nothing
    Set cmdCancel.Picture = Nothing
    Utility.RemoveFormResPicture 139
    Utility.RemoveFormResPicture 1001
    Utility.RemoveFormResPicture 1002
End Sub

Private Sub OptFile_Click()
    CboPrinterName.Enabled = False
    CmdAttrib.Enabled = False
    ChkColorPrint.Enabled = False
    CboFile.Enabled = True
End Sub

Private Sub OptPrintAll_Click()
    Label5.Enabled = False
    Label6.Enabled = False
    SpiCount(0).Enable = False
    SpiCount(1).Enable = False
End Sub

Private Sub OptPrinter_Click()
    CboPrinterName.Enabled = True
    CmdAttrib.Enabled = True
    ChkColorPrint.Enabled = True
    CboFile.Enabled = False
End Sub


Private Sub OptPrintPage_Click()
    Label5.Enabled = True
    Label6.Enabled = True
    SpiCount(0).Enable = True
    SpiCount(1).Enable = True
End Sub

Private Sub SpiCount_Change(Index As Integer)
    If IsValid(SpiCount(Index)) = False Then Exit Sub
    If IsGreate(SpiCount(Index)) = True Then Exit Sub
    If IsSmall(SpiCount(Index)) = True Then Exit Sub
End Sub


Private Sub SpiCount_GotFocus(Index As Integer)
    mstrOld = SpiCount(Index).Text
End Sub

Private Sub SpiCount_LostFocus(Index As Integer)
    CheckEmpty SpiCount(Index)
    If Index = 1 Then
        blnIsGreat
    End If
End Sub
Private Sub SpiNumbersCopies_Change()
    If IsValid(SpiNumbersCopies) = False Then Exit Sub
    If IsGreate(SpiNumbersCopies) = True Then Exit Sub
    If IsSmall(SpiNumbersCopies) = True Then Exit Sub
End Sub
Private Sub SpiNumbersCopies_GotFocus()
    mstrOld = SpiNumbersCopies.Text
End Sub

Private Sub SpiNumbersCopies_LostFocus()
    CheckEmpty SpiNumbersCopies
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                         私有过程
'
Private Sub InitArray()
    strX(0) = "2080"                         '"8.5 in"
    strY(0) = "2700"                         '"11 in"
    strX(1) = "2080"                         '"8.5 in"
    strY(1) = "2700"                         '"11 in"
    strX(2) = "2700"                         '"11 in"
    strY(2) = "4170"                         '"17 in"
    strX(3) = "4170"                         '"17 in"
    strY(3) = "2700"                         '"11 in"
    strX(4) = "2080"                         '"8.5 in"
    strY(4) = "3430"                         '"14 in"
    strX(5) = "1350"                         '"5.5 in"
    strY(5) = "2080"                         '"8.5 in"
    strX(6) = "1780"                         '"7.25 in"
    strY(6) = "2570"                         '"10.5 in"
    strX(7) = "2970"
    strY(7) = "4200"
    strX(8) = "2100"
    strY(8) = "2970"
    strX(9) = "2100"
    strY(9) = "2970"
    strX(10) = "1480"
    strY(10) = "2100"
    strX(11) = "2500"
    strY(11) = "3540"
    strX(12) = "1820"
    strY(12) = "2570"
    strX(13) = "2080"                        '"8.5 in"
    strY(13) = "3190"                        '"13 in"
    strX(14) = "2150"
    strY(14) = "2750"
    strX(15) = "2450"                        '"10 in"
    strY(15) = "3430"                        '"14 in"
    strX(16) = "2700"                        '"11 in"
    strY(16) = "4170"                       '"17 in"
    strX(17) = "2080"                        '"8.5 in"
    strY(17) = "2790"                        ' "11 in"
    strX(18) = "980"
    strY(18) = "2250"
    strX(19) = "3110"
    strY(19) = "2790"
    strX(20) = "2000"
    strY(20) = "2000"

End Sub

Private Function IsSmall(XSpinText As SpinEdit) As Boolean
    If XSpinText.Text <> "" Then
        If CInt(XSpinText.Text) < XSpinText.Min Then
            Utility.ShowMsg Me.hWnd, "超过最小值!", vbOKOnly + vbExclamation, "格式设置"
            XSpinText.Text = mstrOld
            IsSmall = True
        Else
            IsSmall = False
        End If
    End If
End Function

Private Sub SaveToDB(XX As DEVMODE)
Dim strSQL As String
    
    If mblnFixPrint Then Exit Sub
    If XX.dmPaperSize = 256 Then '自定义纸张
        mlngOldPaperLength = XX.dmPaperLength   '保存为 0.1毫米
        mlngOldPaperWidth = XX.dmPaperWidth     '保存为 0.1毫米
    Else
        If XX.dmPaperSize > 0 And XX.dmPaperSize < 21 Then  '在所定义的纸张范围内
            mlngOldPaperLength = strY(XX.dmPaperSize - 1)
            mlngOldPaperWidth = strX(XX.dmPaperSize - 1)
        End If
    End If
    mintOldOrientation = XX.dmOrientation
    mlngOldPaperSize = XX.dmPaperSize
    strSQL = "UPDATE  PrintSetup Set lngOrientation =" & mintOldOrientation & ",intPaperSizeIndex=" & mlngOldPaperSize & ",lngPaperSize =" & mlngOldPaperSize _
            & ",lngPaperLength = " & mlngOldPaperLength & ",lngPaperWidth=" & mlngOldPaperWidth _
            & " Where lngPrintSetupID = " & mlngPrintSetupID
    gclsBase.ExecSQL strSQL
End Sub
Private Sub InitPrintObj(XX As DEVMODE)
    With XX
        .dmOrientation = mintOldOrientation
        .dmPaperSize = mlngOldPaperSize
        .dmPaperLength = mlngOldPaperLength
        .dmPaperWidth = mlngOldPaperWidth
    End With
End Sub
Private Sub InitCboFile()
Dim iFile As Integer
    StrFileName(0) = "CSV(逗号分隔)(*.csv)|*.csv"
    StrFileName(1) = "HTML 文档 (*.htm)|*.htm"
    StrFileName(2) = "纯文本(*.txt)|*.txt"
    StrFileName(3) = "Access 2.0 (*.mdb)|*.mdb"
    StrFileName(4) = "Access 7.0 (*.mdb)|*.mdb"
    StrFileName(5) = "DBASE III 文件 (*.dbf)|*.dbf"
    StrFileName(6) = "DBASE IV 文件 (*.dbf)|*.dbf"
    StrFileName(7) = "DBASE V 文件 (*.dbf)|*.dbf"
    StrFileName(8) = "FOXPRO 2.0 文件 (*.dbf)|*.dbf"
    StrFileName(9) = "FOXPRO 2.5 文件 (*.dbf)|*.dbf"
    StrFileName(10) = "FOXPRO 2.6 文件 (*.dbf)|*.dbf"
    StrFileName(11) = "Paradox 3.X (*.db)|*.db "
    StrFileName(12) = "Paradox 4.X (*.db)|*.db "
    StrFileName(13) = "Paradox 5.X (*.db)|*.db "
    StrFileName(14) = "Excel 3.0 (*.xls)|*.xls"
    StrFileName(15) = "Excel 4.0 (*.xls)|*.xls"
    StrFileName(16) = "Excel 5.0 (*.xls)|*.xls"
    #If conWan = 1 Then
        StrFileName(17) = "万能通用表格 (*.tbl)|*.tbl"
    #Else
        StrFileName(17) = "金算盘通用表格 (*.tbl)|*.tbl"
    #End If
    For iFile = 0 To 17
        If StrFileName(iFile) <> "" Then
              CboFile.AddItem Left(StrFileName(iFile), Len(StrFileName(iFile)) - 6)
        End If
    Next iFile
    CboFile.Text = CboFile.list(0)
End Sub
Private Sub RedefineProperty()
    mDeviceName = CboPrinterName.Text
    mIsColorPrint = IIf(ChkColorPrint.Value = 1, True, False)
    mPrintRange = IIf(OptPrintAll.Value = True, 0, 1)
    mBeginPagePrint = CInt(SpiCount(0).Text)
    mEndPagePrint = CInt(SpiCount(1).Text)
    mCopiesPrint = CInt(SpiNumbersCopies.Text)
    mIsPagebyPage = IIf(ChkCopies.Value = 1, True, False)
    mIsDoublePrint = IIf(ChkDouble.Value = 1, True, False)
    mIsPrintByOrderOne = IIf(ChkOrder1.Value = 1, True, False)
    mIsPrintbyPrderTwo = IIf(ChkOrder2.Value = 1, True, False)
    mblnIsTaoDa = IIf(ChkTaoDa.Value = 1, True, False)
    mblnLianDa = IIf(ChkCatenaPrint.Value = 1, True, False)
End Sub



Private Sub SaveToDataBase()
Dim strSQL As String
    strSQL = "UPDATE  PrintSetup Set blnIsColorPrint =" & IIf(mIsColorPrint, 1, 0) & ",blnIsPrintPageByPage =" & IIf(mIsPagebyPage, 1, 0) _
            & ",intDuplex=" & IIf(mIsDoublePrint, 2, 1) & ",blnIsPrintByOrder1=" & IIf(mIsPrintByOrderOne, 1, 0) & ",blnIsPrintByOrder2=" & IIf(mIsPrintbyPrderTwo, 1, 0) _
            & " Where lngPrintSetupID = " & mlngPrintSetupID
    gclsBase.ExecSQL strSQL
End Sub
Private Sub CheckEmpty(XSpiText As SpinEdit)
    If XSpiText.Text = "" Then
        XSpiText.Text = mstrOld
    End If
End Sub


Private Sub DefineFileType()
Dim FileType As Integer
Dim FileIndex As Integer
    If CboFile.ListIndex < 3 Then
        FileType = CboFile.ListIndex + 1
    Else
        If CboFile.ListIndex = 17 Then   '如果是金算盘通用表格
           FileType = 5
        Else
           FileType = 4
        End If
    End If
    If CboFile.ListIndex >= 3 Then
        FileIndex = CboFile.ListIndex - 3
    End If
    mintFileType = FileType
    mintFileIndex = FileIndex
End Sub
Private Sub LoadResMap()
    cmdOk.Picture = GetFormResPicture(1001, vbResBitmap)
    cmdCancel.Picture = GetFormResPicture(1002, vbResBitmap)
End Sub

Private Sub InitPropertyByDataBase()
Dim strSQL As String
Dim rstInit As rdoResultset
    strSQL = "Select * from PrintSetup Where lngPrintSetupID = " & mlngPrintSetupID
    Set rstInit = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    With rstInit
        mIsColorPrint = !blnIsColorPrint
        mIsPagebyPage = !blnIsPrintPageByPage
        mIsColorPrint = !blnIsColorPrint
        mIsDoublePrint = IIf(!intDuplex = 2, 1, 0)
        mIsPrintByOrderOne = !blnIsPrintByOrder1
        mIsPrintbyPrderTwo = !blnIsPrintByOrder2
        
        mintOldOrientation = !lngOrientation
        mlngOldPaperSize = !lngPaperSize
        mlngOldPaperLength = !lngPaperLength
        mlngOldPaperWidth = !lngPaperWidth
    End With
End Sub
Private Sub InitObject()
        ChkColorPrint.Value = IIf(mIsColorPrint, 1, 0)
        ChkCopies.Value = IIf(mIsPagebyPage, 1, 0)
    
        If mIsDoublePrint Then
           ChkDouble.Value = 1
           ChkOrder1.Enabled = True
           ChkOrder2.Enabled = True
        Else
           ChkDouble.Value = 0
           ChkOrder1.Enabled = False
           ChkOrder2.Enabled = False
        End If
        
        ChkOrder1.Value = IIf(mIsPrintByOrderOne, 1, 0)
        ChkOrder2.Value = IIf(mIsPrintbyPrderTwo, 1, 0)
    
        SpiCount(0).Min = 1
        SpiCount(0).Max = mEndPagePrint
        SpiCount(1).Min = 1
        SpiCount(1).Max = mEndPagePrint
        SpiCount(0).Text = CStr(mBeginPagePrint)
        SpiCount(1).Text = CStr(mEndPagePrint)
End Sub
Private Function IsValid(XSpinText As SpinEdit) As Boolean
    If IsNumeric(XSpinText.Text) = False And XSpinText.Text <> "" Then
        Utility.ShowMsg Me.hWnd, "非法字符!", vbExclamation + vbOKOnly, "格式设置"
        XSpinText.Text = mstrOld
        IsValid = False
    Else
        IsValid = True
    End If
End Function
Private Function IsGreate(XSpiText As SpinEdit) As Boolean
    If XSpiText.Text <> "" Then
        If CInt(XSpiText.Text) > XSpiText.Max Then
            Utility.ShowMsg Me.hWnd, "超过最大值!", vbOKOnly + vbExclamation, "格式设置"
            XSpiText.Text = mstrOld
            IsGreate = True
        Else
            IsGreate = False
        End If
    End If
End Function

Private Function blnIsGreat() As Boolean
    If CLng(SpiCount(1).Text) < CLng(SpiCount(0).Text) Then
       Utility.ShowMsg Me.hWnd, "终止页不能小于起始页!", vbOKOnly + vbInformation, "打印"
       blnIsGreat = True
       SpiCount(1).Text = mstrOld
    Else
       blnIsGreat = False
    End If
End Function