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

📄 calend.~pas

📁 该程序是一个日历小软件
💻 ~PAS
字号:
unit calend;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, Grids, Calendar, ver, ComCtrls, StdCtrls, Spin, Buttons,
  ExtCtrls, unit1;

type
  Tcalen = class(TForm)
    Calendar1: TCalendar;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    Version1: TMenuItem;
    Exit1: TMenuItem;
    sb: TStatusBar;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    SpinButton2: TSpinButton;
    SpinButton3: TSpinButton;
    Label1: TLabel;
    BitBtn1: TBitBtn;
    Edit1: TEdit;
    SpinButton1: TSpinButton;
    Timer1: TTimer;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Q1: TMenuItem;
    zht: TMenuItem;
    Other1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    PhotoShopCS1: TMenuItem;
    N20051: TMenuItem;
    N4: TMenuItem;
    KV20051: TMenuItem;
    procedure Version1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PopupMenu1Change(Sender: TObject; Source: TMenuItem;
      Rebuild: Boolean);
    procedure FormDblClick(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure Calendar1Change(Sender: TObject);
    procedure SpinButton1DownClick(Sender: TObject);
    procedure SpinButton1UpClick(Sender: TObject);
    procedure SpinButton2DownClick(Sender: TObject);
    procedure SpinButton2UpClick(Sender: TObject);
    procedure SpinButton3UpClick(Sender: TObject);
    procedure SpinButton3DownClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure E1Click(Sender: TObject);
    procedure zhtClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure PhotoShopCS1Click(Sender: TObject);
    procedure N20051Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure KV20051Click(Sender: TObject);
  private
    { Private declarations }
    procedure moveform(var msg:twmnchittest);
    message wm_nchittest;
  public
    { Public declarations }
  end;

var
  calen: Tcalen;

implementation

{$R *.dfm}

procedure tcalen.moveform(var msg:twmnchittest);
begin
  inherited;
  if (htclient=msg.Result) then
    msg.Result:=htcaption;
end;

procedure Tcalen.Version1Click(Sender: TObject);
begin
  version.ShowModal;
end;

procedure Tcalen.FormCreate(Sender: TObject);
begin
  calen.sb.Panels[0].Text:=formatdatetime('" Welcome to My calendar!  访问时间:"yyyy-mm-dd hh:mm',now);
  calen.Edit1.Text:=formatdatetime('yyyy',now);
  calen.Edit2.Text:=formatdatetime('mm',now);
  calen.Edit3.Text:=formatdatetime('dd',now);
//application.CreateHandle;
//showwindow(application.Handle,sw_hide);
//application.ShowMainForm:=false;
end;

procedure Tcalen.PopupMenu1Change(Sender: TObject; Source: TMenuItem;
  Rebuild: Boolean);
begin
  version.Show;
end;

procedure Tcalen.FormDblClick(Sender: TObject);
begin
  version.Show;
end;

procedure Tcalen.Edit1Change(Sender: TObject);
begin
//  calen.Calendar1.Year:=strtoint(calen.Edit1.Text);
  if (strtoint(edit1.Text)>3000)then
  begin
    calen.Edit1.Text:='3000';
    showmessage('仅查询1-3000年');
    calen.edit1.Text:=formatdatetime('yyyy',now);
  end;
end;

procedure Tcalen.Edit2Change(Sender: TObject);
begin
//  calen.Calendar1.Month:=strtoint(calen.Edit2.Text);
  if (strtoint(edit2.Text)>12) or (strtoint(edit2.Text)<1) then
  begin
    showmessage('输入有误,请重新输入');
    calen.edit2.Text:=formatdatetime('mm',now);
  end;
end;

procedure Tcalen.Edit3Change(Sender: TObject);
begin
  calen.Calendar1.Day:=strtoint(calen.Edit3.Text);
  if (strtoint(edit3.Text)>31) or (strtoint(edit3.Text)<1) then
  begin
    showmessage('输入有误,请重新输入!');
    calen.edit3.Text:=formatdatetime('dd',now);
  end;
end;

procedure Tcalen.Calendar1Change(Sender: TObject);
begin
  calen.Edit1.Text:=inttostr(calen.Calendar1.Year);
  calen.Edit2.Text:=inttostr(calen.Calendar1.Month);
  calen.Edit3.Text:=inttostr(calen.Calendar1.Day);
end;

procedure Tcalen.SpinButton1DownClick(Sender: TObject);
begin
//  if (strtoint(calen.Edit1.Text)>1) then  在Tcalen.Calendar1Change(Sender: TObject)中已经实现这一步
//    calen.Edit1.Text:=inttostr(strtoint(calen.Edit1.Text));
  calen.Calendar1.PrevYear;
  edit1.SetFocus;
end;

procedure Tcalen.SpinButton1UpClick(Sender: TObject);
begin
  calen.Calendar1.NextYear;
  edit1.SetFocus;
end;

procedure Tcalen.SpinButton2DownClick(Sender: TObject);
begin
  calen.Calendar1.PrevMonth;
end;

procedure Tcalen.SpinButton2UpClick(Sender: TObject);
begin
  calen.Calendar1.NextMonth;
end;

procedure Tcalen.SpinButton3UpClick(Sender: TObject);
begin
  if strtoint(calen.Edit3.Text)<31 then
  calen.Edit3.Text:=inttostr(strtoint(calen.Edit3.Text)+1);
end;

procedure Tcalen.SpinButton3DownClick(Sender: TObject);
begin
  if strtoint(calen.Edit3.Text)>1 then
  calen.Edit3.Text:=inttostr(strtoint(calen.Edit3.Text)-1);
end;

procedure Tcalen.BitBtn1Click(Sender: TObject);
begin
  calen.Calendar1.Enabled:=true;
  calen.Edit1.Enabled:=true;
  calen.Edit2.Enabled:=true;
  calen.Edit3.Enabled:=true;
  calen.SpinButton1.Enabled:=true;
  calen.SpinButton2.Enabled:=true;
  calen.SpinButton3.Enabled:=true;
  calen.Timer1.Enabled:=true;
  calen.Calendar1.Year:=strtoint(calen.Edit1.Text);
  calen.Calendar1.Month:=strtoint(calen.Edit2.Text);
  calen.Calendar1.Day:=strtoint(calen.Edit3.Text);
  calen.sb.Panels[1].Text:='你查询的时间:'+'公元'+calen.Edit1.Text+'年'+calen.Edit2.Text+'月'+calen.Edit3.Text+'日';
end;

procedure Tcalen.Timer1Timer(Sender: TObject);
begin
  calen.Label1.Caption:=timetostr(time);
end;

procedure Tcalen.E1Click(Sender: TObject);
begin
  close;
end;

procedure Tcalen.zhtClick(Sender: TObject);
begin
  if sb.Visible then
    begin
      sb.Visible:=false;
      zht.Checked:=false;
    end
  else
    begin
      sb.Visible:=true;
      zht.Checked:=true;
    end;
end;

procedure Tcalen.FormShow(Sender: TObject);
begin
  zht.Checked:=true;
end;

procedure Tcalen.FormActivate(Sender: TObject);
begin
  form1.ShowModal;
end;

procedure Tcalen.N2Click(Sender: TObject);
begin
  winexec('D:\制作\calendar\llk.exe',sw_normal);
end;

procedure Tcalen.N3Click(Sender: TObject);
var
  temp:integer;
begin
 if (calen.FormStyle<>fsstayontop) then
   begin
     n3.Checked:=true;
     calen.FormStyle:=fsstayontop;
     systemparametersinfo(spi_screensaverrunning,1,@temp,0);
   end
  else
    if (calen.FormStyle=fsstayontop) then
      begin
      n3.Checked:=false;
      calen.FormStyle:=fsnormal;
      systemparametersinfo(spi_screensaverrunning,1,@temp,0);
      end;
end;

procedure Tcalen.Exit1Click(Sender: TObject);
begin
  close;
end;

procedure Tcalen.PhotoShopCS1Click(Sender: TObject);
begin
  winexec('C:\Program Files\Adobe\Photoshop CS\Photoshop.exe',sw_normal);
end;

procedure Tcalen.N20051Click(Sender: TObject);
begin
  winexec('C:\Program Files\金山词霸 2005\xdict.exe',sw_normal);
end;

procedure Tcalen.N4Click(Sender: TObject);
begin
  winexec('C:\Program Files\Wom\womcc.exe',sw_normal);
end;

procedure Tcalen.KV20051Click(Sender: TObject);
begin
  winexec('C:\Program Files\KV2005\KvXP.kxp',sw_normal);
end;

end.

⌨️ 快捷键说明

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