clock.pas

小闹钟程序

unit Clock;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus,ShellApi, DBTables, DB, StdCtrls,Registry,MMSystem,
  DateUtils;
const
  MY_MESSAGE = WM_USER + 100;

type
  TMainWnd = class(TForm)
    Image1: TImage;
    PopupMenu1: TPopupMenu;
    mnu_Icon: TMenuItem;
    N1: TMenuItem;
    mnu_SysOption: TMenuItem;
    mnu_AlarmOption: TMenuItem;
    mnu_ChangeTime: TMenuItem;
    N2: TMenuItem;
    mnu_Exit: TMenuItem;
    Label1: TLabel;
    MainTimer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure WMEraseBkgnd(var m:TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMWinPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
    procedure mnu_IconClick(Sender: TObject);
    procedure IconOnClick(var message:TMessage); message MY_MESSAGE;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mnu_ExitClick(Sender: TObject);
    procedure Label1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure mnu_SysOptionClick(Sender: TObject);
    procedure mnu_AlarmOptionClick(Sender: TObject);
    procedure MainTimerTimer(Sender: TObject);
    procedure mnu_ChangeTimeClick(Sender: TObject);
protected
    procedure CreateParams(var Params: TCreateParams); Override;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainWnd: TMainWnd;
var
  NT:TNOTIFYICONDATA;

implementation

uses Option,Control,AlarmOption, Adjust;

{$R *.dfm}

procedure TMainWnd.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.WndParent := 0; //把此窗口设为Desktop型的。
end;

procedure TMainWnd.FormCreate(Sender: TObject);
begin
    Brush.Style := bsClear;
    BorderStyle := bsNone;
    SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

procedure TMainWnd.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    ReleaseCapture;
    SendMessage(Handle, WM_SYSCOMMAND, SC_MOVE or HTCLIENT, 0);
    self.hide;
    self.Show;
  end;
end;

procedure TMainWnd.WMEraseBkgnd(var m:TWMERASEBKGND);
begin
    m.Result := LRESULT(false);
end;

procedure TMainWnd.WMWinPosChanging(var Message: TWMWindowPosChanging);
begin
    Invalidate;
end;

procedure TMainWnd.mnu_IconClick(Sender: TObject);
begin
    if Pos('缩为小图标',self.mnu_Icon.Caption)>0 then
    begin
      with NT do begin
        cbSize:=Sizeof(NT); // nid变量的字节数
        Wnd:=Handle; // 主窗口句柄
        UID:=0; // 内部标识，可设为任意数
        uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
        uCallBackMessage:=MY_MESSAGE;
        hIcon:=Icon.Handle; // 要加入的图标句柄，可任意指定
        szTip:='闹铃'#0; // 提示字符串
        hIcon := Application.Icon.Handle;
      end;
      Application.Minimize;
      Shell_NotifyIcon(NIM_ADD,@NT);
      self.mnu_Icon.Caption:='正常显示';
    end
    else
    begin
      Shell_NotifyIcon(NIM_DELETE,@NT);
      showwindow(application.Handle,sw_show);
      Application.Restore;
      self.mnu_Icon.Caption:='缩为小图标';
    end;
end;

procedure TMainWnd.IconOnClick( var message: Tmessage);
var p : TPoint;
begin
 if (message.lParam = WM_LBUTTONDOWN) then
 ;
 if (message.lParam = WM_RBUTTONDOWN) then
 begin
     GetCursorPos(p);
     self.PopupMenu1.Popup( p.x ,p.y );
 end;
end;

procedure TMainWnd.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    Shell_NotifyIcon(NIM_DELETE,@NT);
end;

procedure TMainWnd.mnu_ExitClick(Sender: TObject);
begin
    Application.Terminate; 
end;

procedure TMainWnd.Label1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    ReleaseCapture;
    SendMessage(Handle, WM_SYSCOMMAND, SC_MOVE or HTCLIENT, 0);
    self.hide;
    self.Show;
  end;
end;

procedure TMainWnd.mnu_SysOptionClick(Sender: TObject);
    procedure WriteRegAutoRun(FileName:string);
    var
      Regf:TRegistry;
    begin
      Regf:=TRegistry.Create;
      Regf.RootKey:=HKEY_LOCAL_MACHINE;

      if Length(FileName)>0 then
      begin
          RegF.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',false);
          RegF.WriteString('MyClock',FileName);
      end
      else
      begin
          RegF.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',false);
          RegF.DeleteValue('MyClock');
      end;

      RegF.CloseKey;
      RegF.Free;
    end;
var
    dlg:Tfrm_Option;
    mem:TStream;
    bmp:TBitmap;
begin
    dlg:=Tfrm_Option.Create(self);
    if dlg.ShowModal=mrOK then
    begin
        with dlg do
        begin
            with ControlModule.OptionTable do
            begin
                Edit;
                FieldByName('背景来源').AsString:=cmb_Back.Text;
                FieldByName('自动运行').AsBoolean:=chk_AutoRun.Checked;
                FieldByName('总在最前面').AsBoolean:=chk_TopMost.Checked;
                FieldByName('字体名称').AsString:=lst_Font.Items[lst_Font.ItemIndex];
                Post;
            end;

            with ControlModule.BackTable do
            begin
                First;
                while not eof do
                begin
                    if FieldByName('Name').AsString=cmb_Back.Text then
                        break;
                    Next;
                end;
                bmp:=TBitmap.Create;
                mem:=CreateBlobStream(FieldByName('Data'),bmRead);
                mem.Position:=0;
                bmp.LoadFromStream(mem);
                self.Image1.Picture.Assign(bmp);
                bmp.Free;
                mem.Free;
            end;

            self.Label1.Font.Name:=lst_Font.Items[lst_Font.ItemIndex];
            if cmb_Back.Text='大象' then
            begin
                self.Label1.Left:=107;
                self.Label1.Top:=5;
            end
            else
            begin
                self.Label1.Left:=139;  
                self.Label1.Top:=5;
            end;

            if chk_AutoRun.Checked then
            begin
                WriteRegAutoRun(Application.ExeName);
            end
            else
            begin
                WriteRegAutoRun('');
            end;

            if chk_TopMost.Checked then
            begin
                SetWindowPos(self.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
            end
            else
            begin
                SetWindowPos(self.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
            end;
        end;
        self.Width:=Image1.Width;
        self.Height:=Image1.Height;
        self.Hide;
        self.Show;
    end;
end;

procedure TMainWnd.mnu_AlarmOptionClick(Sender: TObject);
begin
    if frmAlarmOption.ShowModal=mrOK then
    begin
        self.Hide;
        self.Show;
    end;
end;

procedure TMainWnd.MainTimerTimer(Sender: TObject);
    //这里是从系统中取得一个临时文件
    function gettemporyfilename:string;
    const  max_path=144;
    var
        lppathbuffer:pchar;
        lpbuffer:pchar;
    begin
        getmem(lpbuffer,max_path);
        getmem(lppathbuffer,max_path);
        gettemppath(max_path,lppathbuffer);
        gettempfilename(lppathbuffer,'tem',0,lpbuffer);
        freemem(lppathbuffer,max_path);
        gettempfilename(PChar(ExtractFilePath(Paramstr(0))),'tem',0,lpbuffer);
        result:=strpas(lpbuffer);
        freemem(lpbuffer,max_path);
    end;

    procedure PlaySoundFromDB(str1:String);
    var
        filename:string;
        filestream:tfilestream;//a temp file
        blobstream:tstream;//the WAVE blob
    begin
        with ControlModule.SoundTable do
        begin
            First;
            while not eof do
            begin
                if FieldByName('Name').AsString=str1 then
                    break;
                Next;
            end;
            //为字段创建BLOB数据流
            blobstream:=CreateBlobStream(FieldByName('Data'),bmRead);
            if blobstream.size=0 then
            begin
                blobstream.free;
                exit;
            end;
            blobstream.Position:=0;
            //创建前删除同名的临时文件
            if filename<>'' then
                deletefile(filename);
                //设置临时文件名
            filename:=gettemporyfilename;
            //为临时文件创建文件流
            filestream:=tfilestream.create(filename,fmcreate or fmopenwrite);
            //拷贝blob到临时文件中
            filestream.copyfrom(blobstream,blobstream.size);
            //释放流
            filestream.free;
            blobstream.free;
            //播放WAVE文件
            PlaySound(PChar(filename),0,SND_FILENAME + SND_ASYNC);
            //删除临时文件
            if filename<>'' then
                deletefile(filename);
        end;
    end;

    procedure ExcuteAction(TempControlSystem:TControlSystem);
    var
        str1:String;
    begin
        case TempControlSystem.Action of
        0:
            begin
                str1:=TempControlSystem.Sound;
                if Copy(str1,1,1)='1' then
                begin
                    str1:=Copy(str1,2,Length(str1)-1);
                    PlaySound(PChar(str1),0,SND_FILENAME+SND_ASYNC);
                end
                else
                begin
                    str1:=Copy(str1,2,Length(str1)-1);
                    PlaySoundFromDB(str1);
                end;
            end;
        1:
            begin
                ShowMessage(TempControlSystem.Memo);
            end;
        2:
            begin
                WinExec(PChar(TempControlSystem.ExeProgram),SW_SHOW);
            end;
        3:
            begin
                ExitWindowsEx(EWX_REBOOT,0);
            end;
        4:
            begin
                ExitWindowsEx(EWX_SHUTDOWN,0);
            end;
        end;
    end;


var
    i:Integer;
    TempControlSystem:TControlSystem;
    time1,time2,time3:TDateTime;
    AYear1,AYear2,AMonth1,AMonth2,ADay1,ADay2,AWeekOfYear,ADayOfWeek: Word;

begin
    self.Label1.Caption:=FormatDateTime('hh:mm:ss',Now);
    for i:=0 to ControlModule.GetSystemCount-1 do
    begin
        TempControlSystem:=ControlModule.GetSystem(i);
        case TempControlSystem.Mode of
        1:
            begin
                time1:=Now;
                time2:=Trunc(TempControlSystem.Date)+TempControlSystem.Time-Trunc(TempControlSystem.Time);
                time3:=EncodeTime(0,0,0,250);
                if (time2>time1-time3) and (time2<time1+time3) then
                begin
                    ExcuteAction(TempControlSystem);
                end;
            end;
        2:
            begin
                time1:=Now;
                time2:=Trunc(time1)+TempControlSystem.Time-Trunc(TempControlSystem.Time);
                time3:=EncodeTime(0,0,0,250);
                if (time2>time1-time3) and (time2<time1+time3) then
                begin
                    ExcuteAction(TempControlSystem);
                end;
            end;
        3:
            begin
                time1:=Now;
                DecodeDateWeek(time1,AYear1,AWeekOfYear,ADayOfWeek);
                if ADayOfWeek<>TempControlSystem.Week then exit; 
                time2:=Trunc(time1)+TempControlSystem.Time-Trunc(TempControlSystem.Time);
                time3:=EncodeTime(0,0,0,250);
                if (time2>time1-time3) and (time2<time1+time3) then
                begin
                    ExcuteAction(TempControlSystem);
                end;
            end;
        4:
            begin
                time1:=Now;
                DecodeDate(time1,AYear1,AMonth1,ADay1);
                DecodeDate(TempControlSystem.Date,AYear2,AMonth2,ADay2);
                if AMonth1<>AMonth2 then exit;
                if ADay1<>ADay2 then exit;
                time2:=Trunc(time1)+TempControlSystem.Time-Trunc(TempControlSystem.Time);
                time3:=EncodeTime(0,0,0,250);
                if (time2>time1-time3) and (time2<time1+time3) then
                begin
                    ExcuteAction(TempControlSystem);
                end;
            end;
        5:
            begin
                time1:=Now;
                DecodeDate(time1,AYear1,AMonth1,ADay1);
                DecodeDate(TempControlSystem.Date,AYear2,AMonth2,ADay2);
                if AYear1<>AYear2 then exit;
                if AMonth1<>AMonth2 then exit;
                if ADay1<>ADay2 then exit;
                time2:=Trunc(time1)+TempControlSystem.Time-Trunc(TempControlSystem.Time);
                time3:=EncodeTime(0,0,0,250);
                if (time2>time1-time3) and (time2<time1+time3) then
                begin
                    ExcuteAction(TempControlSystem);
                end;
            end;
        end;
    end;
end;

procedure TMainWnd.mnu_ChangeTimeClick(Sender: TObject);
begin
    if frmAdjust.ShowModal=mrOK then
    begin
        self.Hide;
        self.Show;
    end;
end;

end.