unitmain.pas

来自「这是我做的一个大学院系成绩管理系统」· PAS 代码 · 共 391 行

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, mmsystem, Menus, StdCtrls, AppEvnts;

type
  TFMain = class(TForm)
    form_main: TImage;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    ImageBar11: TImage;
    ImageBar12: TImage;
    ImageClose: TImage;
    ImageMini: TImage;
    ImageBar21: TImage;
    ImageBar22: TImage;
    ImageBar41: TImage;
    ImageBar32: TImage;
    ImageBar33: TImage;
    ImageBar34: TImage;
    ImageBar31: TImage;
    Image5: TImage;
    Image6: TImage;
    Image7: TImage;
    Image8: TImage;
    Image9: TImage;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    PopupMenu2: TPopupMenu;
    N3: TMenuItem;
    N4: TMenuItem;
    PopupMenu3: TPopupMenu;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    PopupMenu4: TPopupMenu;
    N9: TMenuItem;
    PopupMenu5: TPopupMenu;
    N10: TMenuItem;
    N11: TMenuItem;
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Image1Click(Sender: TObject);
    procedure ShowBar(BarNo:Integer);
    procedure FormActivate(Sender: TObject);
    procedure ImageCloseClick(Sender: TObject);
    procedure ImageMiniClick(Sender: TObject);
    procedure Image_logbgMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
    procedure Image2Click(Sender: TObject);
    procedure Image3Click(Sender: TObject);
    procedure Image4Click(Sender: TObject);
    procedure ImageBar11Click(Sender: TObject);
    procedure ImageBar21Click(Sender: TObject);
    procedure ImageBar41Click(Sender: TObject);
    procedure ImageBar22Click(Sender: TObject);
    procedure ImageBar12Click(Sender: TObject);
    procedure FreeFrm(Sender: TObject);
    procedure ImageBar31Click(Sender: TObject);
    procedure ImageBar32Click(Sender: TObject);
    procedure ImageBar33Click(Sender: TObject);
    procedure Image5Click(Sender: TObject);
    procedure Image6Click(Sender: TObject);
    procedure Image7Click(Sender: TObject);
    procedure Image8Click(Sender: TObject);
    procedure Image9Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure ImageBar34Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FMain: TFMain;
  CurrBar: Integer;
  IsCreat: bool;

implementation

uses UnitDefine, UnitUsers, UnitBackup, UnitStuinfo, UnitIscore,
  UnitMscore, UnitSquery, UnitCourse, UnitClass, UnitLogin, UnitAbout,
  UnitStat, UnitHelp;

{$R *.dfm}

{初始化函数}
procedure TFMain.FormCreate(Sender: TObject);
begin
   CurrBar := 3;
   IsCreat := True;
   UnitDefine.ExeRoot := GetCurrentDir;
   FreeFrm(self);
   with TFrmIscore.Create(self) do
   begin
     Parent := FMain;
     Left := 220;
     Top := 195;
     Show;
   end;
end;

{析构函数}
procedure TFMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  IsCreat := True;
  sndplaysound(pchar(ExeRoot+'\sound\logout.wav'),snd_async);
  FMLogin.Create(self).Show; 
end;

 procedure TFMain.Image_logbgMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if (ssleft in shift) then
  begin
    releasecapture;
    perform(wm_syscommand, $f012, 0);
  end;
end;


{侧栏图标显示函数}
procedure TFMain.ShowBar(BarNo:Integer);
var
  i,j:integer;
  AImage:TComponent;
begin
  if  barno>currbar then
  begin
    for i := currbar+1 to barno do
    begin
      Aimage := FMain.FindComponent('Image' + IntToStr(i));
      if Aimage is Timage then TImage(AImage).top :=  TImage(AImage).top-134;
    end;
  end
  else
  begin
    for i := barno+1 to currbar do
    begin
      Aimage := FMain.FindComponent('Image' + IntToStr(i));
      if Aimage is Timage then TImage(AImage).top :=  TImage(AImage).top+134;
    end;
  end;
  for i:=1 to 4 do
    for j:=1 to 4 do
    begin
      Aimage := FMain.FindComponent('ImageBar' + IntToStr(i) + IntToStr(j));
      if Aimage is Timage then
        if i=BarNo then
          TImage(AImage).Visible := True
        else
          TImage(AImage).Visible := False;
    end;
  if CurrBar<>BarNo then sndplaysound(pchar(ExeRoot+'\sound\folder.wav'),snd_async);
  CurrBar := BarNo;
end;

procedure TFMain.FormActivate(Sender: TObject);
begin
  if IsCreat then
  begin
    sndplaysound(pchar(ExeRoot+'\sound\login.wav'),snd_async);
    ShowBar(3);
    IsCreat := False;
  end;
end;

procedure TFMain.Image1Click(Sender: TObject);
begin
    ShowBar(1);
end;

procedure TFMain.ImageCloseClick(Sender: TObject);
begin
Application.Terminate;
end;

