我先把我用VB做的一个程序弄上来发吧，你看看你还想要什么，或者我们一起探讨。我目前
对formula正感兴趣呢。
'打印机进纸口编号
' 257 tray 1
' 258 tray 2
' 259 tray 3
' 260 tray 4
' 261 tray 5
Option Explicit
Public LastState As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const SC_RESTORE = &HF120&
Private Const SC_SIZE = &HF000&
Dim crtUID As String
Dim crtPsw As String
Dim crxDatabaseTable As craxdrt.DatabaseTable
Dim crxTextObject As craxdrt.TextObject
Dim crxObject As Object
Dim crxApplication As New craxdrt.Application
'Declare the report object
Public Report As craxdrt.Report
Dim ADOrs As New ADODB.Recordset
Dim ADOcmd As New ADODB.Command
Dim ADOconn As New ADODB.Connection
Dim rptFace, rptFace1, rptCash, rptCash1 As craxdrt.Report
Dim tb As NOTIFYICONDATA
Dim nPageCount As Integer
Public Sub OpenDatabase()
On Error Resume Next
If ADOconn.State <> adStateClosed then
ADOconn.Close
ADOconn.Open ("Driver={Microsoft ODBC for Oracle};Server=" &
strServer &
";Uid=" &
strUserName &
";Pwd=" &
strPassword)
If ADOconn.State = adStateOpen then
StatusBar1.SimpleText = "已经连接到数据库 " &
strServer
else
StatusBar1.SimpleText = "连接数据库 " &
strServer &
"失败"
End If
End Sub
Private Sub Check1_Click()
'Timer1.Enabled = Not Timer1.Enabled
If Check1.Value = Checked then
Timer1.Enabled = False
else
Timer1.Enabled = True
End If
End Sub
Private Sub Command1_Click()
Dim ret
ret = QueryDatabase(CInt(Text1.Text), False)
End Sub
'团险报表生成函数
'团险保单打印，参数1 Policy_id为团单的ID号，在打印分单时要先查出分单的POLICY_ID再用个险的打印方式打印，但模板不一样
Private Function QueryGroupDatabase(Print_id As Integer, Printed As Boolean) As Integer
Dim strSQL
Dim nFlag As Integer '长期险和短期的标志：1:短期；2:长期。注：约定，团单为长期，则分单一定为长期
Dim nPrintFlag As Integer
Dim rs As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
'载入封面
Set Report = crxApplication.OpenReport(strAppPath &
"/团险封面.rpt")
Set crxDatabaseTable = Report.Database.Tables.Item(1)
crxDatabaseTable.SetLogOnInfo "taiping", , crtUID, crtPsw
Report.SQLQueryString = "SELECT POLICY_CODE, HOLDER_NAME,HOLDER_DATE,PRODUCT_NAME FROM T_GROUP_POLICY_PRINT_MAIN,T_GROUP_POLICY_PRINT_PRODUCT WHERE T_GROUP_POLICY_PRINT_MAIN.POLICY_PRINT_ID = T_GROUP_POLICY_PRINT_PRODUCT.POLICY_PRINT_ID and T_GROUP_POLICY_PRINT_PRODUCT.MAIN_RIDER = '1' AND T_GROUP_POLICY_PRINT_MAIN.POLICY_PRINT_ID = " &
Print_id
PrintReport (Printed)
If ADOrs.State <> adStateClosed then
ADOrs.Close
'根据人团险保单类型（长期型，短期型）读入不同的保单模板
strSQL = "select distinct pl.one_year,gp.printed from t_group_policy_print_main gp,t_group_policy_product gpp,t_product_life pl Where gp.policy_id = gpp.policy_id(+) and gp.policy_print_id = " &
Print_id &
" and gpp.product_id = pl.product_id(+)"
ADOrs.Open strSQL, ADOconn, 1, 1
If ADOrs.Fields("one_year") = "Y" then
nFlag = 1 '短期
else
nFlag = 2 '长期
End If
'1，已经打印；2，全部打印；3，只打印主单；4，只打印分单；
nPrintFlag = ADOrs.Fields("printed")
If nPrintFlag = 2 Or nPrintFlag = 3 then
If nFlag = 2 then
Set Report = crxApplication.OpenReport(strAppPath &
"/团险长期险模板.rpt", 1)
else
If nFlag = 1 then
Set Report = crxApplication.OpenReport(strAppPath &
"/团险短期险模板.rpt", 1)
End If
Set crxDatabaseTable = Report.Database.Tables.Item(1)
crxDatabaseTable.SetLogOnInfo "taiping", , crtUID, crtPsw
strSQL = "SELECT DISTINCT T_GROUP_POLICY_PRINT_MAIN.POLICY_CODE, T_GROUP_POLICY_PRINT_MAIN.AREA, T_GROUP_POLICY_PRINT_MAIN.HOLDER_NAME, T_GROUP_POLICY_PRINT_MAIN.HOLDER_ADDRESS, T_GROUP_POLICY_PRINT_MAIN.HOLDER_DATE, T_GROUP_POLICY_PRINT_MAIN.EFFECT_DATE, T_GROUP_POLICY_PRINT_MAIN.POLICY_YEAR, T_GROUP_POLICY_PRINT_MAIN.VALID_PERIOD, T_GROUP_POLICY_PRINT_MAIN.AGENT_CODE, T_GROUP_POLICY_PRINT_MAIN.AGENT_organ, T_GROUP_POLICY_PRINT_MAIN.ASSUMPSIT, T_GROUP_POLICY_PRINT_PRODUCT.INSURED_NAME_1 From T_GROUP_POLICY_PRINT_MAIN T_GROUP_POLICY_PRINT_MAIN,T_GROUP_POLICY_PRINT_PRODUCT T_GROUP_POLICY_PRINT_PRODUCT Where T_GROUP_POLICY_PRINT_MAIN.POLICY_Print_ID = " &
Print_id
Report.SQLQueryString = strSQL
Set rptFace = Report.OpenSubreport("PRODUCTINFO")
strSQL = "SELECT T_GROUP_POLICY_PRINT_MAIN.SUM_FEE,T_GROUP_POLICY_PRINT_PRODUCT.AMOUNT, T_GROUP_POLICY_PRINT_PRODUCT.PREMIUM, T_GROUP_POLICY_PRINT_PRODUCT.PRODUCT_NAME From T_GROUP_POLICY_PRINT_MAIN,T_GROUP_POLICY_PRINT_PRODUCT Where T_group_POLICY_PRINT_MAIN.POLICY_PRINT_ID = " &
Print_id &
" and T_group_POLICY_PRINT_MAIN.policy_print_id = T_group_POLICY_PRINT_PRODUCT.policy_print_id"
rptFace.SQLQueryString = strSQL
toClipBoard (strSQL)
' MsgBox Report.SQLQueryString
PrintReport (Printed)
'<打印背面>
Set Report = crxApplication.OpenReport(strAppPath &
"/团险保单回执.rpt", 1)
PrintReport (Printed)
'</打印背面>
'打印图象
PrintImg Print_id, True
'打印条款
PrintItemImg Print_id, True
If Printed then
'--------------------------------置“已经打印”标志-------------------------
strSQL = "UPDATE T_GROUP_POLICY_PRINT_MAIN SET PRINTED = 1 WHERE POLICY_PRINT_ID = " &
Print_id
If ADOrs.State <> adStateClosed then
ADOrs.Close
ADOrs.Open strSQL, ADOconn, 3, 3
End If
End If
If nPrintFlag = 2 Or nPrintFlag = 4 then
'<打印分单>
Dim nPID As Integer '分单的Policy_id
strSQL = "select p.policy_id,pm.policy_print_id from t_policy p,t_policy_print_main pm,t_group_policy_print_main ppm where p.group_policy_id = ppm.policy_id and ppm.policy_print_id = " &
Print_id &
" and pm.policy_id = p.policy_id and pm.group_policy_print_id = ppm.policy_print_id and pm.Printed > 1"
If rs.State <> adStateClosed then
rs.Close
toClipBoard (strSQL)
rs.Open strSQL, ADOconn, 1, 1
do
While Not rs.EOF
nPID = rs.Fields("policy_id")
If nFlag = 1 then
'短险
Set Report = crxApplication.OpenReport(strAppPath &
"/团险个单短期险模板.rpt", 1)
else
If nFlag = 2 then
'长期险
Set Report = crxApplication.OpenReport(strAppPath &
"/团险个单长期险模板.rpt", 1)
End If
strSQL = "SELECT DISTINCT T_POLICY_PRINT_MAIN.POLICY_CODE, T_POLICY_PRINT_MAIN.HOLDER_NAME, T_POLICY_PRINT_MAIN.HOLDER_DATE, T_POLICY_PRINT_MAIN.EFFECT_DATE, T_POLICY_PRINT_MAIN.ADDRESS, T_POLICY_PRINT_MAIN.AGENT_CODE, T_POLICY_PRINT_MAIN.AGENT_Name,T_POLICY_PRINT_MAIN.ASSUMPSIT, T_POLICY_PRINT_BENIFIT.INSURED_NAME,T_POLICY_PRINT_BENIFIT.INSURED_GENDER,T_POLICY_PRINT_BENIFIT.INSURED_AGE,T_POLICY_PRINT_BENIFIT.benefit_percent,T_POLICY_PRINT_PRODUCT.INSURED_NAME_1 From T_POLICY_PRINT_MAIN, T_POLICY_PRINT_BENIFIT,T_POLICY_PRINT_PRODUCT Where T_POLICY_PRINT_MAIN.POLICY_PRINT_ID = T_POLICY_PRINT_BENIFIT.POLICY_PRINT_ID(+) and T_POLICY_PRINT_MAIN.POLICY_ID =" &
nPID &
" AND T_POLICY_PRINT_MAIN.POLICY_PRINT_ID = " &
rs.Fields("policy_print_id") &
" AND T_POLICY_PRINT_MAIN.POLICY_PRINT_ID = T_POLICY_PRINT_PRODUCT.POLICY_PRINT_ID "
Report.SQLQueryString = strSQL
Set crxDatabaseTable = Report.Database.Tables.Item(1)
crxDatabaseTable.SetLogOnInfo "taiping", , crtUID, crtPsw
toClipBoard (strSQL)
Set rptFace = Report.OpenSubreport("PRODUCTINFO")
strSQL = "SELECT T_POLICY_PRINT_MAIN.SUM_FEE,T_POLICY_PRINT_PRODUCT.AMOUNT, T_POLICY_PRINT_PRODUCT.PREMIUM, T_POLICY_PRINT_PRODUCT.PRODUCT_NAME From T_POLICY_PRINT_MAIN, T_POLICY_PRINT_PRODUCT Where T_POLICY_PRINT_MAIN.policy_ID =" &
nPID &
" And T_POLICY_PRINT_MAIN.policy_print_id = T_POLICY_PRINT_PRODUCT.policy_print_id and t_policy_print_main.policy_print_id = " &
rs.Fields("policy_print_id")
rptFace.SQLQueryString = strSQL
toClipBoard (strSQL)
If nFlag = 2 then
Set rptFace = Report.OpenSubreport("CASHVALUE")
strSQL = "select t_policy_print_cache_value.policy_year,t_policy_print_cache_value.cache_value from t_policy_print_cache_value,t_policy_print_main where t_policy_print_main.policy_print_id = t_policy_print_cache_value.policy_print_id and t_policy_print_main.policy_id = " &
nPID &
" and t_policy_print_main.policy_print_id = " &
rs.Fields("policy_print_id")
rptFace.SQLQueryString = strSQL
End If
toClipBoard (strSQL)
' MsgBox rptFace.SQLQueryString
PrintReport (Printed)
'<打印背面>
'Set Report = crxApplication.OpenReport(strAppPath &
"/团险短期险背面模板.rpt", 1)
'PrintReport (Printed)
'</打印背面>
If Printed then
'--------------------------------置“已经打印”标志-------------------------
strSQL = "UPDATE T_POLICY_PRINT_MAIN SET PRINTED = 1,print_date = sysdate WHERE POLICY_PRINT_ID = " &
Print_id
If rs1.State <> adStateClosed then
rs1.Close
rs1.Open strSQL, ADOconn, 3, 3
End If
rs.MoveNext
Loop
'</打印分单>
End If
End Function
'个险报表生成函数
Private Function QueryDatabase(Print_id As Integer, Printed As Boolean) As Integer
Dim strSQL
'Set crxDatabaseTable = Report.Database.Tables.Item(1)
'crxDatabaseTable.SetLogOnInfo "dev", , "taiping", "taiping"
If ADOrs.State <> adStateClosed then
ADOrs.Close
strSQL = "SELECT * FROM T_POLICY_PRINT_MAIN WHERE POLICY_PRINT_ID = " &
Print_id
ADOrs.Open strSQL, ADOconn, 1, 1
QueryDatabase = ADOrs.RecordCount
If ADOrs.RecordCount <= 0 then
'MsgBox "没有查询到记录！"
StatusBar1.SimpleText = Time &
" - 没有查询到记录！"
Exit Function
End If
'--------------------------打印封面和第一页保单---------------------------
Set Report = crxApplication.OpenReport(strAppPath &
"/太平保险.rpt", 1)
Set rptFace = Report.OpenSubreport("Face0")
Set rptFace1 = Report.OpenSubreport("INFO")
If ADOrs.State <> adStateClosed then
ADOrs.Close
Set crxDatabaseTable = Report.Database.Tables.Item(1)
crxDatabaseTable.SetLogOnInfo "taiping", , crtUID, crtPsw
Set crxDatabaseTable = rptFace.Database.Tables.Item(1)
crxDatabaseTable.SetLogOnInfo "taiping", , crtUID, crtPsw
strSQL = "SELECT * FROM T_POLICY_PRINT_MAIN, T_POLICY_PRINT_PRODUCT WHERE T_POLICY_PRINT_MAIN.POLICY_PRINT_ID = T_POLICY_PRINT_PRODUCT.POLICY_PRINT_ID AND T_POLICY_PRINT_MAIN.POLICY_PRINT_ID = " &
Print_id
rptFace.SQLQueryString = strSQL
strSQL = "SELECT * FROM T_POLICY_PRINT_MAIN, T_POLICY_PRINT_PRODUCT WHERE T_POLICY_PRINT_MAIN.POLICY_PRINT_ID = T_POLICY_PRINT_PRODUCT.POLICY_PRINT_ID AND T_POLICY_PRINT_MAIN.POLICY_PRINT_ID = " &
Print_id
rptFace.SQLQueryString = strSQL
'--------------------------------
'toClipBoard (strSQL)
'MsgBox rptFace.SQLQueryString
'--------------------------------
strSQL = "SELECT T_POLICY_PRINT_BENIFIT.INSURED_ID, T_POLICY_PRINT_BENIFIT.BENEFIT_TYPE, T_POLICY_PRINT_BENIFIT.BENEFIT_PERCENT, T_POLICY_PRINT_BENIFIT.INSURED_NAME, T_POLICY_PRINT_BENIFIT.INSURED_GENDER, T_POLICY_PRINT_BENIFIT.INSURED_BIRTH, T_POLICY_PRINT_BENIFIT.INSURED_CERTI, T_CUSTOMER.REAL_NAME From t_policy_print_main , T_POLICY_PRINT_BENIFIT, t_customer Where t_policy_print_main.policy_print_id = " &
Print_id &
" AND t_policy_print_main.policy_print_id = T_POLICY_PRINT_BENIFIT.policy_print_id And t_customer.customer_id = T_POLICY_PRINT_BENIFIT.benefit_id Order By T_POLICY_PRINT_BENIFIT.INSURED_ID ASC"
rptFace1.SQLQueryString = strSQL
Set crxDatabaseTable = rptFace.Database.Tables.Item(1)
crxDatabaseTable.SetLogOnInfo "taiping", , crtUID, crtPsw
'设页号
nPageCount = 2
Report.ParameterFields.Item(1).AddCurrentValue CStr(nPageCount)
If ADOrs.State <> adStateClosed then
ADOrs.Close
ADOrs.Open strSQL, ADOconn, 1, 1
rptFace.Database.SetDataSource ADOrs
strSQL = "SELECT * FROM T_POLICY_PRINT_MAIN, T_POLICY_PRINT_PRODUCT WHERE T_POLICY_PRINT_MAIN.POLICY_PRINT_ID = T_POLICY_PRINT_PRODUCT.POLICY_PRINT_ID AND T_POLICY_PRINT_MAIN.POLICY_print_ID = " &
Print_id
Report.SQLQueryString = strSQL
strSQL = "SELECT t_policy_print_main.policy_print_id,T_POLICY_PRINT_BENIFIT.INSURED_ID, T_POLICY_PRINT_BENIFIT.BENEFIT_TYPE, T_POLICY_PRINT_BENIFIT.BENEFIT_PERCENT, T_POLICY_PRINT_BENIFIT.INSURED_NAME, T_POLICY_PRINT_BENIFIT.INSURED_GENDER, T_POLICY_PRINT_BENIFIT.INSURED_BIRTH, T_POLICY_PRINT_BENIFIT.INSURED_CERTI,t_customer.real_name From t_policy_print_main , T_POLICY_PRINT_BENIFIT, t_customer Where t_policy_print_main.policy_print_id = t_policy_print_benifit.policy_print_id and t_customer.customer_id(+) = t_policy_print_benifit.benefit_id and t_policy_print_main.policy_print_id =" &
Print_id &
" Order By T_POLICY_PRINT_BENIFIT.INSURED_ID"
rptFace1.SQLQueryString = strSQL
'---------------------------------------
'toClipBoard (strSQL)
'MsgBox rptFace1.SQLQueryString
'---------------------------------------
Report.PaperSource = aPaperBinSet(1, 2)
PrintReport (Printed)
'--------------------------打印主合同现金价值表----------------------------------
'strSQL = "SELECT ITEM_ID FROM T_POLICY_PRINT_PRODUCT WHERE POLICY_PRINT_ID = " &
Print_ID
strSQL = "SELECT pt.ITEM_ID FROM T_POLICY_PRINT_PRODUCT pt,t_policy_product pp WHERE pt.POLICY_PRINT_ID = " &
Print_id &
" and pt.item_id = pp.item_id and pp.basic_id in (select distinct basic_id from t_life_value)"
If ADOrs.State <> adStateClosed then
ADOrs.Close
ADOrs.Open strSQL, ADOconn, 1, 1
Set Report = crxApplication.OpenReport(strAppPath &
"/太平保险现金价值表.rpt", 1)
do
While Not ADOrs.EOF()
'设页号
nPageCount = nPageCount + 1
Report.ParameterFields.Item(1).AddCurrentValue CStr(nPageCount)
Set rptFace1 = Report.OpenSubreport("MainDetail")
strSQL = "SELECT * FROM T_POLICY_PRINT_MAIN, T_POLICY_PRINT_PRODUCT WHERE T_POLICY_PRINT_MAIN.POLICY_PRINT_ID = T_POLICY_PRINT_PRODUCT.POLICY_PRINT_ID AND T_POLICY_PRINT_MAIN.POLICY_print_ID = " &
Print_id &
" AND T_POLICY_PRINT_PRODUCT.ITEM_ID = " &
ADOrs.Fields("ITEM_ID")
rptFace1.SQLQueryString = strSQL
' strSQL = "SELECT * FROM T_POLICY_PRINT_MAIN,T_POLICY_PRINT_CACHE_VALUE , T_POLICY_PRINT_PAYUP " &
_
' " Where T_POLICY_PRINT_MAIN.Policy_ID = " &
Policy_ID &
_
' " AND T_POLICY_PRINT_MAIN.POLICY_PRINT_ID = T_POLICY_PRINT_CACHE_VALUE.POLICY_PRINT_ID " &
_
' " AND T_POLICY_PRINT_MAIN.POLICY_PRINT_ID = T_POLICY_PRINT_PAYUP.POLICY_PRINT_ID " &
_
' " and T_POLICY_PRINT_CACHE_VALUE.item_id = T_POLICY_PRINT_PAYUP.item_id " &
_
' " and T_POLICY_PRINT_CACHE_VALUE.policy_year = T_POLICY_PRINT_PAYUP.policy_year"
strSQL = "select * from t_policy_print_value_table where policy_print_id = " &
Print_id &
" and ITEM_ID = " &
ADOrs.Fields("ITEM_ID")
Report.SQLQueryString = strSQL
'MsgBox Report.SQLQueryString
Set crxDatabaseTable = Report.Database.Tables.Item(1)
crxDatabaseTable.SetLogOnInfo "taiping", , crtUID, crtPsw
Report.PaperSource = aPaperBinSet(2, 2)
PrintReport (Printed)
ADOrs.MoveNext
Loop
'--------------------------打印保单送达通知书-----------------------------------
'先查看是否需要打印溢交通知书
strSQL = "select count(prem.policy_id) as count,sum(fee.fee_amount), prem.period_prem, prem.over_prem, pm.holder_name, p.over_manage From t_policy_print_main pm, t_policy_prem prem, t_policy_fee fee, t_policy p Where p.policy_id = prem.policy_id and prem.policy_id = pm.policy_id and prem.policy_id = fee.policy_id and pm.policy_print_id = " &
Print_id &
" and prem.match_result ='1' and (fee.fee_type = 1 or fee.fee_type = 3) and fee.fee_status = 1 group by fee.policy_id,prem.period_prem,prem.over_prem,pm.holder_name,p.over_manage"
If ADOrs.State <> adStateClosed then
ADOrs.Close
ADOrs.Open strSQL, ADOconn, 1, 1
If ADOrs.Fields("over_prem") < 0.01 then
'没有溢交
Set Report = crxApplication.OpenReport(strAppPath &
"/太平保险送达通知书Ex.rpt", 1)
'设页号
nPageCount = nPageCount + 1
Report.ParameterFields.Item(1).AddCurrentValue CStr(nPageCount)
strSQL = "SELECT * FROM T_POLICY_PRINT_MAIN,T_POLICY_PRINT_PRODUCT WHERE T_POLICY_PRINT_MAIN.POLICY_PRINT_ID = " &
Print_id &
" AND t_policy_print_main.policy_print_id = t_policy_print_product.policy_print_id"
Report.SQLQueryString = strSQL
else
'有溢交
Set Report = crxApplication.OpenReport(strAppPath &
"/太平保险送达通知书.rpt", 1)
'设页号
nPageCount = nPageCount + 1
Report.ParameterFields.Item(1).AddCurrentValue CStr(nPageCount)
strSQL = "SELECT * FROM T_POLICY_PRINT_MAIN,T_POLICY_PRINT_PRODUCT WHERE T_POLICY_PRINT_MAIN.POLICY_PRINT_ID = " &
Print_id &
" AND t_policy_print_main.policy_print_id = t_policy_print_product.policy_print_id"
Report.SQLQueryString = strSQL
Set rptFace = Report.OpenSubreport("OverPrem")
strSQL = "select distinct t_policy.over_manage,t_policy_fee.fee_amount,t_policy_prem.period_prem,t_policy_prem.over_prem,t_policy_print_main.holder_name,t_policy_print_main.policy_code From t_policy_print_main, t_policy_prem, t_policy_fee,T_POLICY Where t_policy_print_main.policy_id = t_policy_prem.policy_id and t_policy_print_main.policy_id = t_policy_fee.policy_id and t_policy_print_main.policy_print_id = " &
Print_id &
" and T_POLICY.POLICY_ID = T_POLICY_PRINT_MAIN.Policy_id AND t_policy_prem.match_result ='1' and (t_policy_fee.fee_type = 1 or t_policy_fee.fee_type = 3) and t_policy_fee.fee_status = 1 group by t_policy_fee.policy_id,t_policy_prem.period_prem,t_policy_prem.over_prem,t_policy_print_main.holder_name,t_policy_fee.fee_amount,t_policy.over_manage,t_policy_print_main.policy_code"
rptFace.SQLQueryString = strSQL
End If
Set crxDatabaseTable = rptFace.Database.Tables.Item(1)
crxDatabaseTable.SetLogOnInfo "taiping", , crtUID, crtPsw
Report.PaperSource = aPaperBinSet(3, 2)
PrintReport (Printed)
'---------------------------------------检查是否需要打印溢交通知单-------------------
'已将溢缴通知书改至送达通知书一页中一起打印(2001-10-11)
'检查是否有已经承保的并且为溢交的保单存在
'strSQL = "select count(prem.policy_id) as count,sum(fee.fee_amount), prem.period_prem, prem.over_prem, pm.holder_name, p.over_manage From t_policy_print_main pm, t_policy_prem prem, t_policy_fee fee, t_policy p Where p.policy_id = prem.policy_id and prem.policy_id = pm.policy_id and prem.policy_id = fee.policy_id and pm.policy_print_id = " &
Print_id &
" and prem.match_result ='1' and (fee.fee_type = 1 or fee.fee_type = 3) and fee.fee_status = 1 group by fee.policy_id,prem.period_prem,prem.over_prem,pm.holder_name,p.over_manage"
'If ADOrs.State <> adStateClosed then
ADOrs.Close
'当前页码为5
'nPageCount = 6
'ADOrs.Open strSQL, ADOconn, 1, 1
'If Not ADOrs.EOF() then
' If (ADOrs.Fields("count") > 0) then
' If CInt(ADOrs.Fields("OVER_manage")) = 1 then
'退费
' Set Report = crxApplication.OpenReport(strAppPath &
"/溢缴退费通知单.rpt", 1)
' else
If CInt(ADOrs.Fields("OVER_manage")) = 2 then
' Set Report = crxApplication.OpenReport(strAppPath &
"/溢缴抵费通知单.rpt", 1)
' End If
' strSQL = "select distinct t_policy_fee.fee_amount,t_policy_prem.period_prem,t_policy_prem.over_prem,t_policy_print_main.holder_name,t_policy_print_main.policy_code From t_policy_print_main, t_policy_prem, t_policy_fee Where t_policy_print_main.policy_id = t_policy_prem.policy_id and t_policy_print_main.policy_id = t_policy_fee.policy_id and t_policy_print_main.policy_print_id = " &
Print_id &
" and t_policy_prem.match_result ='1' and (t_policy_fee.fee_type = 1 or t_policy_fee.fee_type = 3) and t_policy_fee.fee_status = 1 group by t_policy_fee.policy_id,t_policy_prem.period_prem,t_policy_prem.over_prem,t_policy_print_main.holder_name,t_policy_fee.fee_amount"
' Report.SQLQueryString = strSQL
' nPageCount = nPageCount + 1
' PrintReport (Printed)
' End If
'End If
'----------------------------打印收据---------------------------------------
Set Report = crxApplication.OpenReport(strAppPath &
"/太平保险收据.rpt", 1)
strSQL = "SELECT T_POLICY_PRINT_PRODUCT.PRODUCT_NAME, T_POLICY_PRINT_PRODUCT.STANDARD_PREMIUM, T_POLICY_PRINT_MAIN.POLICY_CODE, T_POLICY_PRINT_MAIN.HOLDER_NAME, T_POLICY_PRINT_MAIN.AGENT_CODE, T_POLICY_PRINT_MAIN.AGENT_NAME, T_POLICY_PRINT_MAIN.SUM_FEE, T_POLICY_PRINT_MAIN.PAY_STOP, T_POLICY_PRINT_MAIN.ACCOUNT_CODE, T_POLICY_PRINT_MAIN.CHINESE_PREM_VALUE, T_POLICY_PRINT_MAIN.ORGAN_CODE, T_POLICY_PRINT_MAIN.BANK_NAME " &
_
" From T_POLICY_PRINT_PRODUCT, T_POLICY_PRINT_MAIN " &
_
" Where T_POLICY_PRINT_PRODUCT.POLICY_PRINT_ID = T_POLICY_PRINT_MAIN.POLICY_PRINT_ID and t_policy_print_main.policy_print_id = " &
Print_id
If ADOrs.State <> adStateClosed then
ADOrs.Close
Report.SQLQueryString = strSQL
'设页号
nPageCount = nPageCount + 1
Report.ParameterFields.Item(1).AddCurrentValue CStr(nPageCount)
PrintReport (Printed)
'//--------------------------打印收据---------------------------------------
strSQL = ""
If ADOrs.State <> adStateClosed then
ADOrs.Close
nPageCount = nPageCount + 1
'打印图象
If bPrintImage = True then
PrintImg Print_id, False
'打印条款
If bPrintItem = True then
PrintItemImg Print_id, False
If Printed then
'--------------------------------置“已经打印”标志-------------------------
strSQL = "UPDATE T_POLICY_PRINT_MAIN SET PRINTED = 1,Print_date = sysdate WHERE Policy_print_ID = " &
Print_id
If ADOrs.State <> adStateClosed then
ADOrs.Close
ADOrs.Open strSQL, ADOconn, 3, 3
End If
End Function
Private Sub PrintReport(Printed As Integer)
If Printed then
Report.PrintOut False
else
Form2.CRViewer1.ReportSource = Report
Form2.CRViewer1.ViewReport
Form2.Show 1
End If
'Report.ExportOptions.DestinationType = crEDTMicrosoftExchange
'Report.Export True
End Sub
Private Sub Command2_Click()
Form3.Show 1
End Sub
Private Sub Command3_Click()
Dim ret
'ret = QueryDatabase(Int(Text1.Text), True)
'MsgBox Printer.PaperBin
StatusBar1.SimpleText = "打印结束"
End Sub
Private Sub Command6_Click()
Dim ret As Integer
ret = QueryGroupDatabase(CInt(Text1.Text), False)
End Sub
Private Sub Command7_Click()
'PrintImg 81
End Sub
Private Sub Command8_Click()
End Sub
Private Sub Command9_Click()
Form3.Show
End Sub
Private Sub Command5_Click()
Me.Hide
End Sub
Private Sub Form_Load()
LEAD1.UnlockSupport L_SUPPORT_DOCUMENT, "hju78Lt7"
'LeadBarCode1.UnlockSupport L_SUPPORT_DOCUMENT, "hju78Lt7"
'LeadBarCode1.UnlockSupport L_SUPPORT_BARCODES_1D, "2gh7Mi89Zr"
bPrintImage = True
bPrintNotice = True
bPrintItem = True
On Error Resume Next
'得到应用的路径
strAppPath = App.Path
'打开初始化文件
OpenIniFile
If WindowState = vbMinimized then
LastState = vbNormal
else
LastState = WindowState
End If
'加入到托盘
AddToTray Me, Tray
'设置Tip
SetTrayTip "太平项目打印服务"
'隐藏主界面
Me.Hide
OpenDatabase
End Sub
Private Sub OpenIniFile()
'----------------------认证信息-----------------------------
strServer = getServerName(strAppPath &
"/taiping.ini")
strUserName = crtUID
strPassword = crtPsw
End Sub
Private Sub Form_Resize()
If WindowState <> vbMinimized then
LastState = WindowState
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
RemoveFromTray
'SaveToLog Date &
"," &
Time &
", Close Server."
End Sub
Private Sub pExit_Click()
Unload Me
End Sub
Private Sub pHelp_Click()
ShellExecute Me.hwnd, "open", "NotePad.exe", strAppPath &
"/readme.txt", "", 1
End Sub
Private Sub pProperty_Click()
'SendMessage hwnd, WM_SYSCOMMAND, SC_RESTORE, 0&
Form1.Show
End Sub
Private Sub pTool_Click()
Form3.Show 1
End Sub
Private Sub Timer1_Timer()
Dim strSQL As String
Dim i As Integer
Dim rs As New ADODB.Recordset
If ADOconn.State = adStateClosed then
ADOconn.Open "Driver={Microsoft ODBC for Oracle};Server=" &
strServer &
";Uid=" &
strUserName &
";Pwd=" &
strPassword
'先关闭时钟，以免在海量打印时不断触发
Timer1.Enabled = False
strSQL = "SELECT POLICY_PRINT_ID,POLICY_ID FROM T_POLICY_PRINT_MAIN WHERE PRINTED = 0"
rs.Open strSQL, ADOconn, 1, 1
If rs.RecordCount > 0 then
rs.MoveFirst
For i = 1 To rs.RecordCount
QueryDatabase rs.Fields("POLICY_PRINT_ID").Value, True
rs.MoveNext
Next i
else
StatusBar1.SimpleText = Time &
" - 没有查询到记录！"
End If
'团险单子
strSQL = "SELECT POLICY_PRINT_ID,POLICY_ID FROM T_GROUP_POLICY_PRINT_MAIN WHERE PRINTED > 1"
If rs.State <> adStateClosed then
rs.Close
rs.Open strSQL, ADOconn, 1, 1
If rs.RecordCount > 0 then
rs.MoveFirst
For i = 1 To rs.RecordCount
QueryGroupDatabase rs.Fields("POLICY_Print_ID").Value, True
rs.MoveNext
Next i
else
StatusBar1.SimpleText = Time &
" - 没有查询到记录！"
End If
'SaveToLog Date &
"," &
Time &
", Printed " &
ADOrs.RecordCount &
" Records."
'重新开启时钟
Timer1.Enabled = True
End Sub
Private Sub SaveToLog(strInfo As String)
Open strAppPath &
"/info.log" For Append As #1
Print #1, strInfo
Close #1
End Sub
Private Function getServerName(IniFileName As String) As String
Dim nBin As Integer
Dim strBuf As String
Dim szTmp As String
Open IniFileName For Input As #1
do
While Not EOF(1)
Line Input #1, strBuf
If InStr(UCase(strBuf), "SERVERNAME") > 0 then
'数据库名称
getServerName = Mid(strBuf, InStr(UCase(strBuf), "=") + 1, Len(strBuf) - InStr(strBuf, "SERVERNAME"))
else
If InStr(UCase(strBuf), "PRINTSETUP") > 0 then
strBuf = Trim(Mid(strBuf, InStr(strBuf, "=") + 1, Len(strBuf) - InStr(strBuf, "=")))
nBin = 0
do
While (Len(strBuf) > 0)
nBin = nBin + 1
szTmp = Mid(strBuf, 1, InStr(strBuf, ";") - 1)
szTmp = Mid(szTmp, InStr(szTmp, ",") + 1, Len(szTmp) - InStr(szTmp, ","))
aPaperBinSet(nBin, 1) = Mid(szTmp, 1, InStr(szTmp, ",") - 1) '进纸槽名称
aPaperBinSet(nBin, 2) = Mid(szTmp, InStr(szTmp, ",") + 1, Len(szTmp) - InStr(szTmp, ",")) '进纸槽ID
strBuf = Mid(strBuf, InStr(strBuf, ";") + 1, Len(strBuf) - InStr(strBuf, ";"))
Loop
else
If InStr(UCase(strBuf), "CRYSTAL") > 0 then
strBuf = Trim(Mid(strBuf, InStr(strBuf, "=") + 1, Len(strBuf) - InStr(strBuf, "=")))
crtUID = Mid(strBuf, InStr(strBuf, "=") + 1, Len(strBuf) - InStr(strBuf, "="))
crtPsw = Mid(crtUID, InStr(crtUID, ",") + 1, Len(crtUID) - InStr(crtUID, "="))
crtUID = Mid(crtUID, 1, InStr(crtUID, ",") - 1)
End If
Loop
Close #1
End Function
Sub toClipBoard(strInfo As String)
Clipboard.Clear
Clipboard.SetText strInfo
End Sub
'打印投保单影像
Sub PrintImg(Print_id As Integer, IsGroup As Boolean)
Dim imgcon As New ADODB.Connection
Dim imgrs As New ADODB.Recordset
Dim strSQL As String
Dim Chunks As Integer
Dim DataLen As Long
Dim fragment As Integer
Dim ChunkSize As Long
Dim i As Integer
Dim chunkary() As Byte
Dim szImgFile As String
'Set the pointer to an hourglass
Screen.MousePointer = 11
imgcon.Open "dsn=Taiping", crtUID, crtPsw
If (IsGroup) then
strSQL = "Select img.image_data,img.image_format from t_image img,t_group_policy_print_image pimg where pimg.policy_print_id = " &
Print_id &
" and pimg.image_id = img.image_id order by pimg.seq_num"
else
strSQL = "Select img.image_data,img.image_format from t_image img,t_policy_print_image pimg where pimg.policy_print_id = " &
Print_id &
" and pimg.image_id = img.image_id order by pimg.seq_num"
End If
imgrs.Open strSQL, imgcon, 1, 1
'szImgFile = strAppPath &
"/temp.tif"
szImgFile = "c:/temp.tif"
do
While Not imgrs.EOF()
ChunkSize = imgrs.Fields("image_data").ActualSize
If (ChunkSize > 0) then
Printer.Print ""
Open szImgFile For Binary Access Write As #1
' DataLen = imgrs.Fields("Image_data").ActualSize
' If (DataLen = 0) then
Exitdo
' Chunks = DataLen / ChunkSize
' fragment = DataLen Mod ChunkSize
' If fragment > 0 then
' ReDim chunkary(fragment - 1)
' chunkary = imgrs.Fields("IMAGE_DATA").GetChunk(fragment)
' Put #1, , chunkary
' End If
' ReDim chunkary(ChunkSize - 1)
' For i = 1 To Chunks
' chunkary = imgrs.Fields("IMAGE_DATA").GetChunk(ChunkSize)
' Put #1, , chunkary
' Next
chunkary = imgrs.Fields("image_data").GetChunk(ChunkSize)
Put #1, , chunkary
Close #1
PrintTIFbyLead (szImgFile)
End If
imgrs.MoveNext
Loop
Printer.EndDoc
'Set the mouse pointer back to the default
Screen.MousePointer = 0
imgrs.Close
imgcon.Close
End Sub
Sub PrintTIFbyLead(szFileName As String)
LEAD1.Load szFileName, 1, 1, -1
'Declare the variable for printed text
Dim Msg As String
'Declare the variables for pixel measurements
Dim TextHeightInPixels
Dim UsableWidth
Dim UsableHeight
Dim MaxImageHeight
'Declare the variables for sizing and positioning the image
Dim PrintLeft As Long
Dim PrintTop As Long
Dim PrintHeight As Long
Dim PrintWidth As Long
'Declare variables used for preserving aspect ratios
Dim WidthFactor
Dim HeightFactor
'Set the variables used for preserving the aspect ratio
HeightFactor = LEAD1.BitmapHeight
WidthFactor = LEAD1.BitmapWidth
'Get the page width and height in pixels (dots)
UsableWidth = Printer.Width / Printer.TwipsPerPixelX
UsableHeight = Printer.Height / Printer.TwipsPerPixelY
'Get the maximum height of one image,
'assuming two equal-size images and space for 12 lines of text
' TextHeightInPixels = TextHeight(Msg) / Printer.TwipsPerPixelY
MaxImageHeight = UsableHeight
'Size and position the first image, preserving the aspect ratio.
'Check to see if using the maximum width will make the image too tall.
'Set the dimensions based on the result.
If ((UsableWidth * HeightFactor) / WidthFactor) < MaxImageHeight then
PrintLeft = 1
PrintTop = Printer.CurrentY / Printer.TwipsPerPixelX
PrintWidth = UsableWidth
PrintHeight = (PrintWidth * HeightFactor) / WidthFactor
else
PrintLeft = 1
PrintTop = Printer.CurrentY / Printer.TwipsPerPixelX
PrintHeight = MaxImageHeight
PrintWidth = (PrintHeight * WidthFactor) / HeightFactor
End If
Dim i As Integer
For i = 0 To LEAD1.BitmapListCount - 1
PrintTop = 1
LEAD1.BitmapListIndex = i
LEAD1.Render Printer.hDC, PrintLeft - 250, PrintTop - 250, PrintWidth, PrintHeight
'设定页码打印的位置
Printer.CurrentX = 9900
Printer.CurrentY = 16000
Printer.Print "第 " &
nPageCount &
" 页"
nPageCount = nPageCount + 1
Printer.NewPage
Next i
End Sub
'打印条款图象
Sub PrintItemImg(Print_id As Integer, IsGroup As Boolean)
Dim imgcon As New ADODB.Connection
Dim imgrs As New ADODB.Recordset
Dim strSQL As String
Dim DataLen As Long
Dim ChunkSize As Long
Dim i As Integer
Dim chunkary() As Byte
Dim szItemImgFile As String
'Set the pointer to an hourglass
Screen.MousePointer = 11
imgcon.Open "dsn=Taiping", crtUID, crtPsw
If (IsGroup) then
strSQL = "select sample from t_material where product_id in (select pp.product_id from t_group_policy_print_product ppp,t_group_policy_product pp where pp.item_id = ppp.item_id and ppp.policy_print_id = " &
Print_id &
") order by product_id"
else
strSQL = "select sample from t_material where product_id in (select pp.product_id from t_policy_print_product ppp,t_policy_product pp where pp.item_id = ppp.item_id and ppp.policy_print_id = " &
Print_id &
") order by product_id"
End If
imgrs.Open strSQL, imgcon, 1, 1
szItemImgFile = strAppPath &
"/Item.tif"
do
While Not imgrs.EOF()
ChunkSize = imgrs.Fields("sample").ActualSize
If ChunkSize > 0 then
Printer.Print " "
Open szItemImgFile For Binary Access Write As #1
chunkary = imgrs.Fields("sample").GetChunk(ChunkSize)
Put #1, , chunkary
Close #1
PrintTIFbyLead (szItemImgFile)
End If
imgrs.MoveNext
Loop
Printer.EndDoc
'Set the mouse pointer back to the default
Screen.MousePointer = 0
imgrs.Close
imgcon.Close
End Sub
