bb1.prg

建设银行计算机设备台帐程序计算机设备管理程序。其中包括一个网络文件传输示例

*************************************
* 程序      genrpt.prg
* 用途            以当前别名生成一个报表
* 调用方法  先打开一个表，然后在命令窗口打入 do genrpt
* 程序员        任明汉
* 编写日期   2000.04.30
*************************************
if empty(alias())
   wait window "请先打开一个表, 再运行本程序"
   return
endif

LOCAL lcCuurentAlias, lcReportName, lnMaxWidth, lcStatFile, lcFieldType, lcTempAlias, ;
llHasMemo, llHasGen, lnCnt,lnCnt1, laColWidth, lc1stFields, luObject, ;
llIsMemo, llIsGen, llIsNum, laFieldArray[1]

lcMainDbf = alias()
SELECT (m.lcMainDbf)
lnColumnCount = AFIELDS(laFieldArray)
DIMENSION colcount[m.lnColumnCount], laColWidth[m.lnColumnCount]
FOR lnCnt = 1 TO m.lnColumnCount
colcount[m.lnCnt] = laFieldArray(m.lnCnt,1)
laColWidth[m.lnCnt] = laFieldArray(m.lnCnt,3) * 9
lcFieldType = laFieldArray[m.lnCnt,2]
IF TYPE("&lcFieldType") = 'D'
laColWidth[m.lnCnt] = 72
ENDIF
IF TYPE("&lcFieldType") = 'M'
    *-- 表中有备注字段
llHasMemo = .T.
ENDIF
IF TYPE("&lcFieldType") = 'G'
    *-- 表中有通用字段
llHasGen = .T.
ENDIF
ENDFOR


lcReportName = lcMainDbf
lcCuurentAlias = ALIAS()
lc1stFields = colcount[1]

*-- 新报表仅一个字段
CREATE REPORT &lcMainDbf FROM ALIAS() COLUMN FIELDS (lc1stFields)

SELECT 0

lcTempAlias = "_" + SUBSTR(SYS(2015), 4)

USE "&lcReportName..FRX" EXCL ALIAS &lcTempAlias

*-- 删除新报表中仅有的一个字段及标签，以便在一个空白的表中进行处理
DELETE ALL FOR ALLTRIM(UPPER(lc1stFields)) == ALLTRIM(UPPER(EXPR))
PACK
*-- objtype 的值所代表的意义:
*-- 1 报表
*-- 2 工作区
*-- 3 索引
*-- 4 关系
*-- 5 文本
*-- 6 线
*-- 7 框
*-- 8 字段
*-- 9 带信息
*-- 10 组
*-- 17 图象
*-- 18 变量
*-- 21 打印驱动
*-- 25 数据环境
*-- 26 临时表对象

*-- 请注意,报表中的度量值是 1/10000 英寸
*-- 约合 104.167 一象素

*-- 设置报表的高度和宽度
LOCATE FOR objtype=1 AND objcode = 53
REPLACE hpos WITH 5000,HEIGHT WITH 1000

*-- 调整自动生成的报表中的页号标签的位置
SCAN FOR (objtype=5 AND objcode=0) OR (objtype=8 AND objcode=0)
IF ALLTRIM(EXPR)=="DATE()" OR ALLTRIM(EXPR)=='"页"' OR ALLTRIM(EXPR)=="_PAGENO"
REPLACE vpos WITH vpos + 21751 + IIF(objtype = 8 OR ALLTRIM(EXPR) = '"页"',2000,0)
ELSE
REPLACE vpos WITH vpos + 20251 + IIF(objtype = 8 OR ALLTRIM(EXPR) = '"页"',2000,0),hpos WITH hpos + 500
ENDIF
ENDSCAN

LOCATE FOR ALLTRIM(EXPR)==["页"]
REPLACE hpos WITH hpos-10000

LOCATE FOR ALLTRIM(EXPR) == "_PAGENO"
REPLACE hpos WITH hpos - 10000

LOCATE FOR ALLTRIM(EXPR) == "_PAGENO"
lnMaxWidth = hpos + WIDTH

LOCATE FOR objtype == 23

*-- 增加报表标题带的横线
platform=  "WINDOWS "
uniqueid=  "_ROC1DN8ZV"
TIMESTAMP=   591051062
objtype =  6
objcode =  0
vpos =  19333.833
hpos =  312.500
HEIGHT =  416.667
WIDTH =  lnMaxWidth
boxchar =  " "
fillchar=  " "
penred =  -1
pengreen=  -1
penblue =  -1
fillred =  -1
fillgreen= -1
fillblue=  -1
pensize =  4
penpat =  8
TOP =  .T.
offset =  1
supalways=   .T.
suprpcol=  3
INSERT BLANK BEFORE
GATHER MEMVAR MEMO
************************
platform=  "WINDOWS "
uniqueid=  "_ROC1DOOBP"
TIMESTAMP=   591051098
vpos =  22292.667
INSERT BLANK BEFORE
GATHER MEMVAR MEMO
*************************

