calcdlg.pro

利用人工智能程序设计语言prolog编程实现的公式计算软件源代码。

/*****************************************************************************

		Copyright (c) Phd 301 Workshop

 Project:  FORMULA
 FileName: CALCDLG.PRO
 Purpose: Developed by Chen Hongbiao, All Rights Reserved. 本软件使用权属于许王电脑公司。
 Written by: Dr. Chen Hongbiao (陈鸿标 )
 Comments:
******************************************************************************/

include "formula.inc"
include "formula.con"
include "hlptopic.con"

DATABASE-formula
f(string FName, string Formula, slist CommentsList,slist VarList)

DATABASE-record
determ edit_win(window Editwin)
var_value(real VarSeq,string Var, real VArVal)
%determ line_info(string Spec , real NowLine) %"nowLine"
determ calc_info(integer )%1=直接计算(no var)., 0= has fixed no of Var, 2=var num not fixed
determ form_info(string)  %"editable", "noedit"
determ modOrAddId(integer) %modify pb id or add f id
determ fv_record(integer Mode,string NewFormu,slist NewVarList,real NewVarNum)
record(string _extract_var, string NrFormu,slist NTVarList) %general purpose

%BEGIN_DLG calculator
/**************************************************************************
	Creation and event handling for dialog: calculator
**************************************************************************/
PREDICATES
ini_fcalc(window _win,string FName)
slist_strplus(slist InStrList, string Addstr,string TOutstr, string OutStr)
set_win_textlist_Loop(WINDOW _WinHand,SLIST StrList)
%get_varValue(window EditWin, real TVarNums,real VarNs,slist VarList,rlist VarVList,SLIst VVSList)
get_varValue(window EditWin, rlist VarValueList,slist VarValueSList,slist OutVarList)
input_handler:  EHANDLER
what_calc(string Item,integer Mode) %Mode=1,0,2, see calc_info( dbrecord)
set_focusYN(integer YN01, window WHandle)
%get_newVarList(string VarStr, slist NewVarList)
%check_FVar(string Formulus,slist NewVarList,string VarStr)
get_NewFV(integer Mode,string OldFormu,string NewFormu,slist OldVarList,slist NewVarlist,real VarNum)
extract_var(string Formulus, slist NewVarList,integer Mode)
check_var(integer _1, string T,slist TVarList, slist NewVarList)

CONSTANTS

%BEGIN calculator, CreateParms, 23:18:40-8.8.2001, Code automatically updated!
  dlg_calculator_ResID = idd_calculator
  dlg_calculator_DlgType = wd_Modeless
  dlg_calculator_Help = idh_contents
%END calculator, CreateParms

PREDICATES

  dlg_calculator_eh : EHANDLER
%  dlg_calculator_update(DIALOG_VAL_LIST)

CLAUSES

  dlg_calculator_Create(Parent):-

%MARK calculator, new variables

	dialog_CreateModeless(Parent,dlg_calculator_ResID,"",
  		[
%BEGIN calculator, ControlList, 23:18:40-8.8.2001, Code automatically updated!
		df(idc_edit_res,editstr("",[]),nopr),
		df(idc_edit_fcommts,editstr("",[]),nopr),
		df(idc_edit_finput,editstr("",[]),nopr),
		df(idc_list_fnames,listedit([],""),nopr)
%END calculator, ControlList
		],
		dlg_calculator_eh,0),!.

/*
%BEGIN calculator, idc_ok _CtlInfo
  dlg_calculator_eh(_Win,e_Control(idc_ok,_CtrlType,_CtrlWin,_CtrlInfo),0):-!,
	VALLIST = dialog_GetValues(_Win),
	dlg_calculator_update(VALLIST),
	!,fail.*/
%END calculator, idc_ok _CtlInfo
%MARK calculator, new events

