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

📄 unit1.pas

📁 生日闹钟源文件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit Unit1;

interface

uses
ShellAPI, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, ExtCtrls, jpeg, Menus, ImgList, Grids, DBGrids, DB,
  DBTables, StdCtrls, registry, ComCtrls, QuickRpt, QRCtrls;

const MY_MESSAGE = WM_USER + 100;
type
  TForm1 = class(TForm)
    Panel2: TPanel;
    Image3: TImage;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton13: TSpeedButton;
    SpeedButton14: TSpeedButton;
    SpeedButton15: TSpeedButton;
    SpeedButton16: TSpeedButton;
    SpeedButton17: TSpeedButton;
    SpeedButton18: TSpeedButton;
    SpeedButton19: TSpeedButton;
    SpeedButton20: TSpeedButton;
    SpeedButton21: TSpeedButton;
    SpeedButton1: TSpeedButton;
    SpeedButton22: TSpeedButton;
    SpeedButton24: TSpeedButton;
    SpeedButton23: TSpeedButton;
    SpeedButton25: TSpeedButton;
    SpeedButton26: TSpeedButton;
    SpeedButton28: TSpeedButton;
    SpeedButton27: TSpeedButton;
    SpeedButton29: TSpeedButton;
    SpeedButton30: TSpeedButton;
    SpeedButton31: TSpeedButton;
    SpeedButton32: TSpeedButton;
    Timer1: TTimer;
    Timer2: TTimer;
    Timer3: TTimer;
    Image5: TImage;
    Table1: TTable;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Timer4: TTimer;
    Panel1: TPanel;
    Image2: TImage;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    Timer5: TTimer;
    RichEdit1: TRichEdit;
    Timer6: TTimer;
    Image7: TImage;
    Image8: TImage;
    Image9: TImage;
    Image10: TImage;
    Image11: TImage;
    Image12: TImage;
    Image13: TImage;
    Image14: TImage;
    Image15: TImage;
    Image16: TImage;
    Timer7: TTimer;
    Panel5: TPanel;
    Image17: TImage;
    Panel7: TPanel;
    Image19: TImage;
    Panel8: TPanel;
    Image20: TImage;
    Panel6: TPanel;
    Image18: TImage;
    Timer8: TTimer;
    Panel9: TPanel;
    Image21: TImage;
    Panel10: TPanel;
    Image22: TImage;
    Image23: TImage;
    Panel11: TPanel;
    Image24: TImage;
    Panel12: TPanel;
    Image25: TImage;
    Panel13: TPanel;
    Image26: TImage;
    Timer9: TTimer;
    Panel14: TPanel;
    Timer10: TTimer;
    Panel4: TPanel;
    Image4: TImage;
    SpeedButton45: TSpeedButton;
    SpeedButton46: TSpeedButton;
    SpeedButton47: TSpeedButton;
    SpeedButton48: TSpeedButton;
    SpeedButton49: TSpeedButton;
    SpeedButton50: TSpeedButton;
    SpeedButton51: TSpeedButton;
    SpeedButton52: TSpeedButton;
    SpeedButton53: TSpeedButton;
    SpeedButton54: TSpeedButton;
    SpeedButton55: TSpeedButton;
    SpeedButton56: TSpeedButton;
    Panel15: TPanel;
    Panel3: TPanel;
    Image6: TImage;
    SpeedButton36: TSpeedButton;
    SpeedButton33: TSpeedButton;
    SpeedButton37: TSpeedButton;
    SpeedButton34: TSpeedButton;
    SpeedButton35: TSpeedButton;
    procedure FormPaint(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton8Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton33Click(Sender: TObject);
    procedure SpeedButton36Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure Timer4Timer(Sender: TObject);
    procedure SpeedButton37Click(Sender: TObject);
    procedure Timer5Timer(Sender: TObject);
    procedure Timer6Timer(Sender: TObject);
    procedure Timer7Timer(Sender: TObject);
    procedure Timer8Timer(Sender: TObject);
    procedure Timer9Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Panel14Click(Sender: TObject);
    procedure Panel4Click(Sender: TObject);
    procedure Panel15Click(Sender: TObject);
    procedure Timer10Timer(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton34Click(Sender: TObject);
    procedure SpeedButton35Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    
  private
     procedure hotkey(var msg:Tmessage);
     message wm_hotkey;
    procedure OnIconNotify(var Message: TMessage);
    message MY_MESSAGE; { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Busy: Boolean ;
  ro,many,uo,goo,too,i,n,m,doo:integer;
  bitmap:tbitmap;
  now1:string;
implementation

uses  Unit4, Unit5, Unit3;

{$R *.dfm}
procedure tform1.hotkey(var msg:tmessage);
var
 destdc,sourcedc:hdc;
 mousepoint:tpoint;
 my:hwnd;
 bhandle:hbitmap;
begin
sourceDC:=createDC('display','','',nil);
destdc:=createcompatibleDC(sourceDC);
bhandle:=createcompatiblebitmap(sourcedc,screen.Width,screen.Height-25);
selectobject(destDc,Bhandle);
bitblt(destDc,0,0,screen.Width,screen.Height-25,sourceDC,0,0,srccopy);
bitmap:=Tbitmap.Create;
bitmap.Height:=screen.Height-25;
bitmap.Width:=screen.Width;
bitmap.Handle:=Bhandle;
bitmap.SaveToFile (now1+'delphi.bmp');
deletedc(destdc);
releasedc(bhandle,sourcedc);
form5.Show;
end;




function datepick(var n,m:string):integer;
var
 a,b,c,d:string;
 g,h,o,p,t,q:integer;
begin
 a:=copy(n,6,2);
 b:=copy(n,9,2);
 c:=copy(m,6,2);
 d:=copy(m,9,2);
 g:=strtoint(a);
 h:=strtoint(b);
 o:=strtoint(c);
 p:=strtoint(d);
 t:=5;
 q:=h-p;
 if g=o then
   begin
    if q>=-3 then
     begin
      if q<=1 then
       result:=q
      end;
   end  
   else
   result:=t;
end;

procedure Get;
var
 a,b,c,d,e,dd,vb:string;
 f,g,h,k:integer;
 bo:boolean;
begin

 if fileexists('c:\windows\system32\delphi01.dbf')=true then
    begin
      form1.table1.TableName:='c:\windows\system32\delphi01.dbf';
      form1.datasource1.DataSet.Active:=true;
      form1.table1.First;
      form1.table1.Edit;
    end
    else
      begin
        with form1.table1 do
          begin
            Active:=false;
            tablename:='c:\windows\system32\delphi01.dbf';
            tabletype:=ttdbase;
            CreateTable;
          end;
        form1.datasource1.DataSet.Active:=true;
        form1.table1.First;
        form1.table1.Edit;

     end;
 repeat
   a:=datetostr(now);
   b:=   form1.table1.Fields.Fields[4].AsString;
   if b=c then
      begin
        if    form1.table1.Fields.Fields[0].AsString=d then
          begin
            bo:=true;
            b:='9999999999';
          end;
      end;
   c:=b;
   d:=   form1.table1.Fields.Fields[0].AsString;
   e:=   form1.table1.Fields.Fields[1].AsString;

   if    form1.table1.Fields.Fields[4].AsString='' then
    b:='9999999999';
    k:=datepick(a,b);
   
    if k=-3 then
     begin
      showmessage('大后天是'+d+e+'的生日!');
      uo:=1;
     end;
    if k=-2 then
     begin
       showmessage('后天是'+d+e+'的生日!');
      uo:=1;
     end;
    if k=-1 then
      begin
      showmessage('明天是'+d+e+'的生日!');
       uo:=1;
      end;
    if k=0 then
      begin
       showmessage('今天是'+d+e+'的生日!');
       uo:=1;
      end;
    
        form1.table1.Next;
 until bo=true;
      form1.datasource1.DataSet.Active:=false;
      form1.table1.Active:=false;


end;
procedure delay(i:integer);
var
 h,n,p:integer;
begin
 for h:=0 to i do
  begin
   for n:=0 to i do
    inc(p);
  end;
end;
procedure TForm1.OnIconNotify(var Message: TMessage);
var
 a,b:integer;
nid: TNotifyIconData;
begin
 a:=screen.Height-25;
 b:=screen.Width-10;
if not Busy then
 Busy := true;
  if Message.LParam=WM_LBUTTONDOWN then
  begin
  form1.Show;
  nid.cbSize := sizeof(nid); // nid变量的字节数
  nid.cbSize := sizeof(nid); // nid变量的字节数
  nid.uID := 0; //内部标识,与加入小图标时的数一致
  nid.Wnd := Handle; //主窗口句柄
  Shell_NotifyIcon(NIM_DELETE, @nid); //去掉小图标
  Shell_NotifyIcon(NIM_DELETE, @nid); //去掉小图标
  busy:=false;
  end;
  
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
 Hide;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
nid: TNotifyIconData;
begin
 nid.cbSize := sizeof(nid); // nid变量的字节数
 nid.cbSize := sizeof(nid); // nid变量的字节数
 nid.uID := 0; //内部标识,与加入小图标时的数一致
 nid.Wnd := Handle; //主窗口句柄
 Shell_NotifyIcon(NIM_DELETE, @nid); //去掉小图标
 Shell_NotifyIcon(NIM_DELETE, @nid); //去掉小图标
end;

procedure TForm1.SpeedButton8Click(Sender: TObject);
var
nid: TNotifyIconData;
tt:integer;
begin
 tt:=GlobalAddAtom('sf');
 registerHotKey(form1.Handle,tt,MOD_shift,vk_Space );
nid.cbSize := sizeof(nid); // nid变量的字节数
nid.Wnd := Handle; // 主窗口句柄
nid.uID := 0; // 内部标识,可设为任意数
nid.hIcon := Application.Icon.Handle; // 要加入的图标句柄,可任意指?
nid.hIcon := Application.Icon.Handle; // 要加入的图标句柄,可任意指?

nid.szTip := 'This is a test application'; // 提示字符串
nid.uCallbackMessage := MY_MESSAGE; // 回调函数消息
nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // 指明哪些字段有?

if not Shell_NotifyIcon(NIM_ADD, @nid) then begin
ShowMessage('Failed!');
Application.Terminate;
end;


 form1.Hide;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 a,b,c,d,e,dd,vb:string;
 f,g,h,k:integer;
 bo:boolean;
 T:TSHFileOpStruct;
 registry:tregistry;
begin
 now1:=ExtractFilepath(Application.ExeName);

⌨️ 快捷键说明

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