Implementation
{$R *.dfm} const
DBNAME = 'pogoda.txt'; var
db: TextFile; // файл — база данных
// Начало работы. Откроем или создадим
// файл данных.
Procedure TForml.FormCreate(Sender: TObject);
144
Примеры и задачи
145
Р
ис.
1.53. Форма программы базы данных "Погода"
г: integer; // ответ пользователя begin
AssignFile(db,DBNAME) ; try
Append(db); // возможна ошибка except
on E: EInOutError do begin
r := MessageDlg('Файл базы данных (pogoda.txt) + 'не найден.' +
#13+'Создать файл?',mtWarning,[mbOk,mbCancel],0); if r = mrOK then begin
Rewrite(db); // создадим файл ShowMessage('Файл базы данных создан!'); end
else Application.Terminate; // завершить работу end; end;
Edit1.Enabled := True; Buttonl.Enabled := True; end;
// нажатие клавиши в поле Температура
procedure TForml.EditlKeyPress(Sender: TObject; var Key: Char);
begin
case Key of
10'..'9',#8:; // цифры и клавиша <Backspace>
#13: // клавиша <Enter>
if Length(Editl.Text) о 0 then Buttonl.SetFocus;
',','.': begin // десятичная точка Key:= DecimalSeparator; if Pos(DecimalSeparator,Editl.Text) о О
then Key :=Char(0); end;
'-': if Length(Editl.Text) О 0 then Key:=Char(0);
else Key:= Char(O); // остальные символы запрещены end;
end;
// щелчок на кнопке Добавить
procedure TForml.ButtonlClick(Sender: TObject);
begin
if Length(Editl.Text) = 0
then ShowMessage('Надо ввести температуру.') else begin
writeln(db,
FormatDateTime('dd/mm/yy',
MonthCalendarl.Date), ' ',Editl.Text); Editl.Text := "; end; end;
// завершение работы программы
procedure TForml.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
CloseFile(db); // закрыть файл end;
end.
Н
апишите
программу, которая в указанном
пользователем! ^доге и его подкаталогах
выполняет поиск файла. Рекомен- ^ый вид
диалогового окна приведен на рис. 1.54.
Для ввода ^и каталога во время работы
программы используйте стан-j
диалоговое окно Обзор
папок (рис.
1.55).
/риск файла в указанном каталоге и его подкаталогах /' ^пользуется рекурсивная процедура Find. //.с FindFile;
:ace
Messages, SysUtils, Variants, Classes, Graphics, , Forms, Dialogs, StdCtrls, FileCtrl;
-- class (TForm) £ditl: TEdit; £dit2: TEdit; plemol: TMemo; puttonl: TButton; ^utton2: TButton; j,abell: TLabel; (,аЬе12: TLabel; pabel3: TLabel; (,abel4 : TLabel;
procedure ButtonlClick(Sender: TObject); procedure Button2Click(Sender: TObject);
Private declarations )
Public declarations }
i*s
^.
// что искать
// где искать
// результат поиска
// кнопка Поиск
// кнопка Папка
-: TForml; ^mentation
.dfm}
Примеры и задачи
Р
ис.
1.54. Форма программы Поиск файла
147
£-j.leName:
string;
//
имя
или маска искомого файла .pir:
string;
Рис. 1.55. Стандартное окно Обзор папок
• integer;
// кол-во файлов, удовлетворяющих запросу
148
Час
Примеры и задачи
149
// поиск файла в текущем каталоге
procedure Find;
var
SearchRec: TSearchRec; // информация о файле или каталоге
begin
GetDir(0,cDir); // получить имя текущего каталога if cDir[length(cDir)] <> '\' then cDir := cDir+'V;
if FindFirst(FileName, faAnyFile,SearchRec) = 0 then repeat
if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then begin
Forml.Memol.Lines.Add(cDir + SearchRec.Name); n := n + 1; end; until FindNext(SearchRec) <> 0;
// обработка подкаталогов текущего каталога
{ Если не обрабатывать системные каталоги, то вместо faAnyFile можно задать faDirectory. Это объясняется тем, что значение SearchRec.Attr для обычного каталога равно faDirectory (16), для Program Files — faDirectory+faReadOnly (17), а для каталога Windows — faDirectory+faSysFile (20) }
if FindFirst('*', faAnyFile, SearchRec) = 0 then repeat
if (SearchRec.Attr and faDirectory) = faDirectory then
// каталоги '.. ' и '. ' тоже каталоги, . // но в них входить не надо !!! if SearchRec.Name[1] о '.' then begin
ChDir(SearchRec.Name); // войти в каталог Find; // выполнить поиск в подкаталоге ChDir('..');// выйти из каталога end;
until FindNext(SearchRec) <> 0; end;
// щелчок на кнопке Поиск
procedure TForml.ButtonlClick(Sender: TObject);
begin
if not DirectoryExists(Edit2.Text) then begin
ShowMessage('Каталог указан неверно.'); Edit2.SetFocus; exit; end;
Buttonl.Enabled := False;
Label4.Caption := '';
Labe14.Repaint;
// очистить поле Memol
// что искать
// где искать
// кол-во найденных файлов
// войти в каталог начала поиска
// начать поиск
Memol.Clear;
Label4.Caption := '';
FileName := Editl.Text;
cDir := Edit2.Text;
n:=0;
ChDir(cDir);
Find;
if n = 0 then
ShowMessage('Файлов, удовлетворяющих критерию ' + 'поиска нет.')
else Label4.Caption := 'Найдено файлов:' + IntToStr(n) Buttonl.Enabled := True;
end;
// возвращает каталог, выбранный пользователем
function GetPath(mes: string):string;
var
Root: string; // корневой каталог pwRoot : PWideChar; Dir: string; begin
Root := ''; // корневой каталог — папка Рабочий стол GetMem(pwRoot, (Length(Root)+1) * 2) ; pwRoot := StringToWideChar(Root,pwRoot,MAX_PATH*2); if SelectDirectory(mes, pwRoot, Dir) then
if length(Dir) =2 // выбран корневой каталог then GetPath := Dir+'V else GetPath := Dir else
GetPath := "; end;
150
ЧастьЩ
Примеры и задачи
151
procedure TForml.Button2Click(Sender: TObject) ,
var
Path: string; begin
Path := GetPath('Выберите папку');
if Path <> ''
then Edit2.Text := Path; end;
end.
Игры и полезные программы
Рис. 1.56. В начале игры фишки перемешаны
Рис. 1.57. Правильный порядок фишек
Напишите программу "Игра "15"". На рис. 1.58 приведена форма и окна программы.
Рис. 1.58. Форма и окна программы Игра 15
I Игра "15") unit gamel5_;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;
type
TForml = class(TForm)
procedure FormCreate(Sender: TObject); procedure FormMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormPaint(Sender: TObject);
// эти объявления вставлены сюда вручную procedure ShowPole; procedure Mixer;
private
{ Private declarations ) public
{ Public declarations ) end;
152
Час
Примеры и задачи
153
var
Forml: TForml ;