*--- 增加标题及细节带的边框
platform ="WINDOWS "
uniqueid ="_RTH1EFWOX"
TIMESTAMP =612154403
objtype =7
objcode =4
vpos =24584.333
hpos =312.500
IF !m.llHasGen
HEIGHT =3333.333
ELSE
HEIGHT =10625
ENDIF
WIDTH =lnMaxWidth
COMMENT =" "
boxchar =" "
fillchar =" "
penred =-1
pengreen =-1
penblue =-1
fillred =-1
fillgreen =-1
fillblue =-1
pensize =1
penpat =8
STRETCH =.T.
TOP =.T.
supalways =.T.
suprpcol =3

*--- 增加标题的边框
LOCATE FOR objtype=23
INSERT BLANK BEFORE
GATHER MEMVAR MEMO

*--- 增加细节带的边框
vpos = 19271.833
HEIGHT = 3333.333
INSERT BLANK BEFORE
GATHER MEMVAR MEMO

m.endposition = 600
FOR m.lnCnt = 1 TO m.lnColumnCount
***************************************
*-- 增加字段
EXPR = colcount[m.lnCnt]
SELECT (m.lcCuurentAlias)
lcFieldType = colcount[m.lnCnt]
IF TYPE("&lcFieldType") = 'G'
llIsGen = .T.
ELSE
llIsGen = .F.
ENDIF
IF TYPE("&lcFieldType") = 'M'
llIsMemo = .T.
ELSE
llIsMemo = .F.
ENDIF
IF TYPE("&lcFieldType") = 'N'
llIsNum = .T.
ELSE
llIsNum = .F.
ENDIF
SELECT (m.lcTempAlias)
platform = "WINDOWS "
uniqueid = "_RE81AIYON"
TIMESTAMP = 557624653
IF m.llIsGen
objtype = 17
ELSE
objtype = 8
ENDIF
objcode = 0
vpos = 25584.333
hpos = m.endposition
HEIGHT = 1458.333
IF m.llIsMemo
WIDTH = 26354.16700
ELSE
WIDTH = laColWidth(m.lnCnt) * 104.16666
ENDIF
*********************
IF m.llIsGen
WIDTH = 11354.167
HEIGHT = 9375
NAME = colcount[m.lnCnt]
EXPR = ''
STYLE = ''
PICTURE = ''
ORDER = ''
UNIQUE = .F.
COMMENT = ''
ENVIRON = .F.
boxchar = ''
fillchar = ''
TAG = ''
TAG2 = ''
penred = 0
pengreen = 0
penblue = 0
fillred = 0
fillgreen = 0
fillblue = 0
pensize = 0
penpat = 0
FILLPAT = 0
FontFace = ''
FontStyle = 0
FONTSIZE = 0
MODE = 0
RULER = 0
RULERLINES = 0
GRID = .F.
GRIDV = 0
GRIDH = 0
FLOAT = .F.
STRETCH = .F.
STRETCHTOP = .F.
TOP = .T.
BOTTOM = .F.
SUPTYPE = 0
SUPREST = 0
NOREPEAT = .F.
RESETRPT = 0
PAGEBREAK = .F.
COLBREAK = .F.
RESETPAGE = .F.
GENERAL = 2
SPACING = 0
DOUBLE = .F.
SWAPHEADER = .F.
SWAPFOOTER = .F.
EJECTBEFOR = .F.
EJECTAFTER = .F.
PLAIN = .F.
SUMMARY = .F.
ADDALIAS = .F.
offset = 1
TOPMARGIN = 0
BOTMARGIN = 0
totaltype = 0
RESETTOTAL = 0
RESOID = 0
CURPOS = .F.
supalways = .T.
SUPOVFLOW = .F.
suprpcol = 3
SUPGROUP = 0
SUPVALCHNG = .F.
SUPEXPR = ''
USER = ''
**************
ELSE
objcode = 0
NAME = ''
STYLE = ''
PICTURE = ''
ORDER = ''
UNIQUE = .F.
COMMENT = ''
ENVIRON = .F.
boxchar = ''
fillchar = 'C'
TAG = ''
TAG2 = ''
penred = 0
pengreen = 0
penblue = 0
fillred =     -1
fillgreen =     -1
fillblue =     -1
pensize = 0
penpat = 0
FILLPAT = 0
FontFace = '宋体'
FontStyle = 0
FONTSIZE = 9
MODE = 1
RULER = 0
RULERLINES = 0
GRID = .F.
GRIDV = 0
GRIDH = 0
FLOAT = .F.
STRETCH = .T.
STRETCHTOP = .F.
TOP = .T.
BOTTOM = .F.
SUPTYPE = 0
SUPREST = 0
NOREPEAT = .T.
RESETRPT = 0
PAGEBREAK = .F.
COLBREAK = .F.
RESETPAGE = .F.
GENERAL = 0
SPACING = 2
DOUBLE = .F.
SWAPHEADER = .F.
SWAPFOOTER = .F.
EJECTBEFOR = .F.
EJECTAFTER = .F.
PLAIN = .F.
SUMMARY = .F.
ADDALIAS = .F.
offset = 0
TOPMARGIN = 0
BOTMARGIN = 0
totaltype = 0
RESETTOTAL = 1
RESOID = 0
CURPOS = .F.
supalways = .T.
SUPOVFLOW = .F.
suprpcol = 3
SUPGROUP = 6
SUPVALCHNG = .F.
SUPEXPR = ''
USER = ''
IF llIsNum
offset = 1
ELSE
offset = 0
ENDIF
ENDIF
INSERT BLANK BEFORE
GATHER MEMVAR MEMO
*****************************************
*-- 增加标签
platform = "WINDOWS "
uniqueid = "_RE81AIYOM"
TIMESTAMP = 557624653
objtype = 5
objcode = 0
EXPR = ["]+colcount[m.lnCnt]+["]
vpos = 20251.000
hpos = m.endposition
HEIGHT = 1458.333
WIDTH = LEN(colcount[m.lnCnt]) * 625
boxchar = " "
fillchar = " "
penred = -1
pengreen = -1
penblue = -1
fillred = -1
fillgreen = -1
fillblue = -1
FontFace = "宋体"
FontStyle = 1
FONTSIZE = 9
MODE = 1
FLOAT = .T.
supalways = .T.
suprpcol = 3
INSERT BLANK BEFORE
GATHER MEMVAR MEMO
*********************************************
*--- 该字段的终止位置超出范围，退出
IF hpos + MAX(LEN(colcount[m.lnCnt]) * 625,laColWidth(m.lnCnt) * 104.16666) > m.lnMaxWidth
WAIT WINDOW "字段太多,可能有的字段没有放入报表"
DELETE
SKIP
DELETE
SKIP
DELETE
SKIP
DELETE
EXIT
ENDIF

