📄 calendar_desktop_1.pas
字号:
// **************************************************************
// 在桌面背景图上画日历 LHC 2004.09.06
// **************************************************************
unit calendar_Desktop_1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, jpeg, Grids, CnCalendar, Registry, DateCn,
Buttons, inifiles, ColorGrd;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
ScrollBox1: TScrollBox;
Image2: TImage;
Image1: TImage;
Button1: TButton;
Button2: TButton;
GroupBox1: TGroupBox;
R1: TRadioButton;
R3: TRadioButton;
R4: TRadioButton;
R2: TRadioButton;
GroupBox2: TGroupBox;
Edit3: TEdit;
Label5: TLabel;
Edit4: TEdit;
SpeedButton2: TSpeedButton;
Label6: TLabel;
GroupBox3: TGroupBox;
CheckBox2: TCheckBox;
Label3: TLabel;
Edit1: TEdit;
Label4: TLabel;
Edit2: TEdit;
SpeedButton1: TSpeedButton;
CheckBox4: TCheckBox;
CnCalendar1: TCnCalendar;
Label7: TLabel;
CheckBox1: TCheckBox;
CheckBox3: TCheckBox;
CheckBox5: TCheckBox;
CheckBox6: TCheckBox;
imgfile: TEdit;
Label8: TLabel;
ColorDialog1: TColorDialog;
Panel1: TPanel;
Panel2: TPanel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure CheckBox4Click(Sender: TObject);
procedure Panel1DblClick(Sender: TObject);
private
procedure doit(Sender: TObject);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1 : TForm1;
paths : string;
implementation
uses DS;
{$R *.dfm}
procedure TForm1.doit(Sender: TObject);
var
Reg : Tregistry;
s : string;
s1 : widestring;
T, Tx, Ty : integer;
TS : TBrushStyle;
Fs : TFontStyles;
Tr, TR1 : TRect;
Td : integer;
begin
CnCalendar1.MonthFontcolor := Panel1.Color;
CnCalendar1.Color := Panel2.Color;
CnCalendar1.imgfile := imgfile.Text;
CnCalendar1.FirstRowimg := CheckBox6.Checked;
CnCalendar1.ShowMonth := CheckBox5.Checked;
CnCalendar1.Ctl3D := CheckBox1.Checked;
Reg := Tregistry.Create; {创建Tregistry对象的实例}
Reg.Rootkey := Hkey_Current_User; {设置根键名称}
Reg.OpenKey('Control Panel\Desktop', False); {打开Control Panel\Desktop 路径对应的主键}
s := Reg.ReadString('Wallpaper');
Image1.Height := screen.Height;
Image1.Width := screen.Width;
if ExtractFilepath(s) <> paths then
begin
if s = '' then
Image2.Picture.LoadFromFile(paths + 'space.bmp')
else
Image2.Picture.LoadFromFile(s);
Image2.Picture.SaveToFile(paths + 'old.bmp');
end
else
Image2.Picture.LoadFromFile(paths + 'old.bmp');
Image2.Stretch := False;
Image2.Stretch := true;
Image1.Height := screen.Height;
Image1.Width := screen.Width;
if R1.Checked then
begin
Tx := CnCalendar1.Width + 7;
Ty := CnCalendar1.Height + 36;
end
else if R2.Checked then
begin
Tx := CnCalendar1.Width + 7;
Ty := Image1.Height;
end
else if R3.Checked then
begin
Tx := Image1.Width;
Ty := CnCalendar1.Height + 36;
end
else
begin
Tx := Image1.Width;
Ty := Image1.Height;
end;
Image1.Canvas.CopyRect(Image1.Canvas.ClipRect, Image2.Canvas, Image2.Canvas.ClipRect);
Image2.Visible := False;
CnCalendar1.PaintTo(Image1.Canvas, Tx - CnCalendar1.Width - 4,
Ty - CnCalendar1.Height - 32);
Image1.Canvas.Pen.Color := clred;
if CheckBox3.Checked then
Image1.Canvas.Rectangle(Tx - 242, Ty - 57, Tx - 8, Ty - 37);
Image1.Canvas.Font := Label1.Font;
TS := Image1.Canvas.Brush.style;
Image1.Canvas.Brush.style := bsClear;
s := inttostr(CnCalendar1.Year) + '.'
+ format('%.2d', [CnCalendar1.Month]) + '.'
+ format('%.2d', [CnCalendar1.Day]);
if CheckBox3.Checked then
Image1.Canvas.TextOut(Tx - 222, Ty - 58, s);
T := Tx - 222 + Image1.Canvas.TextWidth(s);
s1 := '日一二三四五六';
s := ' (' + s1[DayOfWeek(now)] + ') ' + CnDateOfDateStr(now);
Image1.Canvas.Font := Label2.Font;
if CheckBox3.Checked then
Image1.Canvas.TextOut(T, Ty - 53, s);
Image1.Canvas.Brush.style := TS;
Td := trunc(strtodate(Edit2.Text) - date);
Tx := Tx - CnCalendar1.Width - 4;
if R1.Checked or R2.Checked then
Tx := Tx + CnCalendar1.Width + 78;
Ty := Ty - CnCalendar1.Height - 32;
Tr.Left := Tx - 76;
Tr.Top := Ty + 28;
Tr.Right := Tr.Left + 74;
Tr.Bottom := Tr.Top + 60;
Image1.Canvas.Pen.Color := clBlack;
if (Td >= 0) and (Edit1.Text <> '') and CheckBox2.Checked then
begin
Image1.Canvas.Rectangle(Tx - 78, Ty, Tx, Ty + CnCalendar1.Height);
Fs := Image1.Canvas.Font.style;
Image1.Canvas.Font.style := [];
s1 := '距';
Image1.Canvas.TextOut(Tx - 78 + (78 - Image1.Canvas.TextWidth(s1)) div 2, Ty + 8, s1);
s := Edit1.Text;
Image1.Canvas.Font.style := Fs;
Image1.Canvas.Brush.style := bsClear;
DrawText(Image1.Canvas.handle, pchar(s), Length(s), Tr, DT_WORDBREAK or DT_Center);
Image1.Canvas.Brush.style := TS;
Image1.Canvas.Font.style := [];
s1 := '还有';
Image1.Canvas.TextOut(Tx - 78 + (78 - Image1.Canvas.TextWidth(s1)) div 2, Ty + 60, s1);
s1 := '天';
Image1.Canvas.TextOut(Tx - 78 + (78 - Image1.Canvas.TextWidth(s1)) div 2, Ty + 128, s1);
s1 := inttostr(Td);
Image1.Canvas.Font.style := Fs;
Image1.Canvas.Font := Label1.Font;
Image1.Canvas.Font.size := 36;
Image1.Canvas.TextOut(Tx - 78 + (78 - Image1.Canvas.TextWidth(s1)) div 2, Ty + 72, s1);
end;
s := inttostr(CnCalendar1.Year) + '-' + inttostr(CnCalendar1.Month) + '-' + inttostr(CnCalendar1.Day);
if (Edit3.Text <> '') and (s = Edit4.Text) then
begin
if R1.Checked or R2.Checked then
Tx := Tx - CnCalendar1.Width - 78;
s := Edit3.Text;
Image1.Canvas.Font.style := [];
Image1.Canvas.Font.size := 9;
Tr.Left := Tx;
Tr.Top := Ty;
Tr.Right := Tr.Left + CnCalendar1.Width;
Tr.Bottom := Tr.Top + 22;
Image1.Canvas.Rectangle(Tr.Left, Tr.Top, Tr.Right, Tr.Bottom);
Tr.Top := Tr.Top + 4;
Tr.Left := Tx + 2;
s := '今日提醒：' + s;
Image1.Canvas.Font.Color := clred;
DrawText(Image1.Canvas.handle, pchar(s), Length(s), Tr, DT_WORDBREAK or DT_Left);
end;
Image1.Canvas.Font.style := Fs;
if (Sender = Button2) or (ParamStr(1) = '/e') then
begin
Image1.Picture.SaveToFile(paths + 'Temp.Bmp');
Reg.WriteString('Wallpaper', paths + 'Temp.Bmp');
Systemparametersinfo(SPI_SETDESKWallpaper, 0, nil, SPIF_SendChange); {向Windows发送消息，通知Windows更换壁纸}
end;
Reg.CloseKey; {将更改内容写入注册表并关闭}
Reg.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
IniFile : TINIFile;
begin
paths := ExtractFilepath(application.ExeName);
CnCalendar1.ShowMonth := true;
CnCalendar1.Color := $00D5EAE6;
IniFile := TINIFile.Create(paths + 'Cal_D.ini');
Edit1.Text := IniFile.ReadString('system', 'ed1', '');
Edit2.Text := IniFile.ReadString('system', 'ed2', '2004-9-7');
Edit3.Text := IniFile.ReadString('system', 'ed3', '');
Edit4.Text := IniFile.ReadString('system', 'ed4', '2004-9-7');
imgfile.Text := IniFile.ReadString('system', 'img', '');
Panel1.Color := stringtocolor(IniFile.ReadString('system', 'co1', 'clRed'));
Panel2.Color := stringtocolor(IniFile.ReadString('system', 'co2', 'clWhite'));
CheckBox1.Checked := IniFile.readBool('system', 'ch1', False);
CheckBox2.Checked := IniFile.readBool('system', 'ch2', False);
CheckBox3.Checked := IniFile.readBool('system', 'ch3', true);
CheckBox4.Checked := IniFile.readBool('system', 'ch4', true);
CheckBox5.Checked := IniFile.readBool('system', 'ch5', true);
CheckBox6.Checked := IniFile.readBool('system', 'ch6', true);
R1.Checked := IniFile.readBool('system', 'RB1', False);
R2.Checked := IniFile.readBool('system', 'RB2', False);
R3.Checked := IniFile.readBool('system', 'RB3', False);
R4.Checked := IniFile.readBool('system', 'RB4', true);
IniFile.Free;
if ParamStr(1) = '/e' then
Left := 2000;
Image2.Height := screen.Height;
Image2.Width := screen.Width;
Image2.Picture.LoadFromFile(paths + 'old.bmp');
doit(Sender);
if ParamStr(1) = '/e' then
application.Terminate;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
doit(Sender);
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if form2.ShowModal = 4 then
Edit2.Text := form2.Label1.Caption;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
if form2.ShowModal = 4 then
Edit4.Text := form2.Label1.Caption;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
// 退出时保存设置
var
IniFile : TINIFile;
begin
IniFile := TINIFile.Create(paths + 'Cal_D.ini');
IniFile.WriteString('system', 'ed1', Edit1.Text);
IniFile.WriteString('system', 'ed2', Edit2.Text);
IniFile.WriteString('system', 'ed3', Edit3.Text);
IniFile.WriteString('system', 'ed4', Edit4.Text);
IniFile.WriteString('system', 'img', imgfile.Text);
IniFile.WriteString('system', 'co1', colortostring(Panel1.Color));
IniFile.WriteString('system', 'co2', colortostring(Panel2.Color));
IniFile.WriteBool('system', 'ch1', CheckBox1.Checked);
IniFile.WriteBool('system', 'ch2', CheckBox2.Checked);
IniFile.WriteBool('system', 'ch3', CheckBox3.Checked);
IniFile.WriteBool('system', 'ch4', CheckBox4.Checked);
IniFile.WriteBool('system', 'ch5', CheckBox5.Checked);
IniFile.WriteBool('system', 'ch6', CheckBox6.Checked);
IniFile.WriteBool('system', 'RB1', R1.Checked);
IniFile.WriteBool('system', 'RB2', R2.Checked);
IniFile.WriteBool('system', 'RB3', R3.Checked);
IniFile.WriteBool('system', 'RB4', R4.Checked);
IniFile.Free;
end;
procedure TForm1.CheckBox4Click(Sender: TObject);
// 添加为Win启动时自动运行的程序
var
Reg : Tregistry;
begin
Reg := Tregistry.Create; {创建Tregistry对象的实例}
Reg.Rootkey := HKEY_LOCAL_MACHINE; {设置根键名称}
Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', False);
if CheckBox4.Checked then
Reg.WriteString('Cal_desktop', ParamStr(0) + ' /e')
else
Reg.DeleteValue('Cal_desktop');
Reg.CloseKey; {将更改内容写入注册表并关闭}
Reg.Free;
end;
procedure TForm1.Panel1DblClick(Sender: TObject);
begin
if ColorDialog1.Execute then
(Sender as TPanel).Color := ColorDialog1.Color;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -