倒计时
pas代码
unit main;
interface
uses
Windows, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls,
StdCtrls, ExtCtrls, IniFiles;
type
TForm1 = class(TForm)
stat1: TStatusBar;
tmr1: TTimer;
dtp1: TDateTimePicker;
lbl1: TLabel;
lbl2: TLabel;
lbl3: TLabel;
dlgColor1: TColorDialog;
btn1: TButton;
btn2: TButton;
chk1: TCheckBox;
procedure tmr1Timer(Sender: TObject);
procedure dtp1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure chk1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ToDate: TDateTime;
FontColor, BackColor: Integer;
Msg: string;
implementation
{$R *.dfm}
procedure TForm1.tmr1Timer(Sender: TObject);
var
dif: Double;
days, hours, mins, secs: Integer;
ini: TIniFile;
begin
stat1.Panels[0].Text := '今天是:' + DateToStr(date());
stat1.Panels[1].Text := '现在时刻:' + Copy(DateTimeToStr(now()), 11, 9);
dif := ToDate - Now;
days := Round(Int(dif));
dif := dif - days;
secs := round(dif * 24 * 60 * 60);
hours := secs div 3600;
mins := (secs - hours * 3600) div 60;
lbl1.Caption := Msg;
lbl3.Caption := Format(' %d天,%d小时,%d分钟', [days, hours, mins]);
end;
procedure TForm1.dtp1Change(Sender: TObject);
var
ini: TIniFile;
begin
ToDate := dtp1.DateTime;
ini := TIniFile.Create('.\Config.ini');
ini.WriteDateTime('Config', 'ToDate', ToDate);
ini.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
ini: TIniFile;
begin
ini := TIniFile.Create('.\Config.ini');
ToDate := ini.ReadDateTime('Config', 'ToDate', Now); //读配置文件日期
dtp1.DateTime := ToDate; //设置控件日期为配置文件日期
msg := ini.ReadString('Config', 'Msg', ''); //读提示内容
FontColor := ini.ReadInteger('Config', 'FontColor', 16777215);
BackColor := ini.ReadInteger('Config', 'BackColor', 0);
lbl3.Color := BackColor;
lbl3.Font.Color := FontColor;
ini.Free;
end;
procedure TForm1.btn2Click(Sender: TObject);
var
ini: TIniFile;
begin
if dlgColor1.Execute then
begin
lbl3.Color := dlgColor1.Color;
ini := TIniFile.Create('.\Config.ini');
ini.WriteInteger('Config', 'BackColor', dlgColor1.Color);
ini.Free;
end;
end;
procedure TForm1.btn1Click(Sender: TObject);
var
ini: TIniFile;
begin
if dlgColor1.Execute then
begin
lbl3.Font.Color := dlgColor1.Color;
ini := TIniFile.Create('.\Config.ini');
ini.WriteInteger('Config', 'FontColor', dlgColor1.Color);
ini.Free;
end;
end;
procedure TForm1.chk1Click(Sender: TObject);
begin
if chk1.Checked then
SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE)
else
SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;
end.
窗体代码
object Form1: TForm1
Left = 201
Top = 146
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = #20498#35745#26102#31243#24207' --by eboy'
ClientHeight = 108
ClientWidth = 476
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object lbl1: TLabel
Left = 8
Top = 8
Width = 233
Height = 33
Alignment = taRightJustify
AutoSize = False
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = -19
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object lbl2: TLabel
Left = 8
Top = 60
Width = 81
Height = 13
AutoSize = False
Caption = #20498#35745#26102#26085#26399#65306
end
object lbl3: TLabel
Left = 240
Top = 8
Width = 225
Height = 33
AutoSize = False
Color = clMedGray
Font.Charset = DEFAULT_CHARSET
Font.Color = clGreen
Font.Height = -19
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object stat1: TStatusBar
Left = 0
Top = 89
Width = 476
Height = 19
Panels = <
item
Width = 230
end
item
Width = 100
end>
end
object dtp1: TDateTimePicker
Left = 88
Top = 56
Width = 129
Height = 21
Date = 39739.000000000000000000
Time = 39739.000000000000000000
TabOrder = 1
OnChange = dtp1Change
end
object btn1: TButton
Left = 392
Top = 56
Width = 75
Height = 25
Caption = #25991#23383#39068#33394
TabOrder = 2
OnClick = btn1Click
end
object btn2: TButton
Left = 312
Top = 56
Width = 75
Height = 25
Caption = #32972#26223#39068#33394
TabOrder = 3
OnClick = btn2Click
end
object chk1: TCheckBox
Left = 256
Top = 60
Width = 41
Height = 17
Caption = 'Top'
TabOrder = 4
OnClick = chk1Click
end
object tmr1: TTimer
OnTimer = tmr1Timer
Left = 352
Top = 16
end
object dlgColor1: TColorDialog
Left = 168
Top = 16
end
end