/*
%BEGIN calculator, e_Move
  dlg_calculator_eh(_Win,e_Move(_X,_Y),0):-
	OuterRCT= win_GetOuterRect(_Win),
%	ClientRct = rect_GetClient(WSFLAGS,HasMenu,OuterRCT)
%	NewClient = rect_Offset(ClientRct ,10,10),
	Pwin=win_getParent(_Win),
	win_Move(PWin,OuterRCT ),	
	!.
%END calculator, e_Move

%BEGIN calculator, e_Native
  dlg_calculator_eh(_Win,e_Native(_Msg,_HDC,_LParam),1):-
	Msg1=cast(string, _Msg),
	dlg_note(Msg1),
	fail.
*/
/*  dlg_calculator_eh(_Win,e_Native(_Msg,HDC,_LParam),1):-
	write("msg=",_Msg,",Hdc=",Hdc),nl,
	fail,
%	win_SetBackColor(_Win,color_Red),
%	setTextColor(HDC, color_Red),
%	setBkColor(HDC,color_blue),
%	hbrush(HBRUSH),
	!. 
%END calculator, e_Native
*/
%BEGIN calculator, idc_list_fnames dropdown
  dlg_calculator_eh(_Win,e_Control(idc_list_fnames,_CtrlType,_CtrlWin,dropdown),0):-
	form_info("editable"),
	!.
%END calculator, idc_list_fnames dropdown

%BEGIN calculator, idc_pb_delf _CtlInfo
  dlg_calculator_eh(_Win,e_Control(idc_pb_delf,_CtrlType,_CtrlWin,_CtlInfo),0):-
	LboxWin=win_getCtlHandle(_Win,idc_list_fnames),
	lbox_GetSel(LboxWin,ItemList,_IndexList),
	ItemList=[Item|_],
	format(Msg, "确实要删除公式\"%-\"？", Item),
	Ans=dlg_Ask(Msg, ["删！(&D)","留着(&K)"]),
	Ans=resp_default,
	retract(f(Item,_,_,_)),!,
	format(Msg2,"公式\"%-\"已经被删除！", Item),
	beep,
	dlg_note("啊", Msg2),
	save("formula.tdb",formula),
%	lbox_Clear(LboxWin),
	ini_fcalc(_Win,""),
	!.
%END calculator, idc_pb_delf _CtlInfo

%BEGIN calculator, idc_pb_fmodify _CtlInfo
  dlg_calculator_eh(_Win,e_Control(idc_pb_fmodify,_CtrlType,_CtrlWin,_CtlInfo),0):-
	ModFText=win_GetText(_CtrlWin),
	ModFText="&G改!",
	%verify:
	Lbox=win_getCtlHandle(_Win,idc_list_fnames),
	lbox_GetSel(Lbox,ItemList,_IndexList),
	ItemList=[Item|_],
	format(Msg, "确实要修改公式\"%-\"？", Item),
	Ans=dlg_Ask(Msg, ["改！(&D)","留着(&K)"]),
	Ans=resp_default,
	retractall(modOrAddId(_)),
	assert(modOrAddId(idc_pb_fmodify)), 
	%del old:
	retract(f(Item,OldFormu,CMList,OldVarList)),!,
	retractall(form_info(_)),
	assert(form_info("editable")),	
	%change interface
	set_ctlText(_Win, [idc_pb_fmodify], "完&W"),
	DisIdList=[idc_ok,idc_pb_delf,idc_pb_addf],
	set_wins_state(_win, DisIdList,[wsf_disabled]),
	edit_win(EditWin),
	win_setState(EditWin,[wsf_disabled]),
	edit_win(Editwin),
	slist_strplus(OldVarList,",", "",OldVarStr),
	edit_PasteStr(EditWin, OldVarStr),
	CMList=[Cmt|_],
	set_ctlText(_Win,[idc_edit_fcommts],Cmt),
	FWin=win_getCtlHandle(_Win, idc_edit_finput),
	ComWin=win_getCtlHandle(_Win, idc_edit_fcommts),
	win_SetEditCtlReadOnly(Comwin,0),
	win_SetEditCtlReadOnly(Fwin,0),
	win_setText(FWin, OldFOrmu),
	win_setFocus(Fwin),
	!.
  dlg_calculator_eh(_Win,e_Control(idc_pb_fmodify,_CtrlType,_CtrlWin,_CtlInfo),0):-
	ModFText=win_GetText(_CtrlWin),
	ModFText="改!",
	beep,
	dlg_note("没有作任何改动。"),
	ini_fcalc(_Win,""),
	!.
  dlg_calculator_eh(_Win,e_Control(idc_pb_fmodify,_CtrlType,_CtrlWin,_CtlInfo),0):-
	ModFText=win_GetText(_CtrlWin),
	ModFText="完&W",
	%get new form name
	LboxWin=win_getCtlHandle(_win, idc_list_fnames),
	NewName=win_getText(LboxWin),
	fronttoken(NewName,_,_),