*--- 增加标题带分隔线
IF m.lnCnt < m.lnColumnCount
DO CASE
CASE m.llIsGen
endposition = hpos + 11354.167 + 520.834
CASE m.llIsMemo
endposition = hpos + 26354.16700 + 520.834
OTHERWISE
endposition = hpos + MAX(LEN(colcount[m.lnCnt]) * 625,laColWidth(m.lnCnt) * 104.16666) + 520.834
ENDCASE
platform ="WINDOWS "
uniqueid ="_RTH1EZWBC"
TIMESTAMP = 612154865
objtype = 6
objcode = 0
vpos = 19273.833
hpos = m.endposition - 300
HEIGHT = 3229.166
WIDTH = 104.167
boxchar =" "
fillchar =" "
penred = -1
pengreen = -1
penblue = -1
fillred = -1
fillgreen = -1
fillblue = -1
pensize = 1
penpat = 8
TOP =.T.
supalways =.T.
suprpcol = 3

INSERT BLANK BEFORE
GATHER MEMVAR MEMO
*--- 增加细节带分隔线
vpos = 24688.5
STRETCH = .T.
IF m.llHasGen
HEIGHT = 10520
ENDIF
INSERT BLANK BEFORE
GATHER MEMVAR MEMO
ENDIF

*--- 下一字段的起始位置超出范围，退出
IF m.endposition > m.lnMaxWidth
WAIT WINDOW "字段太多,可能有的字段没有放入报表"
EXIT
ENDIF

ENDFOR

*---增加报表标题
DIMENSION aobjects[8,8]
FOR lnCnt= 1 TO 8
aobjects[m.lnCnt,6] = 'T'
    if lnCnt= 1
   luObject = "报表标题"
   aobjects[m.lnCnt,1] = ALLTRIM(m.luObject)
    endif
luObject = "宋体"
aobjects[m.lnCnt,2] = m.luObject
lcCaption = 'THISFORM.RPTFTSIZE'+ALLTRIM(STR(m.lnCnt))
luObject = 9   && 字体大小
aobjects[m.lnCnt,3] = m.luObject

