程序代码：
PUBLIC oform1
oform1=NEWOBJECT("form1")
oform1.Show
RETURN
**************************************************
*-- Form: form1 (根据花名单统计人\平均人数.scx)
*-- 父类: form
*-- 基类: form
*
DEFINE CLASS form1 AS form
Height = 146
Width = 395
DoCreate = .T.
AutoCenter = .T.
BorderStyle = 3
Caption = "请选择年份月份日期"
MinButton = .T.
WindowState = 0
AlwaysOnTop = .F.
Name = "Form1"
ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
FontName = "楷体_GB2312", ;
FontSize = 16, ;
Alignment = 0, ;
Caption = "年", ;
Height = 27, ;
Left = 136, ;
Top = 31, ;
Width = 22, ;
Name = "Label1"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 79, ;
Left = 66, ;
Height = 30, ;
Width = 70, ;
Caption = "统计(\<Y)", ;
Name = "Command1"
ADD OBJECT command2 AS commandbutton WITH ;
Top = 79, ;
Left = 158, ;
Height = 30, ;
Width = 70, ;
Caption = "取消(\<N)", ;
Name = "Command2"
ADD OBJECT spinner1 AS spinner WITH ;
FontSize = 14, ;
Height = 30, ;
Left = 56, ;
Top = 27, ;
Width = 75, ;
ForeColor = RGB(255,0,0), ;
Value = (YEAR(DATE())), ;
Name = "Spinner1"
ADD OBJECT spinner2 AS spinner WITH ;
FontSize = 14, ;
Height = 30, ;
KeyboardHighValue = 12, ;
KeyboardLowValue = 1, ;
Left = 163, ;
SpinnerHighValue = 12.00, ;
SpinnerLowValue = 1.00, ;
Top = 27, ;
Width = 50, ;
ForeColor = RGB(0,0,255), ;
Value = (MONTH(DATE())), ;
Name = "Spinner2"
ADD OBJECT label2 AS label WITH ;
AutoSize = .T., ;
FontName = "楷体_GB2312", ;
FontSize = 16, ;
Alignment = 0, ;
Caption = "月", ;
Height = 27, ;
Left = 217, ;
Top = 31, ;
Width = 22, ;
Name = "Label2"
ADD OBJECT spinner3 AS spinner WITH ;
FontSize = 14, ;
Height = 30, ;
KeyboardHighValue = 31, ;
KeyboardLowValue = 1, ;
Left = 255, ;
SpinnerHighValue = 31.00, ;
SpinnerLowValue = 1.00, ;
Top = 27, ;
Width = 50, ;
ForeColor = RGB(0,0,255), ;
Value = (DAY(DATE())), ;
Name = "Spinner3"
ADD OBJECT label3 AS label WITH ;
AutoSize = .T., ;
FontName = "楷体_GB2312", ;
FontSize = 16, ;
Alignment = 0, ;
Caption = "日", ;
Height = 27, ;
Left = 309, ;
Top = 31, ;
Width = 22, ;
Name = "Label3"
ADD OBJECT command3 AS commandbutton WITH ;
Top = 79, ;
Left = 250, ;
Height = 30, ;
Width = 70, ;
Caption = "建新表(\<W)", ;
Name = "Command3"
PROCEDURE Resize
private i as no
private j as no
i=thisform.width/fwidth
j=thisform.height/fheight
thisform.lockscreen=.t.
for k=1 to thisform.controlcount
thisform.controls(k).left=thisform.controls(k).left*i
thisform.controls(k).top=thisform.controls(k).top*j
thisform.controls(k).width=thisform.controls(k).width*i
thisform.controls(k).height=thisform.controls(k).height*j
endfor
thisform.lockscreen=.f.
fwidth=Thisform.width
fheight=thisform.height
thisform.refresh
ENDPROC
PROCEDURE Init
Thisform.minwidth=Thisform.width
thisform.minheight=thisform.height
public fwidth as integer
public fheight as integer
fwidth=Thisform.width
fheight=thisform.height
ENDPROC
PROCEDURE command1.Click
Set Safety Off
Public nyear,nmonth,nday,ddate,ndays,nianyue
nyear=ThisForm.spinner1.Value
nmonth=ThisForm.spinner2.Value
nday=ThisForm.spinner3.Value
ddate=Date(nyear,nmonth,1)
ndays=Gomonth(ddate,1)-ddate
ndayfields="A"+Alltrim(Str(ThisForm.spinner3.Value))
ndayfieldsold="A"+Alltrim(Str(ThisForm.spinner3.Value-1))
If ThisForm.spinner2.Value<10
nianyue=Str(ThisForm.spinner1.Value)+"0"+Alltrim(Str(ThisForm.spinner2.Value))
nianyueA=Str(ThisForm.spinner1.Value)+"-0"+Alltrim(Str(ThisForm.spinner2.Value))
Else
nianyue=Str(ThisForm.spinner1.Value)+Alltrim(Str(ThisForm.spinner2.Value))
nianyueA=Str(ThisForm.spinner1.Value)+"-"+Alltrim(Str(ThisForm.spinner2.Value))
endif
If nday>ndays &&&&天数大于月天数
MessageBox("无效日期,请重新输入",0+48,"提示信息")
Else
ThisForm.Hide
If not Used('hmd')
Sele 1
Use hmd
Else
Sele hmd
Endif
If not Used('RSB')
Sele 1
Use rsb
Else
Sele rsb
EndIf
Do While not Eof()
nhere=Recno()
narray='array'+Alltrim(Str(Recno()))
pp=rsb.tj
If !Empt(rsb.tj)
Sele Count(*) As 人数 Where &pp From hmd Into Array &narray
Repl &ndayfields With &narray
Endif
Skip
EndDo
ns=''
For i=1 To ndays
sl='array'+Allt(Str(i))
sl2='A'+Allt(Str(i))
Sele Sum(&sl2) From rsb Into Array &sl
If &sl=0
ns=ns+"A"+Allt(Str(i))+IIF(I<ndays,[,],[])
EndIf
Endfor
If Len(NS)>0
MessageBox(ns+"列,数据为空",0+48,"提示信息")
Else
MessageBox("["+Allt(nianyueA)+"],数据完整！",0+48,"提示信息")
Endif
Sele rsb
Repl All ny With Val(nianyue)
Do Case
Case ndays=28
Repl All bj0 With Round((A1+A2+A3+A4+A5+A6+A7+A8+A9+A10+A11+A12+A13+A14+A15+A16+A17+A18+A19+A20+A21+A22+A23+A24+A25+A26+A27+A28)/ndays,2)
Case ndays=29
Repl All bj0 With Round((A1+A2+A3+A4+A5+A6+A7+A8+A9+A10+A11+A12+A13+A14+A15+A16+A17+A18+A19+A20+A21+A22+A23+A24+A25+A26+A27+A28+A29)/ndays,2)
Case ndays=30
Repl All bj0 With Round((A1+A2+A3+A4+A5+A6+A7+A8+A9+A10+A11+A12+A13+A14+A15+A16+A17+A18+A19+A20+A21+A22+A23+A24+A25+A26+A27+A28+A29+A30)/ndays,2)
Case ndays=31
Repl All bj0 With Round((A1+A2+A3+A4+A5+A6+A7+A8+A9+A10+A11+A12+A13+A14+A15+A16+A17+A18+A19+A20+A21+A22+A23+A24+A25+A26+A27+A28+A29+A30+A31)/ndays,2)
EndCase
****计算期末人数（当月28日）******
Do Case
Case ndays=28
Copy To Array Asj FIELDS A28
asj[2]=asj[3]+asj[4]+asj[5]
asj[6]=asj[7]+asj[8]
asj[1]=asj[2]+asj[6]
Repl A28 With asj[2] For xh=2
Repl A28 With asj[6] For xh=6
Repl A28 With asj[1] For xh=1
Copy To Array Asj Fields bj0
asj[2]=asj[3]+asj[4]+asj[5]
asj[6]=asj[7]+asj[8]
asj[1]=asj[2]+asj[6]
Repl BJ0 With asj[2] For xh=2
Repl BJ0 With asj[6] For xh=6
Repl BJ0 With asj[1] For xh=1
Repl All bj With Round(bj0,0) &&&&人数四舍五入
Repl All bj With 1 for bj0<=1 AND bj0>0 &&&&人数小于1大于0,取1
Copy To Array Asj Fields bj
asj[2]=asj[3]+asj[4]+asj[5]
asj[6]=asj[7]+asj[8]
asj[1]=asj[2]+asj[6]
Repl BJ With asj[2] For xh=2
Repl BJ With asj[6] For xh=6
Repl BJ With asj[1] For xh=1
repl all L1 With A28
repl all L2 With bj
****计算期末人数（当月29日）******
Case ndays=29
Copy To Array Asj FIELDS A29
asj[2]=asj[3]+asj[4]+asj[5]
asj[6]=asj[7]+asj[8]
asj[1]=asj[2]+asj[6]
Repl A29 With asj[2] For xh=2
Repl A29 With asj[6] For xh=6
Repl A29 With asj[1] For xh=1
Copy To Array Asj Fields bj0
asj[2]=asj[3]+asj[4]+asj[5]
asj[6]=asj[7]+asj[8]
asj[1]=asj[2]+asj[6]
Repl BJ0 With asj[2] For xh=2
Repl BJ0 With asj[6] For xh=6
Repl BJ0 With asj[1] For xh=1
Repl All bj With Round(bj0,0) &&&&人数四舍五入
Repl All bj With 1 for bj0<=1 AND bj0>0 &&&&人数小于1大于0,取1
Copy To Array Asj Fields bj
asj[2]=asj[3]+asj[4]+asj[5]
asj[6]=asj[7]+asj[8]
asj[1]=asj[2]+asj[6]
Repl BJ With asj[2] For xh=2
Repl BJ With asj[6] For xh=6
Repl BJ With asj[1] For xh=1
repl all L1 With A29
repl all L2 With bj
****计算期末人数（当月30日）******
Case ndays=30
Copy To Array Asj FIELDS A30
asj[2]=asj[3]+asj[4]+asj[5]
asj[6]=asj[7]+asj[8]
asj[1]=asj[2]+asj[6]
Repl A30 With asj[2] For xh=2
Repl A30 With asj[6] For xh=6
Repl A30 With asj[1] For xh=1
Copy To Array Asj Fields bj0
asj[2]=asj[3]+asj[4]+asj[5]
asj[6]=asj[7]+asj[8]
asj[1]=asj[2]+asj[6]
Repl BJ0 With asj[2] For xh=2
Repl BJ0 With asj[6] For xh=6
Repl BJ0 With asj[1] For xh=1
Repl All bj With Round(bj0,0) &&&&人数四舍五入
Repl All bj With 1 for bj0<=1 AND bj0>0 &&&&人数小于1大于0,取1
Copy To Array Asj Fields bj
asj[2]=asj[3]+asj[4]+asj[5]
asj[6]=asj[7]+asj[8]
asj[1]=asj[2]+asj[6]
Repl BJ With asj[2] For xh=2
Repl BJ With asj[6] For xh=6
Repl BJ With asj[1] For xh=1
repl all L1 With A30
repl all L2 With bj
****计算期末人数（当月31日）******
Case ndays=31
Copy To Array Asj FIELDS A31
asj[2]=asj[3]+asj[4]+asj[5]
asj[6]=asj[7]+asj[8]
asj[1]=asj[2]+asj[6]
Repl A31 With asj[2] For xh=2
Repl A31 With asj[6] For xh=6
Repl A31 With asj[1] For xh=1
Copy To Array Asj Fields bj0
asj[2]=asj[3]+asj[4]+asj[5]
asj[6]=asj[7]+asj[8]
asj[1]=asj[2]+asj[6]
Repl BJ0 With asj[2] For xh=2
Repl BJ0 With asj[6] For xh=6
Repl BJ0 With asj[1] For xh=1
Repl All bj With Round(bj0,0) &&&&人数四舍五入
Repl All bj With 1 for bj0<=1 AND bj0>0 &&&&人数小于1大于0,取1
Copy To Array Asj Fields bj
asj[2]=asj[3]+asj[4]+asj[5]
asj[6]=asj[7]+asj[8]
asj[1]=asj[2]+asj[6]
Repl BJ With asj[2] For xh=2
Repl BJ With asj[6] For xh=6
Repl BJ With asj[1] For xh=1
repl all L1 With A31
repl all L2 With bj
EndCase
If nday=1
Sele xh,ny,部门,DM,L1,L2,&ndayfields,bj0,bj From rsb
Else
Sele xh,ny,部门,DM,L1,L2,&ndayfieldsold,&ndayfields,&ndayfields-&ndayfieldsold As 增减,bj0,bj From rsb Where &ndayfields-&ndayfieldsold<>0
EndIf
MessageBox("统计实有人数已完成",0+48,"提示信息")
EndIf
BROW FIELDS NY,部门,DM,L1,L2
ENDPROC
PROCEDURE command2.Click
dele file *.idx recycle &&& DELETE FILE 和 ERASE 这两个命令功能和语法格式完全相同 要删除同一类型文件：*.PRG 即可。
dele file *.bak recycle
dele file *.err recycle
CLOSE ALL
QUIT
ENDPROC
PROCEDURE command3.Click
Set Safety Off
cstr=""
For i=1 To 31
cstr=cstr+'A'+Alltrim(STR(i))+" N(4),"
endfor
cstr=Left(cstr,Len(cstr)-1)
Create Tabl Rsb (ny n(6),xh N(2),部门 c(30),DM C(2),TJ C(40),L1 N(4),L2 N(4),L3 N(4),&cstr,BJ0 N(7,2),BJ N(4))
Append From biaozhun_tabl.dbf
ENDPROC
ENDDEFINE
*
*-- 结束定义: form1
**************************************************
2017-01-07 21:18