%	write("new formula name:", NewName),nl,
	%get new formulus:
	FormWin=win_GetCtlHandle(_Win, idc_edit_finput),
	Formulus=win_GetText(FormWin),	
	%get comments:
	ComWin=win_GetCtlHandle(_Win, idc_edit_fcommts),
	Comments=win_GetText(ComWin),		
	extract_var(Formulus, NewVarList,Mode),
	slist_length(NewVarList,NewVN),
%	write("modify, Newvarlist=",NewVarlist),nl,
	retractall(fv_record(_,_,_,_)),
	assert(fv_record(Mode,Formulus,NewVarList,NewVN)),
	%assert new formula:
	assert(f(NewName,Formulus, [Comments],NewVarList)),
%	write("assert new f(",NewName,",", Formulus, ",",Comments,",",NewVarList,")"),nl,
	save("formula.tdb",formula),
	%save data and re_set all controls
	EnableIdList=[idc_ok,idc_pb_delf,idc_pb_addf],
	set_wins_state(_win, EnableIdList,[wsf_enabled]),
	edit_win(Editwin),
	win_setState(EditWin,[wsf_enabled]),
%	set_ctlText(_Win,[idct_txt_input],"变量输入："),
	set_ctlText(_Win, [idc_pb_fmodify], "&G改!"),
	retractall(form_info(_)),
	assert(form_info("noedit")),
%	retractall(f(_,_,_,_)),
%	lbox_Clear(LboxWin),
	save("formula.tdb",formula),
	ini_fcalc(_Win,NewName),
	beep,
	dlg_note("公式已经被修改！"),
	!.
%END calculator, idc_pb_fmodify _CtlInfo

%BEGIN calculator, e_Create
  dlg_calculator_eh(_Win,e_Create(_CreationData),0):-!,
	Flags1 = [wsf_Border	],
	FONT = font_Create(ff_System,[], 10),
	InitPos=1,
 %test:
 	Pwin=win_getParent(_Win),
 	win_GetFontMetrics(PWin, Leading, Acent, Descent),
/* 	write("Leading=",Leading,",Acent=", Acent, ",Descent=",Descent),nl,
 	_RCT=win_GetClientRect(_Win),
 	write("Rct=",_RCT),nl,
  	Cmwin=win_getCtlHandle(_Win,idc_edit_fcommts),
  	_RCTcm=win_GetClientRect(CmWin),
	 write("cmRCT=",_RCTcm),nl,
	*/
	C=Acent+Descent,
	L0=17.75*C, L=cast(integer, L0),
	T0=6.315*(C+Leading), T=cast(integer,T0),
	R0=32.25*C, R=cast(integer,R0),
	B0=11*(C+Leading), B=cast(integer, B0), 
	/*the above four constants are attained by RCTcm data when set to different fonts,
	 for eg: in win32,  Acent=13, Descent=3, while in win95: 16,4
	 Rigth constant=RCTcm'Right/(13+3),
	 T and B constants=RCTcm'T/(3+13+3),
	*/
  	EditWin=edit_Create(w_child, rct(L,T,R,B), "",no_menu, _win, Flags1, Font, b_false, b_false, 
 	              "", InitPos, input_handler), %in win32, client RCT is : 236,120,468,210
	retractall(edit_win(_)),
	assert(edit_win(Editwin)),
	ini_fcalc(_win,""),
	%ini default is direct calc
	retractall(calc_info(_)),
	assert(calc_info(1)), 
