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

📄 zrzxkzxt.pas

📁 这是一个有DELPHI编写的自动作息时间打铃控制程序,具有灵活的权限分配,能灵活编写作时间,并有手动打铃功能,能自已加入铃声.你自己看吧
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit zrzxkzxt;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, MPlayer, shellapi, DBTables,ts,senguoqiUnit,
  Menus, ComCtrls, Mask, DBCtrls, DB, Grids, DBGrids;
 const
 icon_id=1;
 mi_iconevent=wm_user+1;
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    MediaPlayer1: TMediaPlayer;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    Label3: TLabel;
    Panel3: TPanel;
    Image1: TImage;
    Timer2: TTimer;
    Image2: TImage;
    BitBtn6: TBitBtn;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    StatusBar1: TStatusBar;
    N4: TMenuItem;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    Query1: TQuery;
    Query1Xianmu: TSmallintField;
    Query1Stime: TSmallintField;
    Query1Ftime: TSmallintField;
    Query1Mtime: TSmallintField;
    Query1PathName: TStringField;
    Timer3: TTimer;
    N5: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer2Timer(Sender: TObject);
    procedure MediaPlayer1Notify(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);

  private
    { Private declarations }
    normalicon,disabledicon:Ticon;
    status:boolean;

    procedure InstallIcon;
    procedure changeicon(s:boolean);
    procedure uninstallicon;
    procedure icononclick(var message:tmessage);message mi_iconevent;
    procedure wmnchittest(var msg:twmnchittest);message wm_nchittest;
  public
    { Public declarations }
    Loged : integer;
    medpath:string;
    UserName , UserPwd : string;
    function CheckUser(AUserName , AUserPwd : string):integer;
    procedure Init(P : integer);

  end;

var
  Form1: TForm1;
   
implementation

uses pianchen, ulong,uGloabVar,guanyuunit;

{$R *.dfm}
function Tform1.CheckUser(AUserName , AUserPwd : string):integer;
var
  Query : TQuery;
begin
  try
    Query := TQuery.Create(nil);
    Query.DatabaseName :=DBName;//'wfxznzxkz';
    Query.SQL.Add('select * from tsyhb where UserName=:UserName');
    Query.ParamByName('UserName').AsString := AUserName;
    Query.Open;
    if Query.RecordCount = 0 then
    begin
      MessageDlg('用户名错误',mtError,[mbok],0);
      Result := -1;
      Exit;
    end else begin
      if Query.FieldByName('UserPwd').AsString <> AUserPwd then
      begin
        MessageDlg('用户名或口令错误',mtError,[mbok],0);
        Result := -1;
        Exit;
      end
      else Result := Query.FieldByName('Class').AsInteger;
    end;
    Query.Close;
    Query.Free;
  except
     Result := -1;
     MessageDlg('连接数据库出错',mtError,[mbok],0);
  end;
end;

procedure Tform1.Init(P: integer);
begin
  case P of
    -1 : begin
           StatusBar1.Panels[0].Text := '程序处于运行状态';
           StatusBar1.Panels[1].Text := '';
           UserName := '';
           UserPwd := '';
           //InitView;
         end;
    0  : begin
           StatusBar1.Panels[0].Text :='程序处于编辑状态  用户名:超级用户';
           StatusBar1.Panels[1].Text := '用户描述:超级用户';
           bitbtn2.Enabled:=true;    // 超级用户具有最高权限,可以编时间表;
           bitbtn3.Enabled:=true;
           bitbtn4.Enabled:=true;
           bitbtn5.Enabled:=true;    //编辑临时作息时间表
           bitbtn6.Enabled:=true;
         end;
    1  : begin
           StatusBar1.Panels[0].Text := '用户名:'+UserName;
           StatusBar1.Panels[1].Text := '用户描述:一般管理员';
           bitbtn4.Enabled:=true;    //操作员权限,可以主持升国旗仪式。
           bitbtn5.Enabled:=true;
         end;
    2  : begin
           StatusBar1.Panels[0].Text := '用户名:'+UserName;
           StatusBar1.Panels[1].Text := '用户描述:操作员';
           bitbtn4.Enabled:=true;
          end;
    3  :begin
           StatusBar1.Panels[0].Text := '用户名:'+UserName;
           StatusBar1.Panels[1].Text := '用户描述:操作员';
           bitbtn3.Enabled:=true;
          end;
  end;
