1 unit DateTimePicker;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, ComCtrls, ExtCtrls, StdCtrls, Grids, Calendar,StrUtils;
8
9 type
10 TForm1 = class(TForm)
11 DateTimePicker1: TDateTimePicker;
12 Panel1: TPanel;
13 Memo1: TMemo;
14 Button1: TButton;
15 Calendar1: TCalendar;
16 Label1: TLabel;
17 Label2: TLabel;
18 Button2: TButton;
19 ListBox1: TListBox;
20 Panel2: TPanel;
21 Timer1: TTimer;
22
23 procedure DateTimePickerOnChange(Sender: TObject);
24 procedure Button1Click(Sender: TObject);
25 procedure FindFiles(APath: String);
26 procedure Calendar1Click(Sender: TObject);
27 procedure Button2Click(Sender: TObject);
28 procedure ListBox1Click(Sender: TObject);
29 procedure Timer1Timer(Sender: TObject);
30 procedure FormCreate(Sender: TObject);
31 procedure newRecord;
32
33 private
34 { Private declarations }
35 public
36 { Public declarations }
37 end;
38
39 var
40 Form1: TForm1;
41
42 var
43 fileName:string;
44 path:string;
45
46
47 implementation
48
49 {$R *.dfm}
50
51
52 //new
53 procedure TForm1.DateTimePickerOnChange(Sender: TObject);
54 begin
55 newRecord;
56 end;
57
58
59 (*新建文件 有则显 无则 新建*)
60
61 procedure TForm1.newRecord;
62 var
63 IsExists:Boolean;
64 begin
65 fileName:=datetostr(DateTimePicker1.Date);
66 Panel1.Caption:=datetostr(DateTimePicker1.Date);
67 path:='D:\record\'+fileName+'.txt';
68 IsExists := FileExists(path);
69 if IsExists then
70 begin
71 Panel1.Caption:=fileName;
72 Memo1.ScrollBars:=ssBoth;
73 Memo1.Lines.LoadFromFile(path);
74 Button1.Caption:='修改';
75 end
76 else
77 begin
78 Memo1.Text:='';
79 Button1.Caption:='保存';
80 end;
81 end;
82
83
84 (*保存记录*)
85
86 procedure TForm1.Button1Click(Sender: TObject);
87 var
88 F: TextFile;
89 begin
90
91 // fileName:=datetostr(DateTimePicker1.Date);
92 fileName:= Panel1.Caption;
93 path:='D:\record\'+fileName+'.txt';
94 AssignFile(F,path);
95 Rewrite(F);
96 Writeln(F,Memo1.text);
97 CloseFile(F);
98
99 end;
100
101
102
103 (*从Calendar中查看 已有 记录内容 *)
104
105 procedure TForm1.Calendar1Click(Sender: TObject);
106 var
107 IsExists:Boolean;
108 begin
109 fileName:= DateToStr(Calendar1.CalendarDate);
110 path:='D:\record\'+fileName+'.txt';
111 IsExists := FileExists(path);
112 if IsExists then
113 begin
114 Panel1.Caption:=fileName;
115 Memo1.ScrollBars:=ssBoth;
116 Memo1.Lines.LoadFromFile(path);
117
118 end
119 else
120 ShowMessage('该文件不存在！');
121
122 end;
123
124
125 (* 查找 D：/Record 目录下的文件 ，并显示文件名在 listBox 中*)
126
127 procedure TForm1.FindFiles(APath: String);
128 var
129 FSearchRec : TSearchRec;
130 FindResult: integer;
131 begin
132 FindResult := FindFirst(APath+'*.*',faAnyFile+faHidden+faSysFile+faReadOnly,FSearchRec);
133 try
134 while FindResult = 0 do
135 begin
136 Listbox1.Items.Add(leftStr(fsearchrec.Name,10));
137 FindResult := FindNext(FSearchRec);
138 end;
139 finally
140 FindClose(FSearchRec);
141 end;
142 end;
143
144
145 (* 显示所有 文件*)
146 procedure TForm1.Button2Click(Sender: TObject);
147 begin
148 ListBox1.Clear;
149 FindFiles('D:\record\');
150 end;
151
152
153 (* 从listBox 中查看已有 记录内容 *)
154 procedure TForm1.ListBox1Click(Sender: TObject);
155 begin
156
157 fileName:= ListBox1.Items[ListBox1.ItemIndex];
158 path:='D:\record\'+fileName+'.txt';
159 Panel1.Caption:=fileName;
160 Memo1.ScrollBars:=ssBoth;
161 Memo1.Lines.LoadFromFile(path);
162 Button1.Caption:='修改';
163 end;
164
165 (* 显示时间*)
166 procedure TForm1.Timer1Timer(Sender: TObject);
167 begin
168 Panel2.Caption := FormatDateTime('yyyy 年 mm 月 dd 日 hh : nn : ss',now());
169 end;
170
171 (*初始化 数据*)
172 procedure TForm1.FormCreate(Sender: TObject);
173 begin
174 DateTimePicker1.DateTime:=Now(); //初始化 DateTimePicker 时间为当天时间
175 Panel1.Caption:=datetostr(DateTimePicker1.Date);
176 FindFiles('D:\record\'); //初始化 ListBox 文件列表
177 newRecord; //初始化 当天记录，有显 无新建
178 end;
179
180
181
182 end.