%	win_enableHook(_Win,1),
	OuterRCT= win_GetOuterRect(_Win),
	win_Move(PWin,OuterRCT ),	
	%%set Chinese text to controls:
	dialog_SetControlTitle(_Win,idct_fcalc_1,"选择公式："),
	dialog_SetControlTitle(_Win,idc_pb_addf,"<增&Z"),
	dialog_SetControlTitle(_Win,idc_pb_delf,"&S删>"),
	dialog_SetControlTitle(_Win,idc_pb_fmodify,"&G改!"),
	dialog_SetControlTitle(_Win,idct_fcalc_3,"公式说明："),
	dialog_SetControlTitle(_Win,idct_fcalc_2,"公式："),
	dialog_SetControlTitle(_Win,idct_txt_input,"变量输入："),
	dialog_SetControlTitle(_Win,idct_fcalc_4,"结果："),
	dialog_SetControlTitle(_Win,idc_pb_copyres,"拷贝(&K)"),
	dialog_SetControlTitle(_Win,idc_ok,"计算(&O)"),
	dialog_SetControlTitle(_Win,idc_cancel,"关闭(&C)"),
	dialog_SetControlTitle(_Win,idc_help,"帮助(&H)"),
	win_SetText(_Win, "公式计算器(V1.0)"),
	!.
%END calculator, e_Create

%BEGIN calculator, idc_edit_fcommts modified
/*
  dlg_calculator_eh(_Win,e_Control(idc_edit_fcommts,_CtrlType,_CtrlWin,modified),0):- %if string exceedes 13 chinese char
	form_info("editable"),
	Text=win_getText(_CtrlWin),
%	write("tx=",Text),nl,
	str_len(Text,L),
	L>26,
	concat(Text,"\n",Text1),
	win_settext(_CtrlWin,Text1),
	!.
*/
  dlg_calculator_eh(_Win,e_Control(idc_edit_fcommts,_CtrlType,_CtrlWin,modified),0):- %if input "。",mena end
	form_info("editable"),
	Text=win_getText(_CtrlWin),
%	write("tx=",Text),nl,
	searchstring(Text,"。",_P),
	Text1=Text,
%	del_str(Text, "\n", Text1),
	win_settext(_CtrlWin,Text1),
	Ans=dlg_ask("输入完了吗？", ["完了(&Y)" ,"没完(&N)"]),
	Ans=resp_default,
	modOrAddId(MAiD),
	MAWin=win_getCtlHandle(_win,Maid),
	win_sendEvent(_win,e_Control(MAiD,wc_pushbutton,MAWin,activated)), 
	!.
  dlg_calculator_eh(_Win,e_Control(idc_edit_fcommts,_CtrlType,_CtrlWin,modified),0):-
	form_info("editable"),
	!.
%END calculator, idc_edit_fcommts modified
/*
%BEGIN calculator, idc_list_fnames _CtlInfo
  dlg_calculator_eh(_Win,e_Control(idc_list_fnames,_CtrlType,_CtrlWin,_CtlInfo),0):-
	write("lbox, what=",_CtLInfo),nl,
	!.
%END calculator, idc_list_fnames _CtlInfo
*/
%BEGIN calculator, idc_list_fnames modified
  dlg_calculator_eh(_Win,e_Control(idc_list_fnames,_CtrlType,_CtrlWin,modified),0):-
	form_info("noedit"),
%	Ans=dlg_ask("是否希望修改公式？", ["是(&Y)", "不(&N)"]),
%	Ans=resp_default,
	AddPbWin=win_getCtlHandle(_win, idc_pb_fmodify), 
	retractall(modOrAddId(_)),
	assert(modOrAddId(idc_pb_fmodify)), 
	_Reply=win_SendEvent(_Win,e_Control(idc_pb_fmodify,wc_PushButton,AddPbWin,activated)),
	!.
  dlg_calculator_eh(_Win,e_Control(idc_list_fnames,_CtrlType,_CtrlWin,modified),0):-%not want to modify
	form_info("noedit"),
	ini_fcalc(_Win,""),
	!.
  dlg_calculator_eh(_Win,e_Control(idc_list_fnames,_CtrlType,_CtrlWin,modified),0):-
	form_info("noedit"),
%	Text=win_getText(_CtrLWin),
%	write("Text=",Text),nl,
	!.
%END calculator, idc_list_fnames modified

%BEGIN calculator, idc_pb_addf _CtlInfo
  dlg_calculator_eh(_Win,e_Control(idc_pb_addf,_CtrlType,_CtrlWin,_CtlInfo),0):-
	AddFText=win_GetText(_CtrlWin),
	AddFText="<增&Z", 
	retractall(modOrAddId(_)),
	assert(modOrAddId(idc_pb_addf)), 
	NewName=dlg_GetStr("输入公式名称","请在下面的框中输入输入公式名称。输入完后按\"Ok\"键：", ""),
	fronttoken(NewName,_,_),
	%clear controls:
	edit_win(EditWin),
	edit_PasteStr(EditWin, ""),
	CtlIdList=[idc_edit_fcommts,idc_edit_finput,idc_edit_res,idc_list_fnames],	
	set_ctlText(_win, CtlIdList, ""),
	retractall(form_info(_)),
	assert(form_info("editable")),	
	set_ctlText(_Win, [idc_pb_addf], "完&W"),
	DisIdList=[idc_ok,idc_pb_delf,idc_pb_fmodify],
	set_wins_state(_win, DisIdList,[wsf_disabled]),
	Lbox=win_getCtlHandle(_win, idc_list_fnames),
	win_SetFocus(Lbox),
	win_setState(EditWin,[wsf_disabled]),
%	set_ctlText(_Win,[idct_txt_input],"输入变量名，用英文逗号分隔："),
	%updat new form name
	win_setText(Lbox, NewName),
	FWin=win_getCtlHandle(_Win, idc_edit_finput),
	ComWin=win_getCtlHandle(_Win, idc_edit_fcommts),
	win_SetEditCtlReadOnly(Comwin,0),
	win_SetEditCtlReadOnly(Fwin,0),
	win_setFocus(Fwin),
	!.
 dlg_calculator_eh(_Win,e_Control(idc_pb_addf,_CtrlType,_CtrlWin,_CtlInfo),0):-
	AddFText=win_GetText(_CtrlWin),
	AddFText="完&W",
	%get new form name
	LboxWin=win_getCtlHandle(_win, idc_list_fnames),
	NewName=win_getText(LboxWin),
	fronttoken(NewName,_,_),
%	write("new formula name:", NewName),nl,
	%get new formulus:
	FormWin=win_GetCtlHandle(_Win, idc_edit_finput),
	Formulus=win_GetText(FormWin),	
	%get comments:
	ComWin=win_GetCtlHandle(_Win, idc_edit_fcommts),
	Comments=win_GetText(ComWin),		
%	write("Comments=",Comments),nl,
	%get variables:
	extract_var(Formulus, NewVarList,Mode),
%	write("addf, Newvarlist=",NewVarlist),nl,
	retractall(fv_record(_,_,_,_)),
	slist_length(NewVarList,NewVN),
	assert(fv_record(Mode,Formulus,NewVarList,NewVN)),
	%assert new formula:
	assert(f(NewName,Formulus, [Comments],NewVarList)),
%	write("assert new f(",NewName,",", Formulus, ",",Comments,",",NewVarList,")"),nl,
	save("formula.tdb",formula),
	%save data and re_set all controls
	set_ctlText(_Win, [idc_pb_addf], "<增&Z"),
	EnableIdList=[idc_ok,idc_pb_delf,idc_pb_fmodify],
	set_wins_state(_win, EnableIdList,[wsf_enabled]),
	edit_win(Editwin),
	win_setState(EditWin,[wsf_enabled]),
	set_ctlText(_Win,[idct_txt_input],"变量输入："),
	retractall(form_info(_)),
	assert(form_info("noedit")),
	retractall(f(_,_,_,_)),
	lbox_Clear(LboxWin),
	ini_fcalc(_Win,NewName),
	beep,
	format(Msg,"新公式\"%-\"已经被加入。",NewName),
	dlg_note("好！", Msg),
	!.
	
	
	
%END calculator, idc_pb_addf _CtlInfo

%BEGIN calculator, idc_help _CtlInfo
  dlg_calculator_eh(_Win,e_Control(idc_help,_CtrlType,_CtrlWin,_CtlInfo),0):-!,
%	project_ShowHelpContext(1),
	vpi_ShowHelp("formula.hlp"),
	!.