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

📄 unit1.pas

📁 一个时钟,适合初学者学习使用,有什么意见联系我
💻 PAS
字号:
{          电脑闹钟3.0-风之铃
          版权所有(C)         2003.3            <风之铃>
    这一程序是自由软件,你可以遵照自由软件基金会出版的GNU通用公共许可
证条款来修改和重新发布这一程序。或者用许可证的第二版,或者(根据你的选
择)用任何更新的版本。
    发布这一程序的目的是希望它有用,但没有任何担保。甚至没有适合特定目
的的隐含的担保。更详细的情况请参阅GNU通用公共许可证。
    你应该已经和程序一起收到一份GNU通用公共许可证的副本。如果还没有,
写信给:
    The Free Software Foundation, Inc.,  675  Mass Ave,  Cambridge,
    MA02139,  USA

    风之铃:tel:0712-83155 or 13610412046
}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons,MMSystem,Registry,shellapi, Menus, jpeg,
  MPlayer, ComCtrls,inifiles;

const
WM_TRAYNOTIFY=WM_USER+1;//定义通知消息

type
  TAutoWave = class(TForm)
    Edit8: TEdit;
    Timer1: TTimer;
    CheckBox1: TCheckBox;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    X1: TMenuItem;
    A1: TMenuItem;
    MediaPlayer1: TMediaPlayer;
    V1: TMenuItem;
    S1: TMenuItem;
    Image1: TImage;
    N3: TMenuItem;
    B1: TMenuItem;
    N2: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    D1: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure X1Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure V1Click(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N3Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
  private
    { Private declarations }
    procedure Minimize(var mess:TWMNCLBUTTONDOWN);message WM_NCLBUTTONDOWN;
  public
    { Public declarations }
  procedure WndProc(var Msg: TMessage); override;
  end;


var
  AutoWave: TAutoWave;
  fullrgn,clientrgn,ctlrgn:Thandle;
  defaultwav:char;
  ylx,yly:integer;
  GaiB,filename:string;
  nd0,nd1:NotifyIconData;
  hs:array[0..9]of LongWord;
  region:HRgn;
  myinifile:Tinifile;
  voice,settime:array[1..3] of string;
  shutswitch:boolean;
  autoshut:string;
procedure Baoshi(s:string);
procedure Kaishi();
procedure AdjustToken;

implementation

uses Unit2, About, Unit3;

{$R *.DFM}
{$R wav.res}
{$R image.res}

procedure AdjustToken; //获得系统NT,win2000 的关机权限
var
  hdlProcessHandle: Cardinal;
  hdlTokenHandle: Cardinal;
  tmpLuid: Int64;
  tkp: TOKEN_PRIVILEGES;
  tkpNewButIgnored: TOKEN_PRIVILEGES;
  lBufferNeeded: Cardinal;
  Privilege: array[0..0] of _LUID_AND_ATTRIBUTES;
begin
  hdlProcessHandle := GetCurrentProcess;
  OpenProcessToken(hdlProcessHandle,
    (TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY), hdlTokenHandle);
  LookupPrivilegeValue('', 'SeShutdownPrivilege', tmpLuid);
  Privilege[0].Luid := tmpLuid;
  Privilege[0].Attributes := SE_PRIVILEGE_ENABLED;
  tkp.PrivilegeCount := 1;
  tkp.Privileges[0] := Privilege[0];
  AdjustTokenPrivileges(hdlTokenHandle, False, tkp, Sizeof(tkpNewButIgnored),
    tkpNewButIgnored, lBufferNeeded);
end;

procedure TAutoWave.Timer1Timer(Sender: TObject);
var
i:integer;
begin
edit8.text:=formatdatetime('hh:nn:ss',time);
for i:=1 to 3 do    //查找是否有此时间点
begin
        if settime[i]=edit8.Text then
        begin
        mediaplayer1.Close ;
        mediaplayer1.FileName :=voice[i];
        mediaplayer1.Open ;
        mediaplayer1.Position :=0;
        mediaplayer1.Play ;
        end;
end;

if (autoshut=edit8.Text) and (shutswitch) then
        begin
//        timer1.Destroy ;
        AdjustToKen;
        ExitWindowsEx(EWX_poweroff, 0);
        end;

if GaiB=FormatDateTime('nn',time) then exit else GaiB:=FormatDateTime('nn',time);
if strtoint(GaiB) mod 60=0 then  //整点报时
    kaishi;

end;

procedure TAutoWave.FormDestroy(Sender: TObject);
begin
myinifile.Destroy ;
Shell_NotifyIcon(NIM_DELETE,@nd0);//将图标从任务栏状态区删除
mediaplayer1.Close ; //关闭播放器
deleteobject(region);//删除自定义区域
end;


procedure TAutoWave.FormCreate(Sender: TObject);
var
regRegistry: TRegistry;

begin

//读取ini文件
myinifile:=Tinifile.Create(ExtractFilePath(paramstr(0))+'myini.ini');
voice[1]:=myinifile.Readstring('程序参数','wav1','');
voice[2]:=myinifile.ReadString('程序参数','wav2','');
voice[3]:=myinifile.ReadString('程序参数','wav3','');
settime[1]:=myinifile.ReadString('程序参数','settime1','');
settime[2]:=myinifile.ReadString('程序参数','settime2','');
settime[3]:=myinifile.ReadString('程序参数','settime3','');

autoshut:=myinifile.ReadString('程序参数','autoshut','');
shutswitch:=myinifile.ReadBool('程序参数','shutswitch',false);
//预设声音文件
mediaplayer1.Close ;
mediaplayer1.FileName :=voice[1];
mediaplayer1.Open ;


regRegistry := TRegistry.Create;
try
regRegistry.RootKey := HKEY_LOCAL_MACHINE;
if regregistry.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',true) then
begin
        if regregistry.ValueExists('电脑闹钟') then
        begin
        checkbox1.Checked :=true;
        end
        else checkbox1.Checked :=false;
        regregistry.CloseKey ;
        end;
finally
    regregistry.Free;
    inherited;
    end;

//填充NotifyIconData记录型变量nd0
nd0.cbSize := sizeof(NotifyIconData);
nd0.Wnd := handle;
nd0.uID := 0;
nd0.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
nd0.uCallbackMessage := WM_TRAYNOTIFY;
nd0.hIcon :=application.icon.handle;
StrPLCopy(nd0.szTip,'电脑闹钟3.0-风之铃',63);
//在任务栏状态区添加图标
Shell_NotifyIcon(NIM_ADD,@nd0);

//不在任务栏显示
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);

