如何在VFp中使用代码修改日历

Question

如题所述

Answer 1

Local oForm
oForm = createobject("SetDate")
oForm.show(1)
retu

Define CLASS SetDate AS form

Top = 0
Left = 0
Height = 140
Width = 339
DoCreate = .T.
Caption = "设置系统日期"
WindowType = 1
Name = "Form1"

Add OBJECT label1 AS label WITH ;
AutoSize = .F., ;
Caption = "年", ;
Height = 16, ;
Left = 34, ;
Top = 24, ;
Width = 14, ;
TabIndex = 7, ;
Name = "Label1"

Add OBJECT label2 AS label WITH ;
AutoSize = .F., ;
Caption = "月", ;
Height = 16, ;
Left = 34, ;
Top = 61, ;
Width = 14, ;
TabIndex = 8, ;
Name = "Label2"

Add OBJECT label3 AS label WITH ;
AutoSize = .F., ;
Caption = "日", ;
Height = 16, ;
Left = 34, ;
Top = 97, ;
Width = 14, ;
TabIndex = 9, ;
Name = "Label3"

Add OBJECT command1 AS commandbutton WITH ;
Top = 19, ;
Left = 223, ;
Height = 25, ;
Width = 84, ;
Caption = "设置", ;
TabIndex = 4, ;
Name = "Command1"

Add OBJECT command2 AS commandbutton WITH ;
Top = 54, ;
Left = 223, ;
Height = 25, ;
Width = 84, ;
Caption = "查看系统日期", ;
TabIndex = 5, ;
Name = "Command2"

Add OBJECT command3 AS commandbutton WITH ;
Top = 91, ;
Left = 223, ;
Height = 25, ;
Width = 84, ;
Caption = "关闭", ;
TabIndex = 6, ;
Name = "Command3"

Add OBJECT spinner1 AS spinner WITH ;
Height = 20, ;
Left = 59, ;
SpinnerHighValue = 2100.00, ;
SpinnerLowValue = 1980.00, ;
TabIndex = 1, ;
Top = 18, ;
Width = 120, ;
Name = "Spinner1"

Add OBJECT spinner2 AS spinner WITH ;
Height = 20, ;
Left = 59, ;
SpinnerHighValue = 12.00, ;
SpinnerLowValue = 1.00, ;
TabIndex = 2, ;
Top = 57, ;
Width = 120, ;
Name = "Spinner2"

Add OBJECT spinner3 AS spinner WITH ;
Height = 20, ;
Left = 59, ;
SpinnerHighValue = 31.00, ;
SpinnerLowValue = 1.00, ;
TabIndex = 3, ;
Top = 92, ;
Width = 120, ;
Name = "Spinner3"

Procedure decimal2hex
Lparameters tnvalue, ;
tnplaces
Local lnplaces, ;
lchex, ;
lcout, ;
lni
lnplaces = IIF(pcount() = 1, 4, tnplaces)
lchex = thisform.reversedecimal2hex(tnvalue, lnplaces)
lcout = ''
For lni = 1 TO lnplaces
lcout = lcout + SUBSTR(lchex, lnplaces - lni + 1, 1)
Next lni
Return lcout
Endproc

Procedure reversedecimal2hex
Lparameters tnvalue, ;
tnplaces
Local lndecimal, ;
lchex, ;
lncurrdecimals, ;
lnplaces, ;
lni, ;
lnexponent, ;
lntemp
lndecimal = tnvalue
lchex = ''
lncurrdecimals = SET('DECIMALS')
lnplaces = IIF(pcount() = 1, 4, tnplaces)
Set DECIMALS TO 17
For lni = lnplaces TO 1 STEP -1
lnexponent = 256 ^ (lni - 1)
lntemp = INT(lndecimal/lnexponent)
lchex = lchex + CHR(lntemp)
lndecimal = lndecimal - lntemp * lnexponent
Next lni
Set DECIMALS TO lncurrdecimals
Return lchex
Endproc

Procedure reversehex2decimal
Lparameters tcword
Local lndecimal, ;
lni
lndecimal = 0
For lni = LEN(tcword) TO 1 STEP -1
lndecimal = lndecimal + ASC(SUBSTR(tcword, lni, 1)) * 256^(LEN(tcword) - lni)
Next lni
Return lndecimal
Endproc

Procedure hex2decimal
Lparameters tcvalue, ;
tlsigned
Local lndecimal, ;
lnlen, ;
lni, ;
lnmsb, ;
lnmax
lndecimal = 0
lnlen = LEN(tcvalue)
For lni = 1 TO lnlen
lndecimal = lndecimal + ASC(SUBSTR(tcvalue, lni, 1)) * 256 ^ (lni - 1)
Next lni
If tlsigned
lnmsb = (lnlen * 8) - 1
If BITTEST(lndecimal, lnmsb)
lnmax = 2 ^ (lnmsb + 1)
lndecimal = lnresult - lnmax
Endif
Endif
Return lndecimal
Endproc

Procedure Init
Declare GetLocalTime IN Win32API STRING @lpSystemTime
Declare SetLocalTime IN Win32API STRING lpSystemTime
lpsystemtime = SPACE(16)
If !getlocaltime(@lpsystemtime)
Wait WINDOW "读取系统日期失败"
Return .f.
Else
Thisform.spinner1.value = thisform.hex2decimal(SUBSTR(lpsystemtime,1,2))
Thisform.spinner2.value = thisform.hex2decimal(SUBSTR(lpsystemtime,3,2))
Thisform.spinner3.value =thisform.hex2decimal(SUBSTR(lpsystemtime,7,2))
Endif
Endproc

Procedure command1.Click
lpsystemtime = SPACE(16)

If !getlocaltime(@lpsystemtime)
Wait WINDOW "读取系统日期失败"
Endif

lpsystemtime = ;
THISFORM.decimal2hex(THISFORM.spinner1.VALUE,2)+;
THISFORM.decimal2hex(THISFORM.spinner2.VALUE,2)+;
SUBSTR(lpsystemtime,5,2)+;
THISFORM.decimal2hex(THISFORM.spinner3.VALUE,2)+;
RIGHT(lpsystemtime,8)

If !setlocaltime(lpsystemtime)
Wait WINDOW "设置系统日期失败"
Else
Wait WINDOW "设置系统日期成功"
Endif
Endproc

Procedure command2.Click
Run/n control timedate.cpl
Endproc

Procedure command3.Click
Thisform.release
Endproc

Enddefine