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

📄 umainfrm.pas

📁 定时提醒程序
💻 PAS
字号:
unit uMainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RzButton, ComCtrls, StdCtrls, ExtCtrls, Menus, OleCtrls,
  AgentObjects_TLB, DB, ADODB, DateUtils;

const
  wmMousemsg = wm_User + 226;
  wmShowmeMsg = wm_User + 227;
  iid = 100;

type
  TMainFrm = class(TForm)
    RzBitBtn1: TRzBitBtn;
    Panel1: TPanel;
    Label1: TLabel;
    DateTimePicker1: TDateTimePicker;
    MyAgent: TAgent;
    conn: TADOConnection;
    TrayMenu: TPopupMenu;
    X1: TMenuItem;
    S1: TMenuItem;
    Timer1: TTimer;
    query: TADOQuery;
    Label2: TLabel;
    ComboBox1: TComboBox;
    M1: TMenuItem;
    C1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure X1Click(Sender: TObject);
    procedure MyAgentClick(ASender: TObject; const CharacterID: WideString;
      Button, Shift, x, y: Smallint);
    procedure Timer1Timer(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure C1Click(Sender: TObject);
    procedure M1Click(Sender: TObject);
  private
    Agent: IagentCtlCharacterEx;
    Request:IagentCtlRequest;
    AgentName: string;
    procedure ShowmeMsg(var message: TMessage); message wmShowmeMsg;
    procedure InitComboBox;
    procedure ShowMe(Show: Boolean=True);
    procedure May;
    procedure Calc;
  public
    { Public declarations }
  end;

var
  MainFrm: TMainFrm;

implementation

uses CHADOUtils, CHMessageUtils;

{$R *.dfm}

procedure TMainFrm.FormCreate(Sender: TObject);
begin
  {DB}
  conn.ConnectionString := format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Persist Security Info=False',
    [ExtractFilePath(Application.ExeName)+'data.mdb']);
  conn.Connected := True;
  
  if not OpenSQL(query, 'select * from 参数表 where 参数编号=101') then
    DateTimePicker1.Date := StrToDate(query.FieldByName('参数值').AsString)
  else
    DateTimePicker1.Date := Today;

  {Load Agent}
  if not OpenSQL(query, 'select * from 参数表 where 参数编号=100') then
    AgentName := query.FieldByName('参数值').AsString
  else
    AgentName := 'Merlin';

  Request := MyAgent.Characters.Load(AgentName, ExtractFilePath(application.ExeName)+AgentName+'.acs' );
  Agent := MyAgent.Characters.Character(AgentName);
  Agent.Show(0);

  {Init ComboBox}
  InitComboBox;
  
  PostMessage(Handle, wmShowmeMsg, 0, 0);
end;

procedure TMainFrm.FormDestroy(Sender: TObject);
begin
  MyAgent.Characters.Unload(AgentName);
end;

procedure TMainFrm.ShowMe(Show: Boolean);
begin
  if Show then begin
    ShowWindow(Handle, SW_SHOW); //显示应用程序窗口
    ShowWindow(Application.handle, SW_SHOW); //在任务栏上显示应用程序窗口
    SetWindowLong(Application.Handle, GWL_EXSTYLE,
      not (GetWindowLong(Application.handle, GWL_EXSTYLE)
      or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW));
  end else begin
    ShowWindow(Handle, SW_HIDE); //隐藏主窗体
    ShowWindow(Application.Handle, SW_HIDE); //隐藏应用程序窗口在任务栏上的显示
    SetWindowLong(Application.Handle, GWL_EXSTYLE,
      not (GetWindowLong(Application.handle, GWL_EXSTYLE)
      or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW));
  end;
end;

procedure TMainFrm.ShowmeMsg(var message: TMessage);
begin
  ShowMe(False);
end;

procedure TMainFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caNone; //不对窗体进行任何操作
  RzBitBtn1Click(Sender);
end;

procedure TMainFrm.X1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TMainFrm.MyAgentClick(ASender: TObject; const CharacterID: WideString; Button, Shift, x, y: Smallint);
var
  mousept: TPoint;
begin
  if (Button = 1) or (Button = 4097) then begin
    GetCursorPos(mousept); //获取光标位置
    TrayMenu.popup(mousept.x, mousept.y); //在光标位置弹出选单
  end;
end;

procedure TMainFrm.Timer1Timer(Sender: TObject);
begin
  if Timer1.Tag = 0 then begin
    Calc;
    Timer1.Interval := 5000;
    Timer1.Tag := 1;
  end else if Timer1.Tag = 1 then begin
    May;
    Timer1.Tag := 2;
    Timer1.Enabled := False;
  end
end;

procedure TMainFrm.InitComboBox;
var
  i: Integer;
begin
  ComboBox1.Clear;
  ComboBox1.AddItem('Merlin', TObject(nil));
  ComboBox1.AddItem('Genie', TObject(nil));
  ComboBox1.AddItem('Peedy', TObject(nil));
  ComboBox1.AddItem('Robby', TObject(nil));

  for i:=0 to ComboBox1.Items.Count-1 do begin
    if comparetext(ComboBox1.Items.Strings[i], AgentName) = 0 then begin
      ComboBox1.ItemIndex := i;
      break;
    end;
  end;
end;

procedure TMainFrm.RzBitBtn1Click(Sender: TObject);
begin
  ExecSQL(query, format('update 参数表 set 参数值=''%s'' where 参数编号=100'
      , [ComboBox1.Text]));

  ExecSQL(query, format('update 参数表 set 参数值=''%s'' where 参数编号=101'
      , [DateToStr(DateTimePicker1.Date)]));

  {Auto Run}

  ShowMe(False);
end;

procedure TMainFrm.S1Click(Sender: TObject);
begin
  ShowMe;
end;

procedure TMainFrm.Calc;
begin
  Agent.StopAll('');
  Agent.Play('Pleased');
  Agent.Speak(format('距离你们结婚还有%d天,祝福你们!', [Trunc(DateTimePicker1.Date - Today)]), '');
end;

procedure TMainFrm.May;
var
  i, count: Integer;
begin
  OpenSQL(query, 'select count(*) from 祝福表');
  count := query.Fields[0].AsInteger;
  Randomize;
  i := 0;
  while (i<=0) or (i>count) do
    i := Random(count);
  OpenSQL(query, format(
  'select top 1 * from '+
  ' (select top %d * from 祝福表 order by 祝福编号) as t1 order by 祝福编号 desc', [i]));
  Agent.StopAll('');
  Agent.Play('Congratulate');
  Agent.Speak(query.FieldByName('祝福语').AsString, '');
end;

procedure TMainFrm.C1Click(Sender: TObject);
begin
  Calc;
end;

procedure TMainFrm.M1Click(Sender: TObject);
begin
  May;
end;

end.

⌨️ 快捷键说明

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