modexport2jpg.bas

超经典的打印预览动态库源码 版权： 本资源版权归作者所有 说明： 本资源由源码天空搜集,仅提供学习参考

Attribute VB_Name = "ModExport2Jpg"

Option Explicit
'**************************************************************
'*模块名称：ModExport2Jpg
'*模块功能：输出到Jpg图形文件
'*说明：
'*
'*备注：
'*
'*作者：chlf78
'*日期：2002-04-10 10:58:16
'***************************************************************

Private Const ModalName = "ModExport2Jpg"

Private Declare Function BmpToJpeg Lib "bmp2jpeg.dll" (ByVal bmpFileName As String, ByVal JpegFilename As String, ByVal CompressQuality As Integer) As Integer


'**************************************************************
'*名称：funExport2Jpg
'*功能：输出到Jpg图形文件
'*传入参数：
'*      rpt         --报表对象
'*      filepath    --文件夹位置
'*      pic         --先输出到图形控件
'*      pageFrom       --页起始
'*      cutPageFrom      --分页起始
'*      pageTo         --页终止
'*      cutPageTo        --分页终止
'*      sRate       --缩放比例
'*      isBmp       --是否生成BMP文件，否则生成JPG文件
'*      preFix      --生成的文件前缀
'*返回参数：
'*      是否输出成功
'*作者：chlf78
'*日期：2002-04-10 10:58:42
'***************************************************************
Public Function funExport2Jpg(rpt As Report, _
                              filepath As String, _
                              pic As PictureBox, _
                              pageFrom As Integer, cutPageFrom As Integer, _
                              pageTo As Integer, cutPageTo As Integer, _
                              sRate As Single, Optional isBmp As Boolean = False, _
                              Optional preFix As String = "") _
    As Boolean
                              
Dim cutpage         As Integer
Dim page            As Integer
Dim bmpFileName     As String
Dim jpgFileName     As String

Dim str             As String
    
    funExport2Jpg = False
    
    On Error GoTo err_proc

    '*改变当前目录，以找到Bmp2Jpeg入口
    str = CurDir
    ChDir App.Path
    
    For page = pageFrom To pageTo
        For cutpage = 1 To rpt.cutpages
            If Not ((page = pageFrom And cutpage < cutPageFrom) _
                    Or (page = pageTo And cutpage > cutPageTo)) Then
                '*改变PictureBox的大小
                pic.width = rpt.width * sRate
                pic.height = rpt.height * sRate
                
                '*输出
                pic.Cls
                rpt.PrintIt pic, page, cutpage, sRate
                    
                '*保存为bmp文件
                bmpFileName = filepath & "\" & preFix & page & "_" & cutpage & ".bmp"
                jpgFileName = filepath & "\" & preFix & page & "_" & cutpage & ".jpg"
                SavePicture pic.Image, bmpFileName
                
                If Not isBmp Then
                    '*转换成jpg文件
                    BmpToJpeg bmpFileName, jpgFileName, 100
        
                    '*删除bmp文件
                    Kill bmpFileName
                End If
            End If
        Next cutpage
    Next page
    
    funExport2Jpg = True
    
    '*恢复目录
    On Error Resume Next
    ChDir str
    Exit Function
    
'*错误处理
err_proc:
    funExport2Jpg = False
    MsgBox Err.Description
End Function