//生成圆形窗口
region:=CreateEllipticRgn(6,25,image1.Width+3 ,image1.Height+25 );
SetWindowRgn(handle,region,true);

//定位显示位置
autowave.Left :=screen.Width -autowave.Width ;
autowave.Top :=screen.Height -autowave.Height-25 ;


end;


procedure TAutoWave.CheckBox1Click(Sender: TObject);
var
regRegistry: TRegistry;

begin
regRegistry := TRegistry.Create;
try
regRegistry.RootKey := HKEY_LOCAL_MACHINE;
if regregistry.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',true) then
begin
        if checkbox1.Checked then
        regregistry.WriteString('电脑闹钟','"' + ParamStr(0) + '"')
        else if regregistry.DeleteValue('电脑闹钟') then ;
        regregistry.CloseKey ;
        end;
finally
    regregistry.Free;
    inherited;
    end;

end;


procedure TAutoWave.WndProc(var Msg: TMessage);
var
IconID:integer;
pt:TPOINT;
begin
if msg.Msg = WM_TRAYNOTIFY then
begin
{
//在通知消息中,wParam参数为图标的uID,
//lParam参数为鼠标事件的类型。
}
iconID := msg.WParam;
//获取鼠标的在屏幕上的位置
GetCursorPos(pt);
//通知消息的处理的基本框架结构如下:
case msg.lParam of
WM_LBUTTONDOWN:
	begin
	//鼠标左键被按下
	end;
WM_RBUTTONDOWN:
	begin
	//鼠标右键被按下
//        Application.BringToFront ;
        SetForegroundWindow(Application.Handle);
        application.ProcessMessages;
        popupMenu1.Popup(pt.x,pt.Y);
	end;
WM_LBUTTONUP:
	begin
	//释放鼠标左键
	end;
WM_RBUTTONUP:
	begin
	//释放鼠标右键
	end;
WM_MOUSEMOVE:
	begin
	//鼠标在图标上移动
	end;
WM_LBUTTONDBLCLK:
	begin
	//鼠标左键双击
        if (AutoWave.Visible) then autowave.Hide
        else autowave.Show ;
	end;
WM_RBUTTONDBLCLK:
	begin
	//鼠标右键双击
        //Autowave.Hide ;
	end;

end;
end
else//调用父类的WndProc方法处理其它消息
inherited;

end;

//退出
procedure TAutoWave.X1Click(Sender: TObject);
begin
autowave.close;
end;

//关于
procedure TAutoWave.A1Click(Sender: TObject);
begin
Aboutform.showmodal;
end;

