frmloaninfor.frm

用友u8财务源码,用visual basic开发

        .SetColProperty 0, 15
        .TextMatrix(0, 15) = "已还利息额"
        .SetColProperty 0, 15
        .TextMatrix(0, 16) = "结欠利息额"
        .SetColProperty 0, 15
        .TextMatrix(0, 17) = "审核"
        .SetColProperty 0, 10
        .TextMatrix(0, 18) = "记账"
        .SetColProperty 0, 10
        .TextMatrix(0, 19) = "制单"
        .SetColProperty 0, 10
        .TextMatrix(0, 20) = "摘要"
        .SetColProperty 0, 60
    End With
End Sub
'初始化打印数据XML文件
Private Sub initPrnXmlFile()
    '过程变量
    Dim prnxml As New clsPrnXml
    Dim AttrName() As String
    Dim AttrValue() As String
    Dim i, j As Integer
    Dim str1 As String
    
    On Error GoTo error0
    
    '插入结构数据数据
    str1 = "贷款汇总表"
    prnxml.Initialize "数据", "任务"
    prnxml.InsertPNode "任务", "页眉", "第%p页，共%p页"
    prnxml.InsertPNode "任务", "标题", str1
    prnxml.InsertPNode "任务", "表头", ""
    prnxml.InsertPNode "任务", "表体", ""
    prnxml.InsertPNode "任务", "表尾", ""
    prnxml.InsertPNode "任务", "页脚", "用友软件"
    
    ReDim AttrName(2, 1)
    ReDim AttrValue(2)
    
    '插入表头,表尾数据
    For i = 0 To UBound(AttrName)
        AttrName(i, 0) = "名字"
    Next
    '插入表头,表尾数据
    AttrName(0, 1) = "单位名称"
    AttrName(1, 1) = "开始日期"
    AttrName(2, 1) = "结束日期"
    AttrValue(0) = Trim(text1.Caption)
    AttrValue(1) = CStr(Format(lblksrq.Caption, "YYYY-MM-DD"))
    AttrValue(2) = CStr(Format(lbljsrq.Caption, "YYYY-MM-DD"))
    prnxml.InsertHeadNodes "表头", "字段", AttrName, AttrValue
    
    '插入表体头数据
    ReDim AttrName(20, 1)
    ReDim AttrValue(20)
    For i = 0 To 20
        AttrName(i, 0) = "单元"
        AttrValue(i) = ufgridado1.TextMatrix(0, i)
    Next
    prnxml.InsertBodyNodes "表体", "表体头", AttrName, AttrValue
    For i = 0 To 20
        AttrValue(i) = ""
    Next
    
    '插入表体行数据
     With ufgridado1
        For i = 1 To .Rows - 1
            For j = 0 To 20
                AttrValue(j) = .TextMatrix(i, j)
            Next
        prnxml.InsertBodyNodes "表体", "表体行", AttrName, AttrValue
        Next
    End With
    
        ReDim AttrName(1, 1)
    ReDim AttrValue(1)
    For i = 0 To UBound(AttrName)
        AttrName(i, 0) = "名字"
    Next
 
    AttrName(0, 1) = "制单人"
    AttrName(1, 1) = "打印日期"
    
    AttrValue(0) = Trim(lblBillName.Caption)
    AttrValue(1) = CStr(Format(CDate(Trim(lblPrnDate.Caption)), "YYYY-MM-DD"))
    prnxml.InsertHeadNodes "表尾", "字段", AttrName, AttrValue

    '保存数据文件
    prnxml.saveFile "tloanInfoData.xml"
    If initStyleXml Then
        If prnDataBind Then
            xmlInit = True
        Else
            xmlInit = False
        End If
    Else
        xmlInit = False
    End If
    Set prnxml = Nothing
    Exit Sub
error0:
    MsgBox "打印数据准备失败！" & vbCrLf & Err.Description, vbInformation, "错误信息"
'    If rs.State = adStateOpen Then
'        rs.Close
'    End If
    xmlInit = False
    Set prnxml = Nothing
End Sub

Private Function prnDataBind() As Boolean
    Dim lRet As Long
    Dim sData As String
    Dim sStyle As String
    Dim sModuleId As String
    
    sData = App.Path & "\tloanInfodata.xml"
    sStyle = App.Path & "\tloanInfoStyle.xml"
    sModuleId = "default"
    lRet = Printer.SetDataStyleXML(sData, 1, sStyle, 1, sModuleId)
    If lRet = 0 Then
        prnDataBind = True
    Else
        prnDataBind = False
        MsgBox "打印数据准备失败！", vbInformation, "错误信息"
    End If