end;




procedure tform1.changeicon(s:boolean);
 var icondata:tnotifyicondata;
 begin
 icondata.cbSize:=sizeof(icondata);
 icondata.Wnd:=handle;
 icondata.uID:=icon_id;
 if s=false then
 begin
 icondata.hIcon:=disabledicon.Handle;
 status:=false;
 end
 else
 begin
 icondata.hIcon:=normalicon.Handle;
 status:=true;
 end;
 icondata.uFlags:=nif_icon;
 shell_notifyicon(nim_modify,@icondata);
 end;


procedure   med(Sender: TObject;var medpath:string);
 begin
  //form1.MediaPlayer1.Close;
  form1.mediaplayer1.FileName:=medpath;
  form1.MediaPlayer1.Open;
  form1.MediaPlayer1.Play;
end;




procedure tform1.icononclick(var message:tmessage);
var
p:tpoint;
begin
if ((message.LParam=wm_lbuttondown) and (status=true)) then //如果用左键按托盘图标
 begin
if Loged = -1 then
  begin
    if long.ShowModal = mrok then    //调用登录窗  如果按了确定
       begin
         UserName := long.Edit1.Text;   //取登录窗用户输入的用户名与口今
         UserPwd := Long.Edit2.Text;
         Loged := CheckUser(UserName,UserPwd); //调用管理者数据表并进行查询
       end
    else Loged := -1;     //如果按了取消
    if Loged <> -1 then
       begin
         Init(Loged);
       end;
  end;
end;
 if(message.LParam=wm_rbuttondown) then    //如果用右键按托盘图标
begin                                    //弹出菜单
getcursorpos(p);
PopupMenu1.Popup(p.X,p.Y);
end;
end;

procedure tform1.InstallIcon;
var
icondata:tnotifyicondata;
begin
 normalicon:=ticon.Create;
 disabledicon:=ticon.Create;
 normalicon.LoadFromFile('normal.ico');
 disabledicon.LoadFromFile('disable.ico');
 icondata.cbSize:=sizeof(icondata);
 icondata.Wnd:=handle;
 icondata.uID:=icon_id;
 icondata.uFlags:=nif_icon or nif_message or nif_tip;
 icondata.uCallbackMessage:=mi_iconevent;
 icondata.hIcon:=normalicon.Handle;
 icondata.szTip:='智能作息控制系统';
 shell_notifyicon(nim_add,@icondata);
 end;

 procedure tform1.uninstallicon;
 var
 icondata:tnotifyicondata;
 begin
 icondata.cbSize:=sizeof(icondata);
 icondata.Wnd:=handle;
 icondata.uID:=icon_id;
 shell_notifyicon(nim_delete,@icondata);
 end;



procedure ShowNum(image1:timage;x,position:integer);
begin
image1.Canvas.CopyRect(rect(position*32,0,(position+1)*32,48),form1.Image2.Canvas,rect(x*32,0,(x+1)*32,48));
end;

procedure tform1.wmnchittest(var msg:twmnchittest);  //使窗体可以拖动
begin
defaulthandler(msg);
if msg.result=htclient then
msg.result:=htcaption;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var
Year, Month, Day, DOW: Word;
days: array[1..7] of string;
Hour, Min, Sec, MSec: Word;    //
Hour1, Min1, Sec1:integer;     //
Hour2, Min2, Sec2: integer;
begin
 DecodeDateFully(Date, Year, Month, Day, DOW);
  days[1] := '星期日';
  days[2] := '星期一';
  days[3] := '星期二';
  days[4] := '星期三';
  days[5] := '星期四';
  days[6] := '星期五';
  days[7] := '星期六';
  label1.Caption:= days[DOW];
  label2.Caption:=inttostr(Year)+'年'+inttostr(Month)+'月';
  label3.Caption:=inttostr(Day);

 DecodeTime(Time, Hour, Min, Sec, MSec); //
 if hour<10 then
   begin
      Hour1:=0;
      Hour2:=Hour;
   end
 else
   begin
      Hour1:=Hour div 10;
      Hour2:=Hour mod 10;
   end;

 if Min<10 then
   begin
      Min1:=0;
      Min2:=Min;
   end
 else
   begin
      Min1:=Min div 10;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -