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

📄 unit1.~pas

📁 Windows定时设置精灵(delphi).rar
💻 ~PAS
📖 第 1 页 / 共 3 页
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, jpeg, StdCtrls, TFlatRadioButtonUnit,
  TFlatGroupBoxUnit, TFlatEditUnit, TFlatButtonUnit,shellapi, Menus,
  abfComponents, TFlatCheckBoxUnit,Registry, TFlatPanelUnit, ComCtrls,
  ToolWin, TFlatCheckListBoxUnit, TFlatGaugeUnit, TFlatMemoUnit;
  const
  mymsg=wm_user+1;
  iid=100;
  var
  ntid:tnotifyicondataa;
  boot:boolean;
  bootr:boolean;
  reg:TRegistry;
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    FlatGroupBox1: TFlatGroupBox;
    FlatRadioButton1: TFlatRadioButton;
    FlatRadioButton2: TFlatRadioButton;
    FlatRadioButton3: TFlatRadioButton;
    FlatEdit1: TFlatEdit;
    FlatEdit2: TFlatEdit;
    FlatEdit3: TFlatEdit;
    FlatEdit4: TFlatEdit;
    FlatEdit5: TFlatEdit;
    FlatEdit6: TFlatEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    FlatButton1: TFlatButton;
    Timer2: TTimer;
    FlatButton2: TFlatButton;
    Panel2: TPanel;
    Label9: TLabel;
    Image2: TImage;
    Image3: TImage;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    FlatButton4: TFlatButton;
    Timer3: TTimer;
    Image4: TImage;
    FlatCheckBox1: TFlatCheckBox;
    FlatPanel1: TFlatPanel;
    FlatGroupBox3: TFlatGroupBox;
    FlatButton6: TFlatButton;
    FlatGroupBox4: TFlatGroupBox;
    FlatButton7: TFlatButton;
    FlatButton8: TFlatButton;
    FlatCheckBox2: TFlatCheckBox;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Bevel1: TBevel;
    FlatButton12: TFlatButton;
    FlatButton13: TFlatButton;
    FlatButton14: TFlatButton;
    FlatButton11: TFlatButton;
    FlatPanel2: TFlatPanel;
    FlatGroupBox5: TFlatGroupBox;
    FlatButton9: TFlatButton;
    FlatButton10: TFlatButton;
    FlatPanel3: TFlatPanel;
    pf: TFlatCheckListBox;
    FlatButton15: TFlatButton;
    FlatButton16: TFlatButton;
    Label11: TLabel;
    Panel1: TPanel;
    Label10: TLabel;
    ks: TFlatCheckListBox;
    Panel3: TPanel;
    Bevel2: TBevel;
    Label12: TLabel;
    FlatPanel4: TFlatPanel;
    Image5: TImage;
    Bevel3: TBevel;
    FlatPanel5: TFlatPanel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    FlatPanel6: TFlatPanel;
    FlatButton17: TFlatButton;
    FlatButton23: TFlatButton;
    FlatButton24: TFlatButton;
    FlatButton25: TFlatButton;
    FlatButton26: TFlatButton;
    FlatButton27: TFlatButton;
    Bevel4: TBevel;
    FlatButton18: TFlatButton;
    FlatButton20: TFlatButton;
    FlatButton21: TFlatButton;
    FlatButton22: TFlatButton;
    FlatPanel7: TFlatPanel;
    Bevel5: TBevel;
    Bevel6: TBevel;
    Bevel7: TBevel;
    Label18: TLabel;
    Label19: TLabel;
    FlatGauge1: TFlatGauge;
    Label20: TLabel;
    Label21: TLabel;
    FlatGauge2: TFlatGauge;
    Timer4: TTimer;
    Timer5: TTimer;
    Timer6: TTimer;
    Timer7: TTimer;
    Label22: TLabel;
    Label23: TLabel;
    FlatGauge3: TFlatGauge;
    Label24: TLabel;
    Label25: TLabel;
    FlatGauge4: TFlatGauge;
    FlatPanel8: TFlatPanel;
    FlatMemo1: TFlatMemo;
    FlatPanel10: TFlatPanel;
    Label40: TLabel;
    FlatPanel9: TFlatPanel;
    FlatGauge5: TFlatGauge;
    FlatGauge6: TFlatGauge;
    FlatGauge7: TFlatGauge;
    FlatGauge8: TFlatGauge;
    FlatGauge9: TFlatGauge;
    FlatGauge10: TFlatGauge;
    FlatGauge11: TFlatGauge;
    FlatGauge12: TFlatGauge;
    FlatGauge13: TFlatGauge;
    FlatGauge14: TFlatGauge;
    FlatGauge15: TFlatGauge;
    FlatGauge16: TFlatGauge;
    FlatGauge17: TFlatGauge;
    FlatGauge18: TFlatGauge;
    Label26: TLabel;
    Label27: TLabel;
    Label28: TLabel;
    Label29: TLabel;
    Label30: TLabel;
    Label31: TLabel;
    Label32: TLabel;
    Label33: TLabel;
    Label34: TLabel;
    Label35: TLabel;
    Label36: TLabel;
    Label37: TLabel;
    Label38: TLabel;
    Label39: TLabel;
    FlatMemo2: TFlatMemo;
    Image6: TImage;
    Image7: TImage;
    Image8: TImage;
    Image9: TImage;
    FlatPanel11: TFlatPanel;
    FlatButton29: TFlatButton;
    Bevel8: TBevel;
    FlatCheckBox3: TFlatCheckBox;
    abfWav1: TabfWav;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FlatButton1Click(Sender: TObject);
    procedure FlatButton3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer2Timer(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FlatButton4Click(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure FlatButton5Click(Sender: TObject);
    procedure FlatButton11Click(Sender: TObject);
    procedure FlatButton6Click(Sender: TObject);
    procedure FlatButton7Click(Sender: TObject);
    procedure FlatButton8Click(Sender: TObject);
    procedure FlatButton9Click(Sender: TObject);
    procedure FlatButton10Click(Sender: TObject);
    procedure FlatCheckBox2Click(Sender: TObject);
    procedure FlatButton12Click(Sender: TObject);
    procedure FlatButton13Click(Sender: TObject);
    procedure FlatButton16Click(Sender: TObject);
    procedure FlatButton15Click(Sender: TObject);
    procedure FlatButton14Click(Sender: TObject);
    procedure FlatButton18Click(Sender: TObject);
    procedure Timer4Timer(Sender: TObject);
    procedure Timer5Timer(Sender: TObject);
    procedure Timer6Timer(Sender: TObject);
    procedure Timer7Timer(Sender: TObject);
    procedure FlatButton20Click(Sender: TObject);
    procedure FlatButton21Click(Sender: TObject);
    procedure FlatButton22Click(Sender: TObject);
    procedure FlatButton17Click(Sender: TObject);
    procedure FlatButton29Click(Sender: TObject);
    procedure FlatButton23Click(Sender: TObject);
    
  private
  procedure WmNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  procedure mymessage(var message:tmessage);message mymsg;
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  it:tsystemtime;
  w:boolean;
  qr:boolean;
  wy,ty,ly:string;
implementation

uses Unit2, Unit3;

{$R *.dfm}
procedure TForm1.WmNCHitTest(var Msg: TWMNCHitTest);
begin
  DefaultHandler(Msg);
  if Msg.Result = HTCLIENT then
    Msg.Result := HTCAPTION;
end;
procedure setautorun(aprogtitle,acmdline:string;arunonce:boolean);
var
hkey:string;
hreg:treginifile;
begin
  if arunonce then
  hkey:='once'
  else
  hkey:='';
  hreg:=treginifile.Create('');
  hreg.WriteString('software\microsoft\windows\currentversion\run'+hkey+#0,
  aprogtitle,
  acmdline);
  hreg.Destroy;
  end; 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if (it.wyear=strtoint(flatedit1.text)) and
     (it.wmonth=strtoint(flatedit2.text)) and
     (it.wday=strtoint(flatedit3.text)) and
     (it.whour=strtoint(flatedit5.text)) and
     (it.wminute=strtoint(flatedit4.text)) and
     (it.wsecond=strtoint(flatedit6.text)) and
     (flatradiobutton2.Checked=true) then
  begin
    w:=false;
    form1.close;
    exitwindowsex(ewx_reboot,0);
  end;
if (it.wyear=strtoint(flatedit1.text)) and
(it.wmonth=strtoint(flatedit2.text)) and
(it.wday=strtoint(flatedit3.text)) and
(it.whour=strtoint(flatedit5.text)) and
(it.wminute=strtoint(flatedit4.text)) and
(it.wsecond=strtoint(flatedit6.text)) and
(flatradiobutton1.Checked=true) and
w=true then
  begin
    w:=false;
    form1.close;
    exitwindowsex(ewx_logoff,0);
  end;
if (it.wyear=strtoint(flatedit1.text)) and
(it.wmonth=strtoint(flatedit2.text)) and
(it.wday=strtoint(flatedit3.text)) and
(it.whour=strtoint(flatedit5.text)) and
(it.wminute=strtoint(flatedit4.text)) and
(it.wsecond=strtoint(flatedit6.text)) and
(flatradiobutton3.Checked=true) and
w=true then
  begin
    w:=false;
    form1.Close ;
    exitwindowsex(ewx_shutdown,0);
  end;
if (it.wyear=strtoint(flatedit1.text)) and
(it.wmonth=strtoint(flatedit2.text)) and
(it.wday=strtoint(flatedit3.text)) and
(it.whour=strtoint(flatedit5.text)) and
((strtoint(flatedit4.text)*60+strtoint(flatedit6.text)-(it.wminute*60+it.wsecond))<=30) and
((strtoint(flatedit4.text)*60+strtoint(flatedit6.text)-(it.wminute*60+it.wsecond))>=0)  and
w=true then
begin
bootr:=true;
end
else bootr:=false;
if bootr=true then
 begin
  label9.Caption:=inttostr(strtoint(flatedit4.text)*60+strtoint(flatedit6.text)-(it.wminute*60+it.wsecond));
  if (boot=true) and (w=true) then
  begin
   ntid.hIcon :=image3.Picture .icon.Handle ;
   shell_notifyicona(nim_modify,@ntid);
   boot:=false;
  end
  else
  begin
   ntid.hIcon :=image2.Picture .icon.Handle ;
   shell_notifyicona(nim_modify,@ntid);
   boot:=true;
  end;
 end;
end;

procedure tform1.mymessage(var message:tmessage);
var
mypt:tpoint;
begin
  inherited;
  if message.LParam =wm_rbuttonup then
    begin
      getcursorpos(mypt);
      popupmenu1.Popup(mypt.x,mypt.y);
    end;
  if message.LParam=wm_lbuttonup then
  begin
  form1.Show;
  end;
  message.result:=0;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
  errno:integer;
  hmutex:hwnd;
  hr:thandle;
  small:integer;
  i:integer;
begin
ClientWidth:=Image1.Width;
ClientHeight:=Image1.Height;
setautorun(application.Title ,application.ExeName ,false);
    reg:=tregistry.Create ;
    reg.rootkey:=HKEY_current_user;
    reg.OpenKey('software\microsoft\windows\currentversion\policies\message',true);
    if reg.ReadString('c')='1' then
    else
    reg.WriteString('c','0'); 
    if reg.ReadString('autorun')='1' then
    flatcheckbox2.Checked:=true
    else
    if reg.ReadString('autorun')='0' then
    flatcheckbox2.Checked:=false;
    if flatcheckbox2.Checked=true then
    reg.Writestring('autorun','1')
    else
    reg.WriteString('autorun','0');
    reg.closekey;//关闭该键
    reg.free;//释放
bootr:=false;
boot:=true;
ntid.cbSize :=sizeof(tnotifyicondataa);
ntid.Wnd:=handle;
ntid.uID:=iid;
ntid.uFlags:=nif_icon+nif_tip+nif_message;
ntid.uCallbackMessage:=mymsg;
ntid.hIcon :=image2.Picture .icon.Handle ;
ntid.szTip:='Windows设置精灵';
shell_notifyicona(nim_add,@ntid);
hmutex:=createmutex(nil,false,pchar(application.title));
errno:=getlasterror;
if errno=error_already_exists then begin
application.messagebox('软件重复运行','重复运行', mb_ok);
application.Terminate;
shell_notifyicona(nim_delete,@ntid);
end;
w:=false;
timer1.Enabled:=false;
getlocaltime(it);
flatedit1.text:=inttostr(it.wYear);
flatedit2.text:=inttostr(it.wmonth);
flatedit3.text:=inttostr(it.wday);
flatedit5.text:=inttostr(it.whour);
flatedit4.text:=inttostr(it.wminute);
flatedit6.text:=inttostr(it.wsecond);
  reg:=tregistry.Create ; //////////////////////
  reg.rootkey:=HKEY_current_user;
  reg.OpenKey('software\microsoft\windows\currentversion\policies\explorer',false);
  ty:=reg.ReadString('timp');
  if ty='' then label10.caption:='无任何盘隐藏'
  else
  label10.Caption:=ty+'盘已隐藏';
  ly:=reg.ReadString('timp2');
  if ly='' then label11.Caption:='没有隐藏项目'
  else

⌨️ 快捷键说明

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