//处理最小化消息
procedure Tautowave.Minimize(var mess:TWMNCLBUTTONDOWN);//最小化时隐藏窗体
begin
if mess.hittest=htreduce then //htreduce表示是否按了最小化按钮
begin
Autowave.hide;
end
else
inherited;
end;

//播放测试
procedure TAutoWave.V1Click(Sender: TObject);
begin
mediaplayer1.Open ;
mediaplayer1.Position :=0;
mediaplayer1.Play ;
end;

//停止播放
procedure TAutoWave.S1Click(Sender: TObject);
begin
mediaplayer1.Stop ;
mediaplayer1.Position :=0;
end;

//拖动窗体
procedure TAutoWave.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
ylx:=x;
yly:=y;
end;

procedure TAutoWave.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
If ssleft in shift then
begin //按下鼠标左键拖动form1
autowave.left:=autowave.left+x-ylx;
autowave.top:=autowave.top+y-yly;
end;
end;

procedure Kaishi();
var
shi,fen:string;
begin
  shi:=FormatDateTime('hh',time); //时
  fen:=FormatDateTime('nn',time); //分
//  i:=strtoint(shi);
//  if form1.RadioButton1.checked and (i>12) then //十二小时制
//    if i-12<10 then shi:='0'+inttostr(i-12) else shi:=inttostr(i-12);
  Baoshi(shi);
  if shi='00' then PlaySound('w0',hInstance,SND_RESOURCE);
  PlaySound('wd',hInstance,SND_RESOURCE);
  Baoshi(fen);
  if fen<>'00' then
  PlaySound('wf',hInstance,SND_RESOURCE);
end;

procedure Baoshi(s:string);
begin
  if s[1]<>'0' then begin
    if s[1]>'1' then PlaySound(pchar('w'+copy(s,1,1)),hInstance,SND_RESOURCE);
    PlaySound('w10',hInstance,SND_RESOURCE);
  end;
  if s[2]<>'0' then PlaySound(pchar('w'+copy(s,2,1)),hInstance,SND_RESOURCE);
end;

//报时
procedure TAutoWave.N3Click(Sender: TObject);
begin
kaishi;
end;

//设置闹钟点
procedure TAutoWave.N1Click(Sender: TObject);
begin
form2.ShowModal ;
end;

procedure TAutoWave.FormShow(Sender: TObject);
begin
SetWindowPos(handle, HWND_TopMost, 0,0,0,0,SWP_NoMove or SWP_NoSize or SWP_ShowWindow);

end;

procedure TAutoWave.N2Click(Sender: TObject);
var
fjpg:tjpegimage;
fstream:TResourceStream;
begin
fjpg:=TJpegImage.Create ;
fstream:=tresourcestream.Create(Hinstance,'blue',RT_RCDATA);
fjpg.LoadFromStream(fstream);
image1.Picture.Bitmap.Assign(fjpg);
//image1.Picture.LoadFromFile('蓝色忧郁.jpg');
end;

procedure TAutoWave.N4Click(Sender: TObject);
var
fjpg:tjpegimage;
fstream:TResourceStream;
begin
fjpg:=TJpegImage.Create ;
fstream:=tresourcestream.Create(Hinstance,'older',RT_RCDATA);
fjpg.LoadFromStream(fstream);
image1.Picture.Bitmap.Assign(fjpg);
//image1.Picture.LoadFromFile('怀旧经典.jpg');
end;

procedure TAutoWave.N5Click(Sender: TObject);
var
fjpg:tjpegimage;
fstream:TResourceStream;
begin
fjpg:=TJpegImage.Create ;
fstream:=tresourcestream.Create(Hinstance,'modal',RT_RCDATA);
fjpg.LoadFromStream(fstream);
image1.Picture.Bitmap.Assign(fjpg);

end;

procedure TAutoWave.N6Click(Sender: TObject);
begin
form3.showmodal;
end;

procedure TAutoWave.N7Click(Sender: TObject);
begin
shutswitch:=not(shutswitch);
if shutswitch then d1.Caption :='自动关机(&D) 开'
else d1.Caption :='自动关机(&D) 关';
end;

procedure TAutoWave.N8Click(Sender: TObject);
var
fjpg:tjpegimage;
fstream:TResourceStream;
begin
fjpg:=TJpegImage.Create ;
fstream:=tresourcestream.Create(Hinstance,'romantic',RT_RCDATA);
fjpg.LoadFromStream(fstream);
image1.Picture.Bitmap.Assign(fjpg);
end;

end.

⌨️ 快捷键说明

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