📄 main.pas
字号:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, ExtCtrls, jpeg, DB, DBTables, Menus,
XPBarMenu, ComCtrls,shellapi, FR_Class, ToolWin, ImgList, ADODB, Grids,
DBGridEh, DBCtrls, PrnDbgeh, ExtDlgs;
type
Tf_main = class(TForm)
d: TImage;
MainMenu1: TMainMenu;
XPBarMenu1: TXPBarMenu;
N1: TMenuItem;
N3: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
sb: TStatusBar;
N15: TMenuItem;
N17: TMenuItem;
N27: TMenuItem;
ImageList2: TImageList;
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
ToolButtonexit: TToolButton;
ToolButton1: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
N4: TMenuItem;
cd: TColorDialog;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton8: TToolButton;
PrintDialog1: TPrintDialog;
N2: TMenuItem;
ToolButton9: TToolButton;
SpeedButton5: TSpeedButton;
pb: TProgressBar;
N10: TMenuItem;
N5: TMenuItem;
N11: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
opd1: TOpenPictureDialog;
ImageList1: TImageList;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure N6Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure SpeedButton2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure SpeedButton3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure SpeedButton4MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure N27Click(Sender: TObject);
procedure dMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButtonexitClick(Sender: TObject);
procedure e_jiereKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ToolButton2Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton5MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure SpeedButton1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure SpeedButton4Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N13Click(Sender: TObject);
procedure N19Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N15Click(Sender: TObject);
procedure N17Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure opd1CanClose(Sender: TObject;
var CanClose: Boolean);
procedure N20Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure N14Click(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N9Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
f_main: Tf_main;
// function can_pk(week:integer,note:integer,code:integer):boolean;
implementation
uses
dl_main,yhdl, dlll, password, u_base, u_apply, u_set_tj,u_data, U_look,
u_wrong, u_add_user,u_abort;
{$R *.dfm}
//判断老师是否能上课及同一地点是否有两个班上课函数;
function can_pk(week:integer;note:string;tec_code:integer;adr_code:integer):boolean;
var can,yes:boolean;
n,now:integer;
begin
can:=true;
yes:=true;
with datamodule1 do
begin
have_pk.Close;
have_pk.Open;
have_pk.First ;
while not have_pk.Eof do
begin
if have_pk['code']<>null then
begin
t_scan.Close;
t_scan.TableName :='kc'+inttostr(have_pk['code'])+'.db';
//找到周数及节数地点的代码;
now:=2 ;
for n:=1 to week-1 do now:=now+2;
t_scan.Open;
t_scan.RecNo :=now;
if t_scan[note]<>null then//如果该节不为空;
begin
if t_scan[note]=adr_code then yes :=false else yes:=true;
CAN:=CAN AND YES;
end
else //如果该节不为空;
begin
can:=true;
have_pk.Next ;
continue;
end;
IF can=false then break; //判断是否可以排课,如不可以直接跳出;
t_scan.Close;
//找周数及节数老师的代码;
now:=3;
for n:=1 to week-1 do now:=now+3;
t_scan.Open;
t_scan.RecNo :=now;
if t_scan[note]<>0 then
begin
if t_scan[note]=tec_code then yes:=false else yes:=true;
can:=can and yes;
if can=false then break; //判断是否可以排课,如不可以直接跳出;
end
else
begin
can:=true;
have_pk.Next ;
continue;
end;
end;
have_pk.Next ;
end;
have_pk.Close;
t_scan.Close;
end;
result:=can;
end;
procedure Tf_main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
mainform.Close;
end;
procedure Tf_main.N6Click(Sender: TObject);
begin
mainform.Close;
f_main.Close ;
application.Terminate ;
end;
procedure Tf_main.N10Click(Sender: TObject);
var
classcode:string;
begin
//shellexecute(handle,nil,pchar('mailto:nwn31@163.net'),nil,nil,SW_SHOWNORMAL);
with datamodule1 do
begin
have_pk.Close;
have_pk.EmptyTable;
tb_class.Close;
tb_class.Filtered :=false;
tb_class.Filter :='';
tb_class.Open;
tb_class.First ;
while not tb_class.Eof do
begin
classcode:=inttostr(tb_class['code']);
temp.Close;
temp2.Close;
temp.TableName:='';
temp.TableName :='kc'+classcode+'.db';
temp2.TableName :='';
temp2.TableName :='pk'+classcode+'.db';
temp.Close;
temp.EmptyTable ;
temp2.Close;
temp2.EmptyTable ;
tb_class.Next ;
end;
tb_class.Close;
temp.Close;
tb_apply.Close;
tb_apply.Open;
tb_apply.First ;
while not tb_apply.Eof do
begin
tb_apply.Edit ;
tb_apply['ready']:=tb_apply['xueshi'];
tb_apply.Post ;
tb_apply.Next ;
end;
end;
showmessage('清空完毕!');
end;
procedure Tf_main.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
sb.Panels[0].Text :='';
SpeedButton1.Font.Color:=clwindow;
SpeedButton2.Font.Color:=clwindow;
SpeedButton3.Font.Color:=clwindow;
SpeedButton4.Font.Color:=clwindow;
end;
procedure Tf_main.SpeedButton2MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
SpeedButton2.Font.Color:=clblue;
sb.Panels[0].Text :='进行班级排课的申请';
end;
procedure Tf_main.SpeedButton3MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
SpeedButton3.Font.Color:=clblue;
sb.Panels[0].Text :='排课前的条件设置';
end;
procedure Tf_main.SpeedButton4MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
SpeedButton4.Font.Color:=clblue;
sb.Panels[0].Text :='开始进行计算机自动排课';
end;
procedure Tf_main.N27Click(Sender: TObject);
begin
f_dl.Show ;
end;
procedure Tf_main.dMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
SpeedButton1.Font.Color:=clwindow;
SpeedButton2.Font.Color:=clwindow;
SpeedButton3.Font.Color:=clwindow;
SpeedButton4.Font.Color:=clwindow;
speedbutton5.Font.Color :=clwindow;
sb.Panels[0].Text :='';
end;
procedure Tf_main.ToolButton4Click(Sender: TObject);
begin
f_dl.Show ;
end;
procedure Tf_main.ToolButtonexitClick(Sender: TObject);
begin
mainform.Close;
f_main.Close ;
application.Terminate ;
end;
procedure Tf_main.e_jiereKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=13 then
begin
end;
end;
procedure Tf_main.ToolButton2Click(Sender: TObject);
begin
f_base.show;
end;
procedure Tf_main.SpeedButton2Click(Sender: TObject);
begin
f_apply.show;
end;
procedure Tf_main.SpeedButton3Click(Sender: TObject);
begin
f_set_tj.show;
end;
procedure Tf_main.SpeedButton5MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
SpeedButton5.Font.Color:=clblue;
sb.Panels[0].Text :='设置班级排课和基本信息';
end;
procedure Tf_main.SpeedButton1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
SpeedButton1.Font.Color:=clblue;
sb.Panels[0].Text :='查看,修改及打印排课结果';
end;
procedure Tf_main.SpeedButton4Click(Sender: TObject);
var adr,kc,tec:array[1..20] of integer; //一周的地点;
a1,a2,a3,a4,a5:array[1..2] of integer;
a6,a7:array[1..5] of integer;
num,wk,code,week_times,ready_pk,i,j,l,id,tech_code,room_code:integer;//本学期周;
path,j_class,lsh,class_name,classcode,kc_code,ii,kind,note:string;//kind为体育课的标志;
sing:boolean;
begin
//取得排课周数;
path:=extractfilepath(application.ExeName)+'\pk.ini';
wk:=getprivateprofileint(
'team',
'week',
0,
pchar(path));
//设置进度条;
//开始按班级进行排课;
with datamodule1 do
begin
tb_class.Close;
tb_class.Open;
tb_class.First ;
pb.Max :=wk*tb_class.RecordCount;
pb.Step :=1;
while not tb_class.Eof do
begin //1-开始进行班级排课;
class_name:=tb_class['name'];
sb.Panels[0].Text :='正在排'+class_name+'的课程';
f_main.Refresh ;
classcode:=inttostr(tb_class['code']);
temp.close;
temp.TableName:='';
temp.TableName :='kc'+classcode+'.db';
t_date.Open; //打开日期表;
t_date.First ;
for i:=1 to wk do //按周进行排课;20为周数;
begin //2-开始进行一学期的排课;
for j:=1 to 20 do
begin //31-初始化一周的课程及地点;
adr[j]:=0;
kc[j]:=0;
end; //end-31
for l:=1 to 2 do
begin //begin 32
a1[l]:=0;
a2[l]:=0;
a3[l]:=0;
a4[l]:=0;
a5[l]:=0;
end; //end-32
//初始化第四节课;
for l:=1 to 5 do
begin//begin 33
a6[l]:=0;
a7[l]:=0;
end;//end-33
//从日期表里读入放假的信息写入放假的信息;
if t_date['y1']=false then //如果星期一为放假;1000表示放假;
begin
a1[1]:=99;
a1[2]:=99;
a6[1]:=99;
a7[1]:=99;
end;
if t_date['y2']=false then//如果星期二为放假;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -