⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 delphi编的排课管理系统
💻 PAS
📖 第 1 页 / 共 3 页
字号:
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 + -