@吹水佬 谢谢指点！
[此贴子已经被作者于2024-6-11 22:38编辑过]
PARAMETERS 报表文件名,报表标题
PRIVATE ALL LIKE L_*
WAIT '正在生成报表......' WINDOW NOWAIT NOCLEAR
IF TYPE('M.报表文件名')='L' OR EMPTY(M.报表文件名)
报表文件名='TMP_REPORT'
ENDIF
L_字符宽度9=625
L_字符宽度9粗=729.167
L_字符宽度16=1250
L_域控件宽度修正9=370
L_带区指示条高度=2083
L_标题区高度=IIF(TYPE('M.报表标题')='L' OR EMPTY(报表标题),0,5000)
L_页标头区高度=2400
L_细节区高度=2400
L_页标头区VPOS=L_标题区高度+IIF(L_标题区高度=0,0,L_带区指示条高度)
L_细节区VPOS=L_标题区高度+L_页标头区高度+IIF(L_标题区高度=0,1,2)*L_带区指示条高度
L_TMP=SYS(2015)
L_CA=SELECT()
COPY STRUCTURE TO (L_TMP) EXTE
CREATE CURSOR TMP (TMPFIELD C(1))
CREATE REPORT (报表文件名) FROM TMP
USE 报表文件名+'.FRX' EXCL
IF L_标题区高度 # 0
*添加标题区
INSERT BLAN
REPLACE PLATFORM WITH 'WINDOWS',OBJTYPE WITH 9,HEIGHT WITH L_标题区高度
ENDIF
LOCATE FOR EXPR='_PAGENO'
L_页面宽度=HPOS+WIDTH
*增高页标头区
LOCATE FOR OBJTYPE=9 AND OBJCODE=1
L_页标头区原高度=HEIGHT
L_页标头区增高=L_页标头区高度-HEIGHT
REPLACE HEIGHT WITH L_页标头区高度
*增高细节区
LOCATE FOR OBJTYPE=9 AND OBJCODE=4
L_细节区原高度=HEIGHT
L_细节区增高=L_细节区高度-HEIGHT
REPLACE HEIGHT WITH L_细节区高度
*标题区以下内容重定位
LOCATE FOR OBJTYPE=5
L_列标题高度=HEIGHT
*修改页注脚区内容垂直位置
REPLACE VPOS WITH L_细节区VPOS+L_细节区高度+L_带区指示条高度 FOR VPOS>L_页标头区原高度+L_带区指示条高度+L_细节区原高度 AND INLIST(OBJTYPE,5,8)
*修改细节区内容垂直位置
REPLACE VPOS WITH L_细节区VPOS+L_细节区增高/2 FOR BETWEEN(VPOS,L_页标头区原高度,L_页标头区原高度+L_带区指示条高度+L_细节区原高度)
*修改页标头区内容垂直位置
REPLACE VPOS WITH L_页标头区VPOS+L_页标头区增高/2 FOR VPOS<L_页标头区原高度 AND !INLIST(OBJTYPE,1,9)
*修改页注脚内容
CALCULATE MAX(HPOS) TO L_MAX FOR OBJTYPE=5 AND TOP
LOCATE FOR HPOS=L_MAX
SCATTER MEMV MEMO
REPLACE EXPR WITH ["第"],HPOS WITH L_页面宽度-10*L_字符宽度9,WIDTH WITH 2*L_字符宽度9
APPEND BLANK
GATHER MEMV MEMO
REPLACE EXPR WITH ["页"],HPOS WITH L_页面宽度-2*L_字符宽度9,WIDTH WITH 2*L_字符宽度9
LOCATE FOR EXPR=[_PAGENO] AND TOP
REPLACE HPOS WITH L_页面宽度-8*L_字符宽度9,WIDTH WITH 5*L_字符宽度9
LOCATE FOR EXPR=[DATE()] AND TOP
REPLACE HPOS WITH HPOS+11*L_字符宽度9
APPEND BLANK
GATHER MEMV MEMO
REPLACE EXPR WITH ["打印日期："],HPOS WITH 0,WIDTH WITH 10*L_字符宽度9
*添加列标题标签控件、细节区域控件以及表格线
*先保存报表中基于TMPFIELD字段的标签控件和域控件记录，作为生成各列的标题标签控件和细节域控件的依据
LOCATE FOR UPPER(EXPR)=["TMPFIELD"]
SCATTER TO L_列标题记录 MEMO
DELETE
LOCATE FOR UPPER(EXPR)=[TMPFIELD]
SCATTER TO L_列细节记录 MEMO
DELETE
PACK
SELECT 0
USE (L_TMP)
L_报表宽度=0
L_HPOS=0
L_GAP=400 &&列与纵线之间的间隙
*设置纵线属性
OBJTYPE=6
EXPR=' '
WIDTH=104.167
HEIGHT=L_细节区高度
PENSIZE=1
PENPAT=8
MODE=0
SCAN FOR FIELD_TYPE # 'G' &&通用字段除外
L_列标题=TRIM(FIELD_NAME)
L_列标题宽=LEN(L_列标题)*L_字符宽度9粗
L_列细节宽=FIELD_LEN*L_字符宽度9+L_域控件宽度修正9
L_列宽=MAX(L_列标题宽,L_列细节宽)
L_报表宽度=L_报表宽度+WIDTH+2*L_GAP+L_列宽
L_类型=FIELD_TYPE
IF L_报表宽度>L_页面宽度
REPLACE Expr WITH STRTRAN(Expr,"ORIENTATION=0”，“ORIENTATION=1”)&& 提示：找不到变量Expr
ENDIF
SELECT (报表文件名)
添加纵线()
L_HPOS=L_HPOS+WIDTH+L_GAP
*添加列标题
APPEND BLANK
GATHER FROM L_列标题记录 MEMO
REPLACE EXPR WITH [' ']+L_列标题+[' '],HPOS WITH L_HPOS,WIDTH WITH L_列标题宽
*添加列细节
APPEND BLANK
GATHER FROM L_列细节记录 MEMO
REPLACE EXPR WITH L_列标题,HPOS WITH L_HPOS,WIDTH WITH L_列细节宽,FILLCHAR WITH CHRTRAN(L_类型,'YFTBIM','NNDNNC')
IF FILLCHAR='N'
REPLACE OFFSET WITH 1
ENDIF
L_HPOS=L_HPOS+L_列宽+L_GAP
SELECT (L_TMP)
ENDSCAN
USE
SELECT (报表文件名)
添加纵线()
L_报表宽度=L_HPOS+WIDTH
*添加横线
HPOS=0
HEIGHT=104.167
WIDTH=L_报表宽度
APPEND BLANK
GATHER MEMV MEMO
REPLACE VPOS WITH L_页标头区VPOS
APPEND BLANK
GATHER MEMV MEMO
REPLACE VPOS WITH L_页标头区VPOS+L_页标头区高度
APPEND BLANK
GATHER MEMV MEMO
REPLACE VPOS WITH L_细节区VPOS+L_细节区高度
IF L_标题区高度 # 0
*拷贝一个标签记录并改造成报表标题记录
LOCATE FOR OBJTYPE=5
SCATTER MEMV MEMO
L_标题宽度=LEN(M.报表标题)*L_字符宽度16
EXPR=[' ']+M.报表标题+[' ']
VPOS=1000
HPOS=MAX(0,(L_报表宽度-L_标题宽度)/2)
WIDTH=L_标题宽度
HEIGHT=2500
FONTSIZE=16
APPEND BLANK
GATHER MEMV MEMO
ENDIF
USE
SELECT (L_CA)
ERASE L_TMP+'.*'
WAIT CLEA
RETURN
PROCEDURE 添加纵线
APPEND BLANK
GATHER MEMV MEMO
REPLACE VPOS WITH L_页标头区VPOS,HPOS WITH L_HPOS
APPEND BLANK
GATHER MEMV MEMO
REPLACE VPOS WITH L_细节区VPOS,HPOS WITH L_HPOS,STRETCH WITH .T.
RETURN
[此贴子已经被作者于2024-6-11 22:55编辑过]