luObject = .f.   && 斜体?
aobjects[m.lnCnt,8] = m.luObject
IF m.luObject
aobjects[m.lnCnt,6] = aobjects[m.lnCnt,6] + "lnCnt"
ENDIF
IF !m.luObject
lcCaption = 'THISFORM.RPTFTBLD'+ALLTRIM(STR(m.lnCnt))
luObject = .f.   && 黑体?
aobjects[m.lnCnt,4] = m.luObject
ENDIF
IF m.luObject
aobjects[m.lnCnt,6] = aobjects[m.lnCnt,6] + "B"
ENDIF
luObject = 1   && 对齐方式
aobjects[m.lnCnt,5] = m.luObject
IF LEN(aobjects[m.lnCnt,6]) = 1
aobjects[m.lnCnt,6] = aobjects[m.lnCnt,6] + "N"
ENDIF
ENDFOR
aobjects[1,7] = 4583.333
aobjects[2,7] = 8020.833
aobjects[3,7] = 9791.667
aobjects[4,7] = 15937.5
aobjects[5,7] = 17500
IF !m.llHasGen
aobjects[6,7] = 31145.833
aobjects[7,7] = 32708.333
aobjects[8,7] = 34270.833
ELSE
aobjects[6,7] = 31145.833 + 7395
aobjects[7,7] = 32708.333 + 7395
aobjects[8,7] = 34270.833 + 7395
ENDIF
FOR m.lnCnt = 1 TO 8
IF NOT EMPTY(aobjects[m.lnCnt,1])
platform = "WINDOWS "
uniqueid = "_RTI00QROL"
TIMESTAMP = 612172463
objtype = 5
objcode = 0
EXPR = " "+aobjects[m.lnCnt,1]+" "
vpos = aobjects[m.lnCnt,7]
WIDTH = TXTWIDTH(aobjects[m.lnCnt,1],aobjects[m.lnCnt,2],aobjects[m.lnCnt,3],aobjects[m.lnCnt,6])*FONTMETRIC(6,aobjects[m.lnCnt,2],aobjects[m.lnCnt,3],aobjects[m.lnCnt,6]) * 104.16666
DO CASE
CASE aobjects[m.lnCnt,5] = 2
hpos = (m.lnMaxWidth - m.WIDTH) / 2
CASE aobjects[m.lnCnt,5] = 0
hpos = 312.500
OTHERWISE
hpos = 312.500
ENDCASE
HEIGHT = aobjects[m.lnCnt,3] * 156.25
boxchar = " "
fillchar = " "
fillred = -1
fillgreen = -1
fillblue = -1
FontFace = aobjects[m.lnCnt,2]
DO CASE
CASE aobjects[m.lnCnt,4]
FontStyle = 1
CASE aobjects[m.lnCnt,8]
FontStyle = 2
OTHERWISE
FontStyle = 0
ENDCASE
FONTSIZE = aobjects[m.lnCnt,3]
MODE = 1
FLOAT = .T.
supalways = .T.
suprpcol = 3
IF m.lnCnt <= 3
PICTURE = '"@I"'
ELSE
PICTURE = ''
ENDIF
INSERT BLANK BEFORE
GATHER MEMVAR MEMO
ENDIF
ENDFOR
LOCATE FOR objtype==9 AND objcode==7
REPLACE HEIGHT WITH 9167

LOCATE FOR objtype==9 AND objcode==1
REPLACE HEIGHT WITH 22605

*--细节带高
LOCATE FOR objtype == 9 AND objcode == 4
IF !m.llHasGen
REPLACE HEIGHT WITH 3230
ELSE
REPLACE HEIGHT WITH 10521
ENDIF

LOCATE FOR objtype = 5 AND objcode = 0 AND EXPR=["页"]
IF NOT EOF()
DELETE
ENDIF
LOCATE FOR objtype=8 AND objcode=0 AND UPPER(EXPR)='_PAGENO'
IF NOT EOF()
REPLACE EXPR WITH ["第"+]+[alltrim(str(_PAGENO))]+[+"页"],WIDTH WITH 7916.667,hpos WITH hpos - 1000
IF m.llHasGen
REPLACE vpos WITH vpos + 7395
ENDIF
ENDIF
LOCATE FOR objtype=8 AND objcode=0 AND UPPER(EXPR)='DATE()'
IF NOT EOF()
DELETE
ENDIF
SELECT (m.lcTempAlias)
PACK
USE
SELECT (m.lcCuurentAlias)
report form &lcMainDbf preview