End Function
'打印处理程序
Private Sub printProc()
    If Not xmlInit Then
        Call initPrnXmlFile
    End If
    If xmlInit Then
        Printer.DoPrint
    End If
End Sub
'预览处理程序
Private Sub previewProc()
    If Not xmlInit Then
        Call initPrnXmlFile
    End If
    If xmlInit Then
        Printer.PrintPreview
    End If
End Sub
'输出处理程序
Private Sub outputProc()
    If Not xmlInit Then
        Call initPrnXmlFile
    End If
    If xmlInit Then
        Dim sTypeList As String
        Dim sSizeList As String
        Dim i As Long
        Dim e As Long
    
        i = 0
        sTypeList = "10,8,7,10,10,7,10,10,10,7,10,10,8,7,7,7,7,10,10,10,10"
        sSizeList = "28,10,15,10,12,15,20,20,8,8,8,32,10,15,15,15,15,10,10,10,60"
        e = Printer.ExportToFile(i, sTypeList, sSizeList, "", "")
    '    MsgBox e
    End If
End Sub
'保存用户设置
Private Sub printer_SettingChanged(ByVal varLocalSettings As Variant, ByVal varModuleSettings As Variant)
    Dim xmlstr As String
    xmlstr = "<?xml version='1.0' standalone='yes' ?>"
    xmlstr = xmlstr & "<格式>"
    xmlstr = xmlstr & varLocalSettings
    xmlstr = xmlstr & varModuleSettings
    xmlstr = xmlstr & "</格式>"
    Dim rs As New ADODB.Recordset
    On Error GoTo error0
    rs.Open "select * from prn_format where moduleid='loanInfoprn'", con, adOpenDynamic, adLockOptimistic
    rs("formatXml") = xmlstr
    rs.Update
    rs.Close
    Set rs = Nothing
    Exit Sub
error0:
    If rs.State = adStateOpen Then
        rs.Close
    End If
    Set rs = Nothing
    MsgBox "打印设置保存失败！"