procedure TFMain.ImageMiniClick(Sender: TObject);
begin
Application.Minimize;
end;

procedure TFMain.Image2Click(Sender: TObject);
begin
    ShowBar(2);
end;

procedure TFMain.Image3Click(Sender: TObject);
begin
 ShowBar(3);
end;

procedure TFMain.Image4Click(Sender: TObject);
begin
 ShowBar(4);
end;


procedure TFMain.FreeFrm(Sender: TObject);
var
   i:integer;
begin
   for i:=0 to self.ComponentCount-1 do
    if (self.Components[i] is Tframe) then (self.Components[i] as Tframe).Free;
end;


{--------------------------------------------}
{-以下各个为相应框架窗体在主窗体上显示的函数-}
{--------------------------------------------}

procedure TFMain.ImageBar11Click(Sender: TObject);
begin
  if(g_UserType='管理员') then
  begin
      FreeFrm(self);
      with TFrmUsers.Create(self) do
      begin
        Parent := FMain;
        Left := 220;
        Top := 195;
        Show;
      end;
  end
  else
  begin
      messagebox(handle,PChar('用户:'+g_UserName+' 无此权限,请与管理员联系!'),'警告',MB_ICONinformation+mb_ok);
  end;

end;

procedure TFMain.ImageBar12Click(Sender: TObject);
begin
  if(g_UserType='管理员') then
  begin
      FreeFrm(self);
      with TFrmBackup.Create(self) do
      begin
        Parent := FMain;
        Left := 220;
        Top := 195;
        Show;
      end;
  end
  else
   begin
      messagebox(handle,PChar('用户:'+g_UserName+' 无此权限,请与管理员联系!'),'警告',MB_ICONinformation+mb_ok);
   end;
end;


procedure TFMain.ImageBar21Click(Sender: TObject);
begin
      FreeFrm(self);
      with TFrmStuinfo.Create(self) do
      begin
        Parent := FMain;
        Left := 220;
        Top := 195;
        Show;
      end;
end;

procedure TFMain.ImageBar22Click(Sender: TObject);
begin
      FreeFrm(self);
      with TFrmClass.Create(self) do
      begin
        Parent := FMain;
        Left := 220;
        Top := 195;
        Show;
      end;
end;

procedure TFMain.ImageBar31Click(Sender: TObject);
begin
     FreeFrm(self);
      with TFrmIscore.Create(self) do
      begin
        Parent := FMain;
        Left := 220;
        Top := 195;
        Show;
      end;
end;

procedure TFMain.ImageBar32Click(Sender: TObject);
begin

      FreeFrm(self);
      with TFrmMscore.Create(self) do
      begin
        Parent := FMain;
        Left := 220;
        Top := 195;
        Show;
      end;
end;

procedure TFMain.ImageBar33Click(Sender: TObject);
begin
       FreeFrm(self);
      with TFrmSquery.Create(self) do
      begin
        Parent := FMain;
        Left := 220;
        Top := 195;
        Show;
      end;
end;

procedure TFMain.ImageBar41Click(Sender: TObject);
begin
      FreeFrm(self);
      with TFrmCourse.Create(self) do
      begin
        Parent := FMain;
        Left := 220;
        Top := 195;
        Show;
      end;
end;

procedure TFMain.Image5Click(Sender: TObject);
begin
PopupMenu1.Popup(FMain.Left +Image5.Left ,FMain.Top + Image5.Top + Image5.Height + 1);
end;

procedure TFMain.Image6Click(Sender: TObject);
begin
PopupMenu2.Popup(FMain.Left +Image6.Left ,FMain.Top + Image6.Top + Image6.Height + 1);
end;

procedure TFMain.Image7Click(Sender: TObject);
begin
 PopupMenu3.Popup(FMain.Left +Image7.Left ,FMain.Top + Image7.Top + Image7.Height + 1);
end;

procedure TFMain.Image8Click(Sender: TObject);
begin
 PopupMenu4.Popup(FMain.Left +Image8.Left ,FMain.Top + Image8.Top + Image8.Height + 1);
end;

procedure TFMain.Image9Click(Sender: TObject);
begin
 PopupMenu5.Popup(FMain.Left +Image9.Left ,FMain.Top + Image9.Top + Image9.Height + 1);
end;

procedure TFMain.N11Click(Sender: TObject);
begin
FMAbout.ShowModal;
end;

procedure TFMain.ImageBar34Click(Sender: TObject);
begin
     FreeFrm(self);
      with TFrmStat.Create(self) do
      begin
        Parent := FMain;
        Left := 220;
        Top := 195;
        Show;
      end;
end;

procedure TFMain.N10Click(Sender: TObject);
begin
  FMHelp.WebBrowser1.Navigate(ExeRoot+'\help\index.htm');
  FMHelp.ShowModal;
end;

procedure TFMain.ApplicationEvents1Exception(Sender: TObject;
  E: Exception);
begin
showmessage(E.Message);
end;

end.