unit5.~pas

以前在某高校做外聘教师时做的学生学籍管理系统(delphi+access)。献丑献丑

unit Unit5;

interface

uses
  IniFiles,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ImgList , Buttons, jpeg, XPMenu,implemntation,DB, ADODB,
  ComCtrls,SHELLAPI, Menus;

type
  TForm5 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    ImageList1: TImageList;
    Image1: TImage;
    N9: TMenuItem;
    N10: TMenuItem;
    XPMenu1: TXPMenu;
    F1: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    Timer1: TTimer;
    D1: TMenuItem;
    N13: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    H1: TMenuItem;
    N14: TMenuItem;
    B1: TMenuItem;
    R1: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    StatusBar1: TStatusBar;
    T1: TMenuItem;
    N17: TMenuItem;
    W1: TMenuItem;
    N18: TMenuItem;
    H2: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N19: TMenuItem;
    U1: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N13Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure F1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure B1Click(Sender: TObject);
    procedure R1Click(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure H1Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N22Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure U1Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N3Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form5: TForm5;
  int_config:Tinifile;

implementation

uses Unit1, Unit4, Unit3, Unit6, about, Unit2, Unit7, Unit8, Unit9, Unit10,
  Unit11, Manage_Users;



{$R *.dfm}


function Login_Msg(Prompt: string='您没有足够的权限，请先登录系统！';Caption: string = '登录提示';Flag: LongInt = MB_OK +MB_ICONINFORMATION): integer;
begin
Result := Application.MessageBox(PChar(Prompt), PChar(Caption), Flag);
end;


procedure OpenForm(FormClass: TFormClass; var fm; AOwner:TComponent);
//用于创建MDI子窗口的过程
var
  i: integer;
  Child:TForm;
begin
  for i := 0 to Screen.FormCount -1 do
      if Screen.Forms[i].ClassType=FormClass then
      begin
        Child:=Screen.Forms[i];
        if Child.WindowState=wsMinimized then
           ShowWindow(Child.handle,SW_SHOWNORMAL)
        else
           ShowWindow(Child.handle,SW_SHOWNA);
        if (not Child.Visible) then Child.Visible:=True;
        Child.BringToFront;
        Child.Setfocus;
        TForm(fm):=Child;
        exit;
      end;
  Child:=TForm(FormClass.NewInstance);
  TForm(fm):=Child;
  Child.Create(AOwner);
end;



procedure TForm5.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if application.MessageBox('确认要退出程序吗？','退出确认',mb_yesno)=  mrYes then begin
    Action := caFree;
    application.Terminate; end
  else
    Action := caNone;

end;


procedure TForm5.N13Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then begin Login_Msg(); N12Click(sender);  end else  begin
OpenForm(tform4,form4,self);
end;
end;




procedure TForm5.N6Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then   begin Login_Msg(); N12Click(sender);  end else  begin
OpenForm(tform3,form3,self);
end;
end;

procedure TForm5.N7Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then   begin Login_Msg(); N12Click(sender);  end else  begin
OpenForm(tform1,form1,self);
end;
end;

procedure TForm5.N4Click(Sender: TObject);
begin
close;
end;

procedure TForm5.N10Click(Sender: TObject);
begin
frm_about:=tfrm_about.create(application);
frm_about.ShowModal;
end;

procedure TForm5.F1Click(Sender: TObject);
begin
login_user:='None';
form2.ShowModal;
end;

procedure TForm5.FormCreate(Sender: TObject);
begin


Application.Title:=Product_Name;
self.Caption:=Product_Name;   //程序标题名称

self.height:=peg_height;
self.Width:=peg_width;

//self.Height:=Screen.Height;   //设置全屏显示
//self.Width:=Screen.Width;
self.Update;
self.Position:= poScreenCenter;

end;






procedure TForm5.N12Click(Sender: TObject);
begin
application.CreateForm(Tform2, form2);
form2.ShowModal;
end;

procedure TForm5.Timer1Timer(Sender: TObject);
var i,n:integer;
ks: tkeyboardstate;
year,month,day:word;now2:TDateTime;
begin

if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then f1.Enabled:=false else f1.Enabled:=true; //注销菜单状态
if login_user='do_not_login' then n12.Enabled:=false else n12.Enabled:=true;   //如果系统不需要登录则禁止登录命令
//当注销管理后关闭所有子窗体
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then begin
   if self.MDIChildCount>0 then begin
        n:=self.MDIChildCount;
        for i:=0 to n do  self.MDIChildren[0].free;
   end;
 end;

//控制状态栏的显示
if state_bar then statusbar1.Visible:=true
 else if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then statusbar1.Visible:=false
 else begin
   if self.MDIChildCount=0 then statusbar1.Visible:=false
   else
   statusbar1.Visible:=true;
 end;





  getkeyboardstate(ks); //检测键盘状态显示在状态栏函数
  statusbar1.panels.items[0].text := '状态: '+state;
  if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then statusbar1.panels.items[1].text := '用户: 未登录' else statusbar1.panels.items[1].text :='用户: '+login_user_name;
  if odd(ks[VK_NUMLOCK]) then statusbar1.panels.items[6].text := 'NUM' else statusbar1.panels.items[6].text := '';
  if odd(ks[VK_INSERT])  then statusbar1.panels.items[5].text := '编辑状态: 插入' else statusbar1.panels.items[5].text := '编辑状态: 改写';
  if odd(ks[VK_CAPITAL]) then statusbar1.panels.items[4].text := '大小写: 大写' else statusbar1.panels.items[4].text := '大小写: 小写';
  now2:=date();  decodedate(now2,year,month,day);
  STATUSBAR1.Panels.Items[7].TEXT:=inttostr(year)+'年'+inttostr(month)+'月'+inttostr(day)+'日 '+ TIMEtostr(time());
  if now_num<>'' then statusbar1.panels.items[2].text :='第 '+now_num+' 条记录' else  statusbar1.panels.items[2].text :='';
  if all_num<>'' then statusbar1.panels.items[3].text :='总共 '+all_num+' 条记录' else statusbar1.panels.items[3].text :='';


end;

procedure TForm5.N2Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then   begin Login_Msg(); N12Click(sender);  end else  begin
OpenForm(tform8,form8,self);
form8.Hide;
form8.QuickRep1.Preview;

end;
end;

procedure TForm5.FormActivate(Sender: TObject);
begin


state:='欢迎使用 '+Product_Name;
Product_Dir:=ExtractFilePath(ParamStr(0));   //把当前程序的绝对路径放进全局变量中
end;

procedure TForm5.B1Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then   begin Login_Msg(); N12Click(sender);  end else  begin
BakupDataBase:=tBakupDataBase.create(application);
BakupDataBase.Showmodal;
end;
end;




procedure TForm5.R1Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then   begin Login_Msg(); N12Click(sender);  end else  begin
        RestoreDataBase:=tRestoreDataBase.create(application);
        RestoreDataBase.Showmodal;

 end;


end;







procedure TForm5.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
state:='欢迎使用 '+Product_Name;

end;

procedure TForm5.H1Click(Sender: TObject);
begin
ShellExecute(handle,'open',pchar(Home_Url),'','',SW_SHOWNORMAL);
end;

procedure TForm5.N17Click(Sender: TObject);
begin
login_user:='';
application.CreateForm(Tform2, form2);
form2.ShowModal;
if login_user='admin' then
begin
  Application.CreateForm(TOpertion, Opertion);
  Opertion.ShowModal;
 end else showmessage('你的权限不够，不能使用本功能！');

end;


procedure TForm5.N18Click(Sender: TObject);
begin
cascade;
end;

procedure TForm5.N21Click(Sender: TObject);
begin
tilemode:=tbHorizontal;
tile;
end;

procedure TForm5.N22Click(Sender: TObject);
begin
TileMode:=tbVertical;
tile;
end;

procedure TForm5.N19Click(Sender: TObject);
var i:integer;
begin
if self.MDIChildCount>0 then begin
        for i:=0 to self.MDIChildCount do  self.MDIChildren[0].free;
   end;


end;



procedure TForm5.FormResize(Sender: TObject);
begin

if FileExists(Product_Dir+'config.ini') then

begin

ini_config:=Tinifile.create(Product_Dir+'config.ini');
data_path:=ini_config.readstring('initialization','data_path',data_path);
login_user:=ini_config.readstring('initialization','login_user','None');
state_bar:=ini_config.readbool('initialization','state_bar',state_bar);
start_log:=ini_config.readbool('initialization','start_log',start_log);
bakup_num:=strtoint(ini_config.readstring('backup','bakup_num',inttostr(bakup_num)));
start_bakup:=ini_config.readbool('backup','start_bakup',start_bakup);
bakup_dir:=ini_config.readstring('backup','Bakup_Dir',bakup_dir);
Bg_Sound:=ini_config.readstring('initialization','bg_sound',bg_sound);
peg_height:=strtoint(ini_config.readstring('initialization','peg_height',inttostr(peg_height)));
peg_width:=strtoint(ini_config.readstring('initialization','peg_width',inttostr(peg_width)));

ini_config.Free;        //释放

end;

end;

procedure TForm5.U1Click(Sender: TObject);
begin
login_user:='';
application.CreateForm(Tform2, form2);
form2.ShowModal;
if login_user<>'' then
begin
Application.CreateForm(Tform12, form12);
form12.ShowModal;
end;

end;

procedure TForm5.N16Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then begin Login_Msg(); N12Click(sender);  end else  begin
showmessage('此功能模块开发未完成！');
end;
end;

procedure TForm5.N3Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then begin Login_Msg(); N12Click(sender);  end else  begin
showmessage('此功能模块开发未完成！');
end;
end;

end.