End Sub
'设置打印格式
Private Function initStyleXml() As Boolean
    Dim rs As New ADODB.Recordset
    Dim PrnDom As New DOMDocument
    Dim xmlstr As String
    
    sqlstr = "select formatXml from PRN_format where moduleID='loanInfoprn'"
    rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    If Not (rs.EOF Or rs.BOF) Then
        xmlstr = Trim(rs("formatXml"))
    Else
        xmlstr = "<?xml version=''1.0'' standalone=''yes'' ?>"
        xmlstr = xmlstr & "<格式>"
        xmlstr = xmlstr & "<打印设置 打印范围=''全部'' 页码范围=''1-1'' 打印份数=''1'' 压缩=''是'' 多任务强制分页=''否'' />"
        xmlstr = xmlstr & "<纸张设置 纸张类型=''9'' 纸张大小=''2100,2970'' 打印方向=''纵向'' 页边距=''300,200,200,200'' />"
        xmlstr = xmlstr & "<页眉 对齐方式=''右'' 左顶点=''0,0'' 宽=''0'' 高=''100'' 字体名=''楷体_GB2312'' 字体大小=''12'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 打印=''是'' />"
        xmlstr = xmlstr & "<标题 对齐方式=''中'' 左顶点=''0,200'' 宽=''0'' 高=''300'' 字体名=''黑体'' 字体大小=''24'' 颜色=''#000000'' 粗体=''是'' 斜体=''否'' 打印=''是'' /> "
        xmlstr = xmlstr & "<表头 对齐方式=''左'' 左顶点=''0,500'' 宽=''1600'' 高=''300'' 字体名=''宋体'' 字体大小=''12'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 打印=''是''>"
        xmlstr = xmlstr & "<字段 打印=''是'' 名字=''单位名称'' 对齐方式=''左'' 左顶点=''200,500'' 宽=''800'' 高=''200'' 字体名=''黑体'' 字体大小=''16'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 标题宽度=''0'' 下标线=''否'' />"
        xmlstr = xmlstr & "<字段 打印=''是'' 名字=''开始日期'' 对齐方式=''左'' 左顶点=''200,700'' 宽=''600'' 高=''140'' />"
        xmlstr = xmlstr & "<字段 打印=''是'' 名字=''结束日期'' 对齐方式=''左'' 左顶点=''800,700'' 宽=''600'' 高=''140'' />"
        xmlstr = xmlstr & "</表头>"
        xmlstr = xmlstr & "<表体 左顶点=''0,800'' 宽=''0'' 高=''0'' 固定行数=''0'' 列宽=''280,100,150,100,120,150,200,200,80,80,80,320,100,150,150,150,150,100,100,100,600''>"
        xmlstr = xmlstr & "<表体头 对齐方式=''中'' 边框风格=''783'' 边框宽度=''2'' 行高=''140'' 字体名=''黑体'' 字体大小=''14'' 颜色=''#000000'' 粗体=''是'' 斜体=''否'' 打印=''是'' />"
        xmlstr = xmlstr & "<表体行 对齐方式=''左,左,左,左,左,左,左,左,左,左,左,左,左,左,左,左,左,左,左,左,左'' 边框风格=''783'' 边框宽度=''2'' 行高=''0'' 字体名=''Times New Roman'' 字体大小=''12'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 打印=''是'' />"
        xmlstr = xmlstr & "<表体尾 对齐方式=''中'' 边框风格=''783'' 边框宽度=''2'' 行高=''140'' 字体名=''黑体'' 字体大小=''14'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 打印=''是'' />"
        xmlstr = xmlstr & "</表体>"
        xmlstr = xmlstr & "<表尾 对齐方式=''左'' 左顶点=''0,2200'' 宽=''1600'' 高=''200'' 字体名=''新宋体'' 字体大小=''12'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 打印=''是''>"
        xmlstr = xmlstr & "<字段 打印=''是'' 名字=''制单人'' 对齐方式=''左'' 左顶点=''50,2200'' 宽=''500'' 高=''200'' 字体名='''' 字体大小=''12'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 标题宽度=''0'' 下标线=''否'' />"
        xmlstr = xmlstr & "<字段 打印=''是'' 名字=''打印日期'' 对齐方式=''右'' 左顶点=''800,2200'' 宽=''600'' 高=''150'' 字体名='''' 字体大小=''12'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 标题宽度=''0'' 下标线=''否'' />"
        xmlstr = xmlstr & "</表尾>"
        xmlstr = xmlstr & "<页脚 对齐方式=''右'' 左顶点=''0,2400'' 宽=''0'' 高=''170'' 字体名=''楷体_GB2312'' 字体大小=''10'' 颜色=''#000000'' 粗体=''否'' 斜体=''否'' 打印=''是'' />"
        xmlstr = xmlstr & "</格式>"
        sqlstr = "insert into PRN_format (moduleID,FormatXml) values('loaninfoprn','" & xmlstr & "');"
        On Error GoTo Error1
        con.BeginTrans
        con.Execute sqlstr
        con.CommitTrans
        xmlstr = "<?xml version='1.0' standalone='yes' ?>"
        xmlstr = xmlstr & "<格式>"
        xmlstr = xmlstr & "<打印设置 打印范围='全部' 页码范围='1-1' 打印份数='1' 压缩='是' 多任务强制分页='否' />"
        xmlstr = xmlstr & "<纸张设置 纸张类型='9' 纸张大小='2100,2970' 打印方向='纵向' 页边距='300,200,200,200' />"
        xmlstr = xmlstr & "<页眉 对齐方式='右' 左顶点='0,0' 宽='0' 高='100' 字体名='楷体_GB2312' 字体大小='12' 颜色='#000000' 粗体='否' 斜体='否' 打印='是' />"
        xmlstr = xmlstr & "<标题 对齐方式='中' 左顶点='0,200' 宽='0' 高='300' 字体名='黑体' 字体大小='24' 颜色='#000000' 粗体='是' 斜体='否' 打印='是' /> "
        xmlstr = xmlstr & "<表头 对齐方式='左' 左顶点='0,500' 宽='1600' 高='300' 字体名='宋体' 字体大小='12' 颜色='#000000' 粗体='否' 斜体='否' 打印='是'>"
        xmlstr = xmlstr & "<字段 打印='是' 名字='单位名称' 对齐方式='左' 左顶点='200,500' 宽='800' 高='200' 字体名='黑体' 字体大小='16' 颜色='#000000' 粗体='否' 斜体='否' 标题宽度='0' 下标线='否' />"
        xmlstr = xmlstr & "<字段 打印='是' 名字='开始日期' 对齐方式='左' 左顶点='200,700' 宽='600' 高='140' />"
        xmlstr = xmlstr & "<字段 打印='是' 名字='结束日期' 对齐方式='左' 左顶点='800,700' 宽='600' 高='140' />"
        xmlstr = xmlstr & "</表头>"
        xmlstr = xmlstr & "<表体 左顶点='0,800' 宽='0' 高='0' 固定行数='0' 列宽='280,100,150,100,120,150,200,200,80,80,80,320,100,150,150,150,150,100,100,100,600'>"
        xmlstr = xmlstr & "<表体头 对齐方式='中' 边框风格='783' 边框宽度='2' 行高='140' 字体名='黑体' 字体大小='14' 颜色='#000000' 粗体='是' 斜体='否' 打印='是' />"
        xmlstr = xmlstr & "<表体行 对齐方式='左,左,左,左,左,左,左,左,左,左,左,左,左,左,左,左,左,左,左,左,左' 边框风格='783' 边框宽度='2' 行高='0' 字体名='Times New Roman' 字体大小='12' 颜色='#000000' 粗体='否' 斜体='否' 打印='是' />"
        xmlstr = xmlstr & "<表体尾 对齐方式='中' 边框风格='783' 边框宽度='2' 行高='140' 字体名='黑体' 字体大小='14' 颜色='#000000' 粗体='否' 斜体='否' 打印='是' />"
        xmlstr = xmlstr & "</表体>"
        xmlstr = xmlstr & "<表尾 对齐方式='左' 左顶点='0,1800' 宽='1600' 高='200' 字体名='新宋体' 字体大小='12' 颜色='#000000' 粗体='否' 斜体='否' 打印='是'>"
        xmlstr = xmlstr & "<字段 打印='是' 名字='制单人' 对齐方式='左' 左顶点='50,1800' 宽='500' 高='200' 字体名='' 字体大小='12' 颜色='#000000' 粗体='否' 斜体='否' 标题宽度='0' 下标线='否' />"
        xmlstr = xmlstr & "<字段 打印='是' 名字='打印日期' 对齐方式='右' 左顶点='800,1800' 宽='600' 高='150' 字体名='' 字体大小='12' 颜色='#000000' 粗体='否' 斜体='否' 标题宽度='0' 下标线='否' />"
        xmlstr = xmlstr & "</表尾>"
        xmlstr = xmlstr & "<页脚 对齐方式='右' 左顶点='0,2400' 宽='0' 高='170' 字体名='楷体_GB2312' 字体大小='10' 颜色='#000000' 粗体='否' 斜体='否' 打印='是' />"
        xmlstr = xmlstr & "</格式>"

    End If
    If PrnDom.loadXML(Trim(xmlstr)) Then
        PrnDom.Save App.Path & "\tloanInfoStyle.xml"
    Else
       initStyleXml = False
    End If
    initStyleXml = True
    
    rs.Close
    Set rs = Nothing
    Set PrnDom = Nothing
    Exit Function
Error1:
    initStyleXml = False
    con.RollbackTrans
    rs.Close
    Set rs = Nothing
    Set PrnDom = Nothing
End Function


Private Sub ufgridado1_RowColChange()
    Dim i As Long
    On Error Resume Next
    i = UBound(cunitName)
    If Err.Number <> 0 Then
        'Text1.Text = ""
        Exit Sub
    End If
    
    If ufgridado1.row <= i + 1 Then
        text1.Caption = cunitName(ufgridado1.row - 1)
    End If
    
End Sub

Private Sub loadstatic()
    Me.Icon = LoadResPicture(109, vbResIcon)
    ImageList1.ListImages.Add , "print", LoadResPicture(314, vbResBitmap)
    ImageList1.ListImages.Add , "preview", LoadResPicture(312, vbResBitmap)
    ImageList1.ListImages.Add , "output", LoadResPicture(263, vbResBitmap)
    ImageList1.ListImages.Add , "find", LoadResPicture(331, vbResBitmap)
    ImageList1.ListImages.Add , "help", LoadResPicture(396, vbResBitmap)
    ImageList1.ListImages.Add , "exit", LoadResPicture(1118, vbResBitmap)
    
    With tlbtool
        .Buttons("print").Caption = "打印"
        .Buttons("print").Image = "print"
        .Buttons("print").ToolTipText = "Ctrl+p"
        
        .Buttons("preview").Caption = "预览"
        .Buttons("preview").Image = "preview"
        .Buttons("preview").ToolTipText = "Alt+V"
        
        .Buttons("output").Caption = "输出"
        .Buttons("output").Image = "output"
        .Buttons("output").ToolTipText = "Ctrl+O"
        
        .Buttons("find").Caption = "查询"
        .Buttons("find").Image = "find"
        .Buttons("find").ToolTipText = "F3"
        
        .Buttons("help").Caption = "帮助"
        .Buttons("help").Image = "help"
        .Buttons("help").ToolTipText = "F1"
        
        .Buttons("exit").Caption = "退出"
        .Buttons("exit").Image = "exit"
        .Buttons("exit").ToolTipText = "Ctrl+F4"
    End With
End Sub