Delphi: Заметки программиста.
Валерий Васильевич Фаронов
О файле проекта
Сокращение времени загрузки
Вид экрана до появления главного окна
Защита программы паролем
Пробные версии программ
Вставка поясняющих комментариев к именам форм
О переносе проекта в другую папку
Разнообразим вывод сообщений
Включение в библиотеку форм
Печать в Delphi
Печать текста
Печать изображений
Отображение файла в память
О таймере
к методу Initialize глобального объекта
program Project1; uses Forms, Unit1 in 'Unit1.pas' {Form1}; {$R *.RES}
begin Application.Initialize; Application.CreateForm(TForm1, Form1);
Application.Run; end.
Проект (программа) начинается обращением к методу Initialize глобального объекта Application и заканчивается после завершения его метода Run. Этот метод — центральный: он визуализирует главную форму приложения и осуществляет диспетчеризацию сообщений Windows. От того, какая работа выполняется строками кода, расположенными перед обращением к нему, зависят время загрузки приложения, и вид экрана до появления главного окна.
Метод Initialize предусмотрен, как говорится, на всякий случай и по умолчанию ничего не осуществляет. Чтобы заставить его работать, следует поместить указатель на соответствующую процедуру без параметров в глобальную переменную InitProc. Это можно сделать в секции инициализации любого модуля (код этих секций активизируется до начала работы основной программы) или непосредственно в теле главного проекта (листинг 2):
в этом последнем случае будет
procedure Init; begin // Выполняет какую-то работу;
end; begin InitProc := @Init; Application.Initialize; // Обращение к Init Application.CreateForm(TForm1, Form1);
Application.Run; end.
Разумеется, в этом последнем случае будет проще в первом операторе основной программы явно обратиться к процедуре Init. Вообще говоря, в подавляющем большинстве случаев оператор Application.Initialize можно удалить без каких-либо последствий для программы.
Разрушаем ненужную форму Form5
begin with TForm5.Create(nil) do try ProgressBar1.Max := 100; Show; // Показываем форму Form5 с индикатором ProgressBar1 Update; // Прорисовываем форму Form5 Application.CreateForm(TForm1, Form1);
ProgressBar1.StepBy(25);
Application.CreateForm(TForm2, Form2);
ProgressBar1.StepBy(25);
Application.CreateForm(TForm3, Form3);
ProgressBar1.StepBy(25);
Application.CreateForm(TForm4, Form4);
ProgressBar1.StepBy(25);
finally Free; // Разрушаем ненужную форму Form5 end; Application.Run; end.
В этом модуле определена функция
program Password; uses Forms, Dialogs, // В этом модуле определена функция InputQuery Unit1 in 'Unit1.pas' {MainForm}; {$R *.RES}
var Passwrd: String; begin // Запрашиваем пароль:
if InputQuery('Окно ввода пароля','Введите пароль:',Passwrd) then // Проверяем его:
if Passwrd = 'Delphi' then
begin // Все в порядке, пароль верен Application.CreateForm(TMainForm, MainForm);
Application.Run; end else ShowMessage('Пароль не верен!');
end.
Здесь следует дать небольшой комментарий.
program Trial; uses Forms, Unit1 in 'Unit1.pas' {Form1}, Registry, Dialogs; // Для TRegistry и ShowMessage
{$R *.RES}
var Reg: TRegistry; N: Integer; begin Reg := TRegistry.Create; with Reg do
begin
OpenKey('software', True);
OpenKey('TrialProg', True);
if ValueExists('MaxRun') then // Первый запуск? begin // - Нет N := ReadInteger('MaxRun')-1; if N>
=0 then WriteInteger('MaxRun', N) end else begin // -Да, первый запуск N := 5; WriteInteger('MaxRun', N) end; Free end; if N>
0 then
begin
Application.CreateForm(TForm1, Form1);
Application.Run; end else ShowMessage('Исчерпано максимальное количество запусков'+ ' пробной версии программы') end.
Здесь следует дать небольшой комментарий. Модуль Registry декларирует класс TRegistry, который представляет программисту доступ к системному реестру Windows. С помощью двух обращений к функции TRegistry.OpenKey создается и/или открывается ключ HKEY_CURRENT_USER\Software\TrialProg системного реестра. Функция TRegistry.ValueExists возвращает True, если этот ключ содержит параметр с именем MaxRun и для него определено значение. При первом запуске приложения это не так, поэтому процедурой WriteInteger создается параметр и для него указывается начальное значение 5 (максимальное количество прогонов программы). При каждом следующем запуске этот параметр уменьшается на 1 и в момент, когда он становится равен 0, приложение блокирует создание и отображение главного окна.
Присваиваем его дескриптор шрифту канвы
procedure TForm1.FormPaint(Sender: TObject);
var X: Integer; LF: TLogFont; Fnt: HFont; const Text = 'Лучшая в мире система программирования'; begin // Определяем параметры нового шрифта
FillChar(LF, SizeOf(LF), 0);
with LF do
begin lfHeight := 20; lfWeight := fw_Normal; lfUnderline := 1; lfEscapement := 450; StrPCopy(lfFaceName, 'Courier New Cyr');
end; with Form1.Canvas do
begin // Создаем шрифт
Fnt := CreateFontIndirect(LF);
// Присваиваем его дескриптор шрифту канвы
Font.Handle := Fnt; // Выводим текст под углом +45 градусов
TextOut(0, 300, Text);
X := TextWidth(Text);
DeleteObject(Fnt);
// Удаляем ненужный шрифт
// Изменяем параметры шрифта
with LF do
begin lfHeight := 90; lfEscapement := -900; lfWeight := fw_Heavy; StrPCopy(LF.lfFaceName, 'Arial Cyr');
end; Fnt := CreateFontIndirect(LF);
// Создаем новый шрифт Font.Handle := Fnt; Font.Color := clRed; // Выводим с наклоном -90 градусов
TextOut(X-10, 10, 'Delphi 5');
DeleteObject(Fnt);
// Удаляем ненужный шрифт end; end;
Параметр Format функции DrawText может содержать один или несколько флагов (табл. 2.)
Таблица 2. Возможные значения параметра Format функции DrawText
dt_Bottom | Текст прижимается к нижней части области Rect |
dt_CalcRect | Разрешает динамически изменять размеры области Rect |
dt_Center | Текст центрируется по горизонтали |
dt_EditControl | Функция дублирует свойства отображения многострочного тестового редактора. В частности, таким же способом вычисляется средняя ширина символа и не показывается частично видимая последняя строка |
dt_ExpandTabs | Символы табуляции заменяются пробелами |
dt_ExternalLeading | В высоту строки включается высота межстрочного интервала |
dt_Left | Текст прижимается к левой части области Rect |
dt_NoClip | Текст не отсекается границами Rect |
dt_NoPrefix | Символы & не заменяются подчеркиванием |
dt_Right | Текст прижимается к правой части области Rect |
dt_SingleLine | Весь текст выводится единственной строкой, символы EOLN игнорируются |
dt_TabsStop | Символы табуляции не заменяются пробелами |
dt_Top | Текст прижимается к верхней части области Rect |
dt_VCenter | Текст центрируется по вертикали |
dt_WordBreak | Разрешает переход на новую строку при достижении правой границы Rect; разрыв строки — на границе слова; символы EOLN также переводят вывод на следующую строку |
Если установлен флаг dt_CalcRect, функция изменяет высоту и ширину прямоугольника таким образом, чтобы вывести весь текст. Если выводится несколько строк, ширина вывода не меняется. Функция возвращает истинную высоту прямоугольника вывода.
Параметр Options функции ExtTextOut может быть комбинацией следующих значений:
eto_Clipped — текст будет отсекаться границами Rect;
eto_Gliph_Index — блокирует обработку языковым драйвером;
eto_Opaque — фон перерисовывается заново;
eto_RTLReading — вывод для чтения справа налево.
При выводе текста стандартными методами TCanvas всегда заново прорисовывается фон символов (цвет фона возвращает функция GetBkColor). Если цвет фона символов отличается от фона канвы, вывод сопровождается неприятными побочными эффектами. Если в примере из листинга 6 для формы оставить стандартный цвет clFaceBtn, окно вывода будет таким, как на рис. 3.
Рис. 3. Эффект прорисовки фона символов
Конечно, с помощью функции SetBkColor можно установить, чтобы цвет формы совпадал с цветом канвы, однако это не всегда возможно. Для примера на рис. 4. показан экран, который традиционно создают многие программы установки Setup.exe. Фон на таком экране не остается постоянным, а плавно переходит от интенсивного синего к черному. Ясно, что установить переменный цвет функцией SetBkColor невозможно. Более того, заглавные надписи программ Setup.exe также традиционно выводятся утолщенным наклонным шрифтом Times New Roman белыми буквами с черной тенью. Реализовать подобный эффект достаточно просто. Так, нужно вообще отказаться от прорисовки фона, установив с помощью функции SetBkMode режим Transparent, и вывести надпись дважды: первый раз черным цветом, а второй — белым, сместив вторую надпись немного влево и вверх относительно первой. Листинг 7 иллюстрирует сказанное (Setup.dpr)
Это обращение накладывает текст на
procedure TForm1.FormPaint(Sender: TObject);
var Y: Integer; Blue: Byte; const Text = 'Фон для программы Setup.exe'; begin
with Form1.Canvas do
begin
// Создаем фон:
for Y := 0 to Form1.Height-1 do begin // Уменьшаем интенсивность цвета с ростом ординаты Y
Blue := Round($FF*(Form1.Height-Y)/Form1.Height);
// Формируем цвет
Pen.Color := RGB(0, 0, Blue);
// Чертим линию
MoveTo(0, Y);
LineTo(Form1.Width-1, Y);
end; // for Y := 0 to Form1.Height-1 do Font.Size := 32; Font.Style := [fsBold, fsItalic, fsUnderline]; Font.Name := 'Times New Roman Cyr'; // Это обращение накладывает текст на фон:
SetBkMode(Handle, Transparent);
// Сначала выводим тень надписи
Font.Color := clBlack; TextOut(40, 30, Text);
// Теперь саму надпись
Font.Color := clWhite; TextOut(36, 26, Text) end; // with Form1.Canvas do end;
На рис. 4. показано окно работающей программы.
Рис. 4. Иллюстрация режима Transparent
Текст DLL
library DLLWithForm; uses SysUtils, Classes, DLLFormU in 'DLLFormU.pas' {DLLForm}; {$R *.RES}
exports ShowModalForm, ShowForm, FreeForm;
begin
end.
Текст формы в DLL
unit DLLFormU; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons; type TDLLForm = class(TForm) BitBtn1: TBitBtn; BitBtn2: TBitBtn; procedure FormClose(Sender: TObject; var Action: TCloseAction);
private { Private declarations }
CallForm: THandle; //Дескриптор вызывающей формы
public { Public declarations }
end; // Объявление экспортируемых подпрограмм
function ShowModalForm: Integer; procedure ShowForm(Appl, Form: THandle);
procedure FreeForm; var DLLForm: TDLLForm; implementation {$R *.DFM}
function ShowModalForm: Integer; // Модальный вызов
begin DllForm := TDllForm.Create(Application);
Result := DLLForm.ShowModal; DLLForm.Free; end; procedure ShowForm(Appl, Form: THandle);
// Немодальный вызов
begin Application.Handle := Appl; // Замена объекта Application DllForm := TDllForm.Create(Application);
// Запоминаем дескриптор вызывающего окна для посылки
// ему сообщения о закрытии
CallForm := Form; DLLForm.Show end; procedure FreeForm; // Уничтожение формы
begin DLLForm.Free end; procedure TDLLForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if CallForm<>
0 then SendMessage(CallForm, wm_User, 0, 0) end; end.
Текст вызывающей программы
unit TestMainU; interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TTestMain = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; Label1: TLabel; procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private { Private declarations }
public { Public declarations }
// Следующая процедура обрабатывает сообщение WM_USER,
// которое посылает форма из DLL в момент своего закрытия
procedure WMUser(var Msg: TMessage);
message WM_USER; end; var TestMain: TTestMain; implementation {$R *.DFM}
function ShowModalForm: Integer; External 'DLLWithForm'; procedure ShowForm(Appl, Form: THandle);
External 'DLLWithForm'; procedure FreeForm; External 'DLLWithForm'; procedure TTestMain.Button1Click(Sender: TObject);
// Модальный вызов
begin Button2.Enabled := False; label1.Caption := 'ModalResult = '+IntToStr(ShowModalForm);
label1.Show; // Показываем результат вызова Button2.Enabled := True end; procedure TTestMain.Button2Click(Sender: TObject);
// Немодальный вызов
begin Button1.Enabled := False; Button2.Enabled := False; Button3.Enabled := True; label1.Hide; ShowForm(Application.Handle, Self.Handle);
end; procedure TTestMain.Button3Click(Sender: TObject);
// Закрыть форму
begin FreeForm; Button1.Enabled := True; Button2.Enabled := True; Button3.Enabled := False; end; procedure TTestMain.WMUser(var Msg: TMessage);
// Сообщение из формы DLL о ее закрытии
begin Button3.Click end; end.
Модуль формы DLLForm, помещенной в DLL, ссылается на стандартный модуль Forms и, таким образом, получает свой глобальный объект Application, который ничего «не знает» о глобальном объекте вызывающей программы. В режиме модального вызова это не имеет особого значения, поскольку модальное окно блокирует работу вызывающей программы. В режиме немодального вызова следует синхронизовать действия объектов, в противном случае минимизация главного окна, например, не приведет к минимизации окна DLL. Синхронизация достигается тем, что дескриптор объекта Application DLL заменяется соответствующим дескриптором вызывающей программы.
При показе формы в немодальном режиме она может быть закрыта либо вызвавшей ее программой, либо щелчком по собственной системной кнопке Закрыть. В последнем случае она должна каким-то образом известить вызывающую программу об этом событии. Для этого используется стандартный механизм посылки Windows-сообщения. Сообщение должно иметь адрес — дескриптор окна, для которого оно предназначено. Вот почему вторым параметром обращения к функции ShowForm в DLL передается и в поле CallForm запоминается дескриптор окна вызывающей программы. Обработчик события OnClose формы проверяет это поле и, если оно определено, посылает вызвавшему окну сообщение с индексом WM_USER. В вызывающей программе предусмотрен обработчик этого сообщения, в котором реализуются необходимые действия.
Печать содержимого редактора как вывод
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons;
type
TForm1 = class(TForm) Memo1: TMemo; Button1: TButton; Button2: TButton; OpenDialog1: TOpenDialog; BitBtn1: TBitBtn; Button3: TButton; FontDialog1: TFontDialog; procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
uses
Printers; // Эта ссылка обязательна!
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
// Выбор файла с текстом и его загрузка в редактор begin
if OpenDialog1.Execute then
Memo1.Lines.LoadFromFile(OpenDialog1.FileName) end;
procedure TForm1.Button3Click(Sender: TObject);
// Выбор шрифта и связывание его с Memo1 begin
if FontDialog1.Execute then
Memo1.Font := FontDialog1.Font end;
procedure TForm1.Button2Click(Sender: TObject);
// Печать содержимого редактора как вывод в текстовый файл var
Prn: TextFile; k: Integer; begin
AssignPrn(Prn);
// Переназначаем вывод в файл на вывод в принтер Rewrite(Prn);
// Готовим принтер к печати (аналог BeginDoc) {Для печати используем такой же шрифт, как и для показа в редакторе:} Printer.Canvas.Font := Memo1.Font; // Цикл печати: for k := 0 to Memo1.Lines.Count-1 do
WriteLn(Prn, Memo1.Lines[k]);
CloseFile(Prn);
// Аналог EndDoc end;
end.
Описанный способ печати — самый примитивный: с его помощью невозможно вывести линии, разделяющие колонки или строки, трудно форматировать текст, вставлять заголовки, номера страниц и т.д.
Значительно более гибкие средства обеспечивает свойство Printer.Canvas. Покажем, как с его помощью можно напечатать текст, содержащийся в редакторе Memo1 (PrintText.dpr, листинг 12):
Печать содержимого редактора как вывод
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons;
type
TForm1 = class(TForm) Memo1: TMemo; Button1: TButton; Button2: TButton; OpenDialog1: TOpenDialog; BitBtn1: TBitBtn; Button3: TButton; FontDialog1: TFontDialog; procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
uses Printers; // Эта ссылка обязательна!
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
// Выбор файла с текстом и его загрузка в редактор begin
if OpenDialog1.Execute then
Memo1.Lines.LoadFromFile(OpenDialog1.FileName) < end;
procedure TForm1.Button3Click(Sender: TObject);
// Выбор шрифта и связывание его с Memo1 < begin
ifFontDialog1.Execute then
Memo1.Font := FontDialog1.Font end;
procedure TForm1.Button2Click(Sender: TObject);
// Печать содержимого редактора как вывод в текстовый файл
var
Prn: TextFile; k: Integer; begin
AssignPrn(Prn);
// Переназначаем вывод в файл на вывод в принтер Rewrite(Prn);
// Готовим принтер к печати (аналог BeginDoc) { Для печати используем такой же шрифт, как и для показа в редакторе: } Printer.Canvas.Font := Memo1.Font; // Цикл печати: for k := 0 to Memo1.Lines.Count-1 do
WriteLn(Prn, Memo1.Lines[k]);
CloseFile(Prn);
// Аналог EndDoc end;
end.
Как можно увидеть, прямое обращение к чертежным инструментам свойства Canvas требует от программиста значительно больших усилий, но зато предоставляет ему полный контроль над печатным изображением.
Во многих случаях для печати документа и внесения в него элементарных средств форматирования (печать общего заголовка, заголовка на каждой странице, номеров страниц и т.п.) проще использовать специальные компоненты, расположенные на странице QReport палитры компонентов Delphi. Эти компоненты разработаны для создания отчетов по базам данных, но могут с успехом использоваться и для печати обычных документов (PrintText.dpr).
Наконец, очень хороших результатов можно достичь, используя специализированные средства просмотра/печати документов, как, например, текстовый процессор MS Word.
Создание файла методом его отображения
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, Spin;
type
TForm1 = class(TForm) btMem: TButton; btFile: TButton; se: TSpinEdit; Label1: TLabel; pb: TProgressBar; Label2: TLabel; lbMem: TLabel; lbFile: TLabel; procedure btMemClick(Sender: TObject);
procedure btFileClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.btMemClick(Sender: TObject);
// Создание файла методом его отображения type
PReal = ^Real; var
HFile, HMap: THandle; AdrBase, AdrReal: PReal; k: Integer; FSize: Cardinal; BegTime: TDateTime; begin
BegTime := Time; // Засекаем время пуска // Готовим ProgressBar: pb.Max := se.Value; pb.Position := 0; pb.Show; FSize := se.Value * SizeOf(Real);
// Длина файла HFile := FileCreate('test.dat');
// Создаем файл if HFile = 0 then // Ошибка: возбуждаем исключение raise Exception.Create('Ошибка создания файла');
try
// Отображаем файл в память HMap := CreateFileMapping( HFile, NIL, PAGE_READWRITE, 0, FSize, NIL);
if HMap = 0 then // Ошибка: возбуждаем исключение raise Exception.Create('Ошибка отображения файла');
try
// Создаем окно просмотра: AdrBase := MapViewOfFile(HMap, FILE_MAP_WRITE, 0, 0, FSize);
if AdrBase = NIL then // Ошибка: возбуждаем исключение raise Exception.Create('Невозможно просмотреть файл');
// Сохраняем начальный адрес для правильной ликвидации // окна просмотра: AdrReal := AdrBase; for k := 1 to se.Value do
begin
AdrReal^ := Random; // Помещаем в файл новое число // Перед наращиванием текущего адреса необходимо // привести его к типу Integer или Cardinal: AdrReal := Pointer(Integer(AdrReal) + SizeOf(Real));
lbMem.Caption := IntToStr(k);
pb.Position := k; Application.ProcessMessages; end;
// Освобождаем окно просмотра: UnmapViewOfFile(AdrBase) finally
// Освобождаем отображение CloseHandle(HMap) end
finally
// Закрываем файл end;
// Сообщаем время счета pb.Hide; lbMem.Caption := TimeToStr(Time-BegTime) end;
procedure TForm1.btFileClick(Sender: TObject);
// Создание файла обычным методом var
F: File of Real; k: Integer; BegTime: TDateTime; R: Real; // Буферная переменная для обращения к Write begin
BegTime := Time; // Засекаем начальное время счета // Готовим ProgressBar: pb.Max := se.Value; pb.Position := 0; pb.Show; // Создаем файл: AssignFile(F, 'test.dat');
Rewrite(F);
for k := 1 to se.Value do
begin
R := Random; // Параметрами обращения к Write Write(F, R);
// могут быть только переменные lbFile.Caption := IntToStr(k);
pb.Position := k; Application.ProcessMessages; end;
CloseFile(F);
pb.Hide; lbFile.Caption := TimeToStr(Time-BegTime) end;
end.
Начальное время цикла Counter: Integer;
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;
type
TfmExample = class(TForm) Panel1: TPanel; bbRun: TBitBtn; bbClose: TBitBtn; edInput: TEdit; lbOutput: TLabel; mmOutput: TMemo; Timer1: TTimer; procedure bbRunClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
BegTime: TDateTime; // Начальное время цикла Counter: Integer; // Счетчик цикла end;
var
fmExample: TfmExample;
implementation
{$R *.DFM}
procedure TfmExample.bbRunClick(Sender: TObject);
// Запускает таймер. edInput содержит период его срабатывания. var
Delay: Word; begin
// Проверяем задание интервала if edInput.Text='' then Exit; try
Delay := StrToInt(edInput.Text);
except
ShowMessage('Ошибка в записи числа');
edInput.SelectAll; edInput.SetFocus; Exit end;
Counter := 0; // Сбрасываем счетчик Timer1.Interval := Delay; // Устанавливаем интервал BegTime := Time; // Засекаем время Timer1.Enabled := True; // Пускаем таймер Screen.Cursor := crHourGlass end;
procedure TfmExample.Timer1Timer(Sender: TObject);
var
h, m, s, ms: Word; // Переменные для декодирования времени const
MaxCount = 55; // Количество срабатываний таймера begin
Counter := Counter + 1; // Наращиваем счетчик срабатываний if Counter=MaxCount then // Конец цикла? begin // - Да Timer1.Enabled := False; // Останавливаем таймер // Находим среднее время срабатывания: DecodeTime((Time-BegTime)/MaxCount, h, m, s, ms);
mmOutput.Lines.Add( // Выводим результат Format('Задано %s ms. Получено %d ms.', [edInput.Text, ms]));
edInput.Text := ''; // Готовим следующий запуск edInput.SetFocus; Screen.Cursor := crDefault end;
end;
procedure TfmExample.FormActivate(Sender: TObject);
begin
edInput.SetFocus end;
end.
Необходимость нескольких (MaxCount) срабатываний для точного усреднения результата связана с тем, что системные часы обновляются каждые 55 мс. После запуска программы и ввода 1 как требуемого периода срабатывания в редакторе mmOutput вы увидите строку
Задано 1 ms. Получено 55 ms.
в которой указывается, какое реальное время разделяет два соседних события OnTimer. Если вы установите период таймера в диапазоне от 56 до 110 мс, в строке будет указано 110 ms и т.д. (в силу дискретности обновления системных часов результаты могут несколько отличаться в ту или иную сторону).
В ряде практически важных областей применения (при разработке игр, в системах реального времени для управления внешними устройствам и т.п.) интервал 55 мс может оказаться слишком велик. Современный ПК имеет мультимедийный таймер, период срабатывания которого может быть от 1 мс и выше, однако этот таймер не имеет компонентного воплощения, поэтому для доступа к нему приходится использовать функции API.
Общая схема его использования такова. Сначала готовится процедура обратного вызова (call back) с заголовком:
procedure TimeProc(uID, uMsg: UINT; dwUser, dw1, dw2: DWORD);
stdcall;
Здесь uID — идентификатор события таймера (см. об этом ниже);
uMsg — не используется; dwUser — произвольное число, передаваемое процедуре в момент срабатывания таймера; dw1, dw2 — не используются.
Запуск таймера реализуется функцией:
function timeSetEvent(uDelay, uResolution: UINT; lpTimeProc: Pointer; dwUser: DWORD; fuEvent: UINT): UINT; stdcall; external 'winmm.dll';
Здесь uDelay — необходимый период срабатывания таймера (в мс);
uResolution — разрешение таймера (значение 0 означает, что события срабатывания таймера будут возникать с максимально возможной частотой; в целях снижения нагрузки на систему вы можете увеличить это значение);
lpTimeProc — адрес процедуры обратного вызова; dwUser — произвольное число, которое передается процедуре обратного вызова и которым программист может распоряжаться по своему усмотрению; fuEvent — параметр, управляющий периодичностью возникновения события таймера: TIME_ONESHOT (0) — событие возникает только один раз через uDelay миллисекунд; TIME_PERIODIC (1) — события возникают периодически каждые uDelay мс. При успешном обращении функция возвращает идентификатор события таймера и 0, если обращение было ошибочным.
Таймер останавливается, и связанные с ним системные ресурсы освобождаются функцией:
function timeKillEvent(uID: UINT): UINT; stdcall; external 'winmm.dll';
Здесь uID — идентификатор события таймера, полученный с помощью timeSetEvent.
В следующем примере (Timer.dpr) иллюстрируется использование мультимедийного таймера (листинг 15).
Идентификатор события таймера BegTime: TDateTime;
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;
type
TfmExample = class(TForm) Panel1: TPanel; bbRun: TBitBtn; bbClose: TBitBtn; edInput: TEdit; lbOutput: TLabel; mmOutput: TMemo; procedure bbRunClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
end;
var
fmExample: TfmExample;
implementation
{$R *.DFM}
// Объявление экспортируемых функций:
function timeSetEvent(uDelay, uReolution: UINT; lpTimeProc: Pointer; dwUser: DWORD; fuEvent: UINT): Integer; stdcall; external 'winmm';
function timeKillEvent(uID: UINT): Integer; stdcall; external 'winmm'; // Объявление глобальных переменных var
uEventID: UINT; // Идентификатор события таймера BegTime: TDateTime; // Засекаем время< Counter: Integer; // Счетчик повторений Delay: Word; // Период срабатывания
procedure ProcTime(uID, msg: UINT; dwUse, dw1, dw2: DWORD);
stdcall; // Реакция на срабатывание таймера (процедура обратного вызова) var
h, m, s, ms: Word; // Переменные для декодирования времени const
MaxCount = 55; // Количество повторений begin
timeKillEvent(uEventID);
// Останавливаем таймер Counter := Counter+1; // Наращиваем счетчик if Counter=MaxCount then // Конец цикла? begin // - Да: декодируем время DecodeTime((Time-BegTime)/MaxCount, h, m, s, ms);
fmExample.mmOutput.Lines.Add( // Сообщаем результат Format('Задано %s ms. Получено %d ms', [fmExample.edInput.Text,ms]));
fmExample.edInput.Text := ''; // Готовим повторение fmExample.edInput.SetFocus end else // - Нет: вновь пускаем таймер uEventID := timeSetEvent(Delay,0,@ProcTime,0,1);
end;
procedure TfmExample.bbRunClick(Sender: TObject);
// Запускает таймер. edInput содержит требуемый период. begin
// Проверяем задание периода if edInput.Text='' then Exit; try
Delay := StrToInt(edInput.Text) except
ShowMessage('Ошибка ввода числа');
edInput.SelectAll; edInput.SetFocus; Exit end;
Counter := 0; // Сбрасываем счетчик BegTime := Time; // Засекаем время // Запускаем таймер: uEventID := timeSetEvent(Delay,0,@ProcTime,0,1);
if uEventID=0 then
ShowMessage('Ошибка запуска таймера') end;
procedure TfmExample.FormActivate(Sender: TObject);
begin
edInput.SetFocus end;
end.
О файле проекта
Известно, что Delphi создает множество файлов с расширениями pas, dfm, dpr и т.д. Обычно программиста интересуют файлы кода (pas) и описания форм (dfm), а остальные остаются вне его поля зрения, а зря — они несут важную информацию, которую можно (а в ряде случаев — нужно) изменять.
Начнем с файла проекта (dpr). Фактически он содержит собственно программу, в то время как связанные с проектом многочисленные файлы форм и DLL представляют собой подпрограммы.
Структура файла проекта, содержащего единственную форму, такова, как показано в листинге 1
О переносе проекта в другую папку
Кстати, данный рисунок иллюстрирует нарушение правила «один проект — одна папка»: в этом проекте, вопреки означенному правилу, многие модули хранятся во вложенных папках, в результате Delphi указывает длинные маршруты доступа к соответствующим файлам. Если такой проект скопировать на дискету, то эти маршруты останутся без изменения и компилятор не сможет найти нужные файлы. Еще хуже, если скопировать проект в другую папку на том же жестком диске. В этом случае начнутся неприятности: вы будете что-то изменять в новом проекте, но приложение на это никак не отреагирует, а если вы установите контрольную точку останова в каком-либо из модулей, то она окажется неработоспособной — компилятор будет по-прежнему использовать оригинальные файлы, а не копии.
Если вы захотите перенести проект в другую папку и при этом сохранить его работоспособность, вам нужно сначала с помощью опции File|Save Project As скопировать в эту папку файл проекта, а затем с помощью опции File|Save As перенести туда все связанные с проектом модули: только тогда Delphi сумеет внести необходимые коррекции в файл проекта. Но если все файлы хранятся в единственной папке, то в предложении uses не указываются маршруты доступа, и поэтому вы сможете безболезненно скопировать разом все файлы в другую папку.
Настроечный файл .dsk, в котором среда сохраняет информацию о состоянии экрана в момент выхода из Delphi, также содержит полные маршруты доступа к открытым файлам. При переносе проекта этот файл копировать не следует.
О таймере
Компонент Timer (таймер) служит для отсчета интервалов реального времени. Его свойство Interval определяет интервал временив миллисекундах , который должен пройти от включения таймера до наступления события OnTimer. Таймер включается при установке значения True в его свойство Enabled. Единожды включенный таймер все время будет возбуждать события OnTimer до тех пор, пока его свойство Enabled не примет значения False.
Следует учесть, что в силу специфики реализации стандартного аппаратного таймера IBM-совместимого компьютера минимальный реально достижимый интервал отсчета времени не может быть меньше 55 мс (этот интервал называется тиком), более того, любой интервал времени, отсчитываемый с помощью таймера, всегда кратен 55 мс. Чтобы убедиться в этом, проведите эксперимент, в котором подсчитывается среднее время между двумя срабатываниями таймера (Timer.dpr):
Начните новый проект с пустой формой и положите на нее компонент TTimer.
Установите в свойство Enabled таймера значение False.
Напишите такой модуль главной формы (листинг 14):
Отображение файла в память
Для работы с файлом динамической подкачки страниц виртуальной памяти в Windows 32 используется механизм отображения файлов в адресное пространство приложения. Соответствующие функции API доступны любому приложению и могут применяться к любому файлу (кстати, таким способом загружаются в адресное пространство процесса исполняемые файлы и DLL). В результате отображения приложение может работать с файловыми данными как с размещенными в динамической памяти. В большинстве случаев такая возможность не только повышает скорость работы с данными, но и предоставляет программисту уникальные средства обработки сразу всех записей файла. Например, он может с помощью единственного оператора проверить, входит ли заданный образец поиска в какую-либо строку текстового файла.
Отображение файла осуществляется в три приема. Вначале файл создается обращением к функции:
function FileCreate (FileName: String): Integer;
или открывается с помощью:
function FileOpen (const FileName: String; Mode: LongWord): Integer;
В обеих функциях FileName — имя файла, возможно, с маршрутом доступа. Параметр Mode определяет режим доступа к файлу и может принимать одно из следующих значений: fmOpenRead — только чтение; fmOpenWrite — только запись; fmOpenReadWrite — чтение и запись. С помощью операции or эти константы можно комбинировать с одной из следующих нескольких функций, регулирующих совместный доступ к файлу: fmShareExclusive — совместный доступ запрещен; fmShareDenyWrite — другим приложениям запрещается запись; fmShareDenyRead — другим приложениям запрещается чтение; fmSchareDenyNone — совместный доступ неограничен. Обе функции возвращают дескриптор созданного (открытого) файла или 0, если операция оказалась неудачной.
На втором этапе создается объект отображения в память. Для этого используется функция:
function CreateFileMapping (hFile: THandle; lpFileMappingAttributes: PSecurityAttributes; flProtect, dwMaximumSizeHigh, dwMaximumSizeLow: DWord; lpName: PChar): THandle;
Здесь hFile — дескриптор файла; lpFileMappingAttributes — указатель на структуру, в которой определяется, может ли создаваемый объект порождать дочерние объекты (обычно не может — NIL); flProtect — определяет тип защиты, применяемый к окну отображения файла (см. об этом ниже); dwMaximumSizeHigh, dwMaximumSizeLow — соответственно старшие и младшие 32 разряда числа, содержащего размер файла (если вы будете отображать файлы длиной до 4 Гбайт, поместите в dwMaximumSizeHigh 0, если в dwMaximumSizeLow — длину файла; а если оба параметра равны 0, то размер окна отображения равен размеру файла); lpName — имя объекта отображения или NIL.
Параметр flProtect задает тип защиты, применяемый к окну просмотра файла, и может иметь одно из следующих значений: PAGE_READONLY — файл можно только читать (файл должен быть создан или открыт в режиме fmOpenRead); PAGE_READWRITE — файл можно читать и записывать в него новые данные (файл открывается в режиме fmOpenReadWrite); PAGE_WRITECOPY — файл открыт для записи и чтения, однако обновленные данные сохраняются в отдельной защищенной области памяти (отображенные файлы могут разделяться приложениями, в этом режиме каждое приложение сохраняет изменения в отдельной области памяти или участке файла подкачки); файл открывается в режиме fmOpenReadWrite или fmOpenWrite; (этот тип защиты нельзя использовать в Windows 95/98). С помощью операции or
к параметру flProtect можно присоединить такие атрибуты: SEC_COMMIT — выделяет для отображения физическую память или участок файла подкачки; SEC_IMAGE — информация об атрибутах отображения берется из образа файла; SEC_NOCASHE — отображаемые данные не кэшируются и записываются непосредственно на диск; SEC_RESERVE — резервируются страницы раздела без выделения физической памяти.
Функция возвращает дескриптор объекта отображения или 0, если обращение было неудачным.
Наконец, на третьем этапе создается окно просмотра, то есть собственно отображение данных в адресное пространство программы.
function
MapViewOfFile(hFileMappingObject: THandle;dwDesiresAccess: DWord; dwFileOffsetHigh, dwFileIffsetLow, dwNumberOfBytesToMap: DWord): Pointer;
Здесь hFileMappingObject — дескриптор объекта отображения; dwDesiresAccess — определяет способ доступа к данным и может иметь одно из следующих значений: FILE_MAP_WRITE — разрешает чтение и запись (при этом в функции CreateFileMapping должен использоваться атрибут PAGE_READWRITE); FILE_MAP_READ — разрешает только чтение (в функции CreateFileMapping должен использоваться атрибут PAGE_READONLY или PAGE_READWRITE); FILE_MAP_ALL_ACCESS — то же, что и FILE_MAP_WRITE; FILE_MAP_COPY — данные доступны для записи и чтения, однако обновленные данные сохраняются в отдельной защищенной области памяти (в функции CreateFileMapping должен использоваться атрибут PAGE_WRITECOPY); dwFileOffsetHigh, dwFileIffsetLow — определяют соответственно старшие и младшие разряды смещения от начала файла, начиная с которого осуществляется отображение; dwNumberOfBytesToMap — определяет длину окна отображения (0 — длина равна длине файла). Функция возвращает указатель на первый байт отображенных данных или NIL, если обращение к функции оказалось безуспешным.
После использования отображенных данных ресурсы окна отображения нужно освободить функцией:
function UnMapViewOfFile(lpBaseAddress: Pointer): BOOL;
единственный параметр обращения к которой должен содержать адрес первого отображенного байта, то есть адрес, возвращаемый функцией MapViewOfFile. Закрытие объекта отображения и самого файла осуществляется обращением к функции:
function CloseHandle(hObject: THandle).
В листинге 13 приводится текст модуля (FileInMemory.dpr
Рис. 5. Окно проекта
Проект создает дисковый файл, состоящий из 100 тыс. случайных вещественных чисел (можно выбрать другую длину файла, если изменить значение редактора Длина массива). Файл с именем test.dat создается путем отображения файла в память (кнопка Память) и традиционным способом (кнопка Файл). В обоих случаях показывается время счета. Чем больше частота процессора и объем свободной оперативной памяти, тем больше будет разница во времени (листинг 13).
Печать изображений
Печать изображений может показаться очень сложным делом, однако свойство Printer.Canvas содержит метод:
procedure StretchDraw(const Rect: TRect; Graphic: TGraphic );
который легко справляется с этой задачей. При обращении к нему в качестве первого параметра указывается прямоугольная область, отводимая на поверхности листа для распечатки изображения, а в качестве второго — объект класса TGraphic, в котором хранится изображение, например:
with Printer do begin BeginDoc; Canvas.StretchDraw(Canvas.ClipRect, Image1.Picture.Graphic); EndDoc; end;
Печать текста
Существует множество способов печати текста на принтере. Прежде всего следует назвать глобальную процедуру AssignPrn (она определена в модуле Printers), позволяющую использовать принтер как текстовый файл и печатать текстовые строки с помощью процедуры WriteLn. В листинге 11 (PrintText.dpr) приведен полный текст модуля, на форме которого расположены многострочный текстовый редактор Memo1 и четыре кнопки: для выбора текстового файла и ввода его содержимого в редактор, для выбора нужного шрифта отображения/печати документа, для инициации процесса печати и для завершения работы программы.
Печать в Delphi
Объект Printer автоматически создается в случае, если в программе указана ссылка на модуль Printers. Этот объект предоставляет программисту все необходимое для того, чтобы научить приложение выводить данные на один из подключенных к компьютеру принтеров.
Вывод на принтер в Windows ничем не отличается от вывода на экран: в распоряжение программиста предоставляется свойство Canvas объекта Printer, содержащее набор чертежных инструментов, и методы, свойственные классу TCanvas. Размер листа бумаги в пикселах определяют свойства Height и Width, а набор принтерных шрифтов – свойство Fonts.
Пробные версии программ
Вышеописанным способом можно создавать пробные версии программ, которые будут функционировать только до определенной даты или до исчерпания заданного количества запусков. В листинге 5 представлен файл проекта (Trial.dpr), в котором пробная версия программы может запускаться не более 5 раз. Для запоминания номера очередного прогона используется системный реестр.
Разнообразим вывод сообщений
Все богатство изобразительных возможностей Windows вовсе не исчерпывается набором свойств и методов класса TCanvas: этот класс инкапсулирует лишь наиболее популярные приемы работы с чертежными инструментами. В табл. 1 перечислены некоторые функции Windows, которые не инкапсулирует класс TCanvas и способны значительно разнообразить текстовый вывод (именно он наиболее обеднен узкими рамками TCanvas).
Таблица 1. Некоторые текстовые функции Windows API
type
TLogFont = record lfHeight: Integer; lfWidth: Integer; lfEscapment: Integer; lfOrientation: Integer; lfWeight: Integer; lfItalic: Byte; lfUnderline: Byte; lfStrikeOut: Byte; lfCharSet: Byte; lfOutPrecision: Byte; lfClipPrecision: Byte; lfQuality: Byte; lfPitchAndFamily: Byte; lfFaceName: PChar; end; function CreateFont(Font: TLogFont): hFont; | Создает новый шрифт на основе данных в параметре Font (назначение полей структуры TLogFont см. в тексте после таблицы) | ||
function
DrawText(DC: hDC; pText: PChar; var Rect: TRect; Format: Wodr): Integer; | В прямоугольнике Rect выводит многострочный текст, на который указывает pText. Параметр Format используется для форматирования (см. ниже) | ||
function
ExtTextOut(DC: hDC; X, Y: Integer; Options: Integer; Rect: TRect; pText: PChar; Count: Integer; PX: PInteger): Bool; | Выводит текст с нестандартными межсимвольными расстояниями: X, Y — верхняя левая точка текста; Options — параметр, управляющий выводом (см. ниже); Rect — ограничивающий прямоугольник; pText — указатель на строку вывода; Count — количество выводимых символов; PX — указатель на массив целочисленных значений, определяющих межсимвольные расстояния: 1-й параметр — расстояние от 1-го до 2-го символа; 2-й параметр — расстояние от 2-го до 3-го символа и т.д.; если какой-то параметр равен 0, используется умалчиваемое межсимвольное расстояние | ||
function
GetBkColor(DC: hDC): TColor; | Возвращает цвет фона | ||
function
GetBkMode(DC: hDC): Integer; | Возвращает режим прорисовки фона: Opaque — фон прорисовывается заново при выводе текста; Transparent — фон не прорисовывается. | ||
function
GetTextAlign(DC: hDC): Integer; | Возвращает выравнивание текста | ||
function
GetTextCharacterExtra(DC: hDC): Integer; | Возвращает межсимвольное расстояние | ||
function
SetBkColor(DC: hDC; Color: TColor): TColor; | Устанавливает новый цвет фона и возвращает старый, если обращение успешно | ||
function
SetBkMode(DC: hDC; Mode: Integer): Integer; | Устанавливает новый режим прорисовки фона и возвращает старый, если операция успешна | ||
function
SetTextAlign(DC: hDC; Flags: Integer): Integer; | Устанавливает новое выравнивание текста и возвращает старое, если вызов успешен | ||
function
SetTextCharacterExtra(DC: hDC; CharExtra: Integer): Integer; | Устанавливает новое межсимвольное расстояние и возвращает старое, если вызов успешен |
Отдельные поля структуры TLogFont для функции CreateFontIndirect имеют следующий смысл:
lfHeight — высота шрифта в пунктах (1 пункт = 1/72 дюйма); если больше 0 — определяет высоту «знакоместа» (с учетом выступающих над заглавным символом элементов в буквах Ё, Й); если меньше 0 — определяет высоту «чистого» символа, если равно 0 — высоту выбирает Windows;
lfWidth — средняя ширина символа; если равно 0 — ширину устанавливает Windows;
lfEscapment — угол наклона базовой линии текста в десятых долях градуса относительно горизонтального направления; положительные значения — поворот по часовой стрелки; в Windows 95/98 совпадает с lfOrientation;
lfOrientation — угол наклона символов по отношению к базовой линии; в Windows NT для шрифтов True Type может отличаться от lfEscapment; для этого следует установить режим устройства отображения равным gm_Advanced (по умолчанию устанавливается gm_Compatible);
lfWeight — плотность шрифта (fm_DontCare=0 — плотность выбирает Windows; fm_Thin=100 — очень тонкий шрифт; fm_ExtraLight=200 — очень светлый; fm_Light=300 — светлый; fm_Normal=400 — нормальный; fm_Medium=500 — утолщенный; fm_SemiBold=600 — полужирный; fm_Bold=700 — жирный; fm_ExtraBold=800 — усиленный; fm_Heavy=900 — тяжелый);
lfItalic, lfUnderline, lfStrikeOut — ненулевое значение означает соответственно наклонный, перечеркнутый и подчеркнутый шрифт;
lfCharSet — набор символов (ANSI_CharSet=0; Default_CharSet=1; Symbol_CharSet=2; ShiftJis_CharSet=128; OEM_CharSet=255);
lfOutPrecision — точность представления шрифта; рекомендуется Out_TT_Prec (выбирает True Type и векторные шрифты, если есть несколько разновидностей одноименных шрифтов) или Out_TT_Only_Prec (только True Type);
lfClipPrecision — определяет точность отсечения надписи границами области прорисовки (Clip_Character_Precis, Clip_Embedded, Clip_Mask, Clip_TT_Always, Clip_Default_Precis — рекомендуется, Clip_LH_Angles, Clip_Stroke_Precis);
lfQuality — определяет качество прорисовки (Default_Quality, Draft_Quality, Proof_Quality);
lfPitchAndFamily — в четырех младших разрядах указывается тип шрифта, в четырех старших — его семейство;
lfFaceName — имя гарнитуры шрифта.
На рис. 2 показан пример вывода наклонными шрифтами, созданными функцией CreateFontIndirect (CreateFont.dpr).
Рис. 2. Использование наклонных шрифтов
Как реализован этот пример, показано в листинге 6.
Сокращение времени загрузки
В реальном проекте со множеством форм между обращениями к Initialize и Run обычно расположены многочисленные вызовы метода CreateForm, с помощью которого создаются используемые в проекте формы. Каждый вызов этого метода увеличивает время загрузки приложения. В начальный момент на экране будет видно только одно окно главной формы приложения (оно создается первым обращением к CreateForm), а остальные объекты-окна можно создавать в ходе работы программы перед визуализацией соответствующего окна.
По умолчанию в переключателе Auto create forms (вызывается с помощью опции Project|Options среды Delphi) на закладке Preference окна Tools|Environment установлен флажок, что заставляет Delphi помещать любую новую форму в список Auto-create forms и формировать соответствующий оператор обращения к CreateForm в файле проекта. Если очистить этот переключатель перед началом работы над проектом или перенести ненужные формы в список Available forms окна Project|Options, можно существенно (иногда — в десятки раз) сократить время загрузки приложения.
Вид экрана до появления главного окна
В приводимом ниже листинге 3 (пример заимствован из справочной системы Delphi) в программе создается 5 окон. В форме Form5 имеется индикатор ProgressBar1, с помощью которого визуализируется процесс загрузки программы, точнее — создания остальных окон.
Включение в библиотеку форм
Несмотря на то что DLL не имеет собственной формы, с ее помощью можно вызывать формы из связанных с библиотекой модулей. Для этого в библиотеке используется ссылка uses на связанные модули-формы и объявляются экспортируемые из DLL подпрограммы, в которых реализуется вызов соответствующих форм.
В следующих примерах (TestDLLForm.dpr) иллюстрируется техника включения в DLL формы и использования ее в вызывающей программе (листинги 8, 9 и 10).
Вставка поясняющих комментариев к именам форм
Обратите внимание на предложение uses в тексте проекта. При перечислении нестандартного модуля Uni1 с помощью зарезервированного слова in указывается имя файла с текстом модуля ('Unit1.pas'), а следующий за именем комментарий {Form1} именует объект-окно, создаваемый модулем Unit1. Такого рода объявления Delphi автоматически создает для каждого включенного в проект модуля. Delphi считает входящими в проект только перечисленные в этом предложении модули, и их алфавитный список появляется при выборе опции View | Units; а при выборе View | Forms показывается список всех перечисленных в комментариях объектов.
Последнее обстоятельство можно использовать для вставки краткого комментария, указывающего назначение формы: при разработке сложного проекта в него обычно включается много десятков, а иногда и сотен форм, и подобная возможность может оказаться совсем не лишней. В качестве примера на рис. 1 показана копия экрана, отображающего файл проекта с комментариями, и соответствующее окно.
Рис.1. Файл проекта с комментариями и связанное с ним окно View Form
Защита программы паролем
Как видно из примера, программист может поместить любой код до обращения к методу Application.Run. В частности, он может показать диалоговое окно с запросом пароля и блокировать вызов Application.Run, если введенный пользователем пароль неверен. В следующем примере (InputQuery и главная форма MainForm. Форма InputQuery создается при обращении к одноименной функции, определенной в модуле Dialogs. Она представляет собой небольшое диалоговое окно с однострочным редактором TEdit и двумя кнопками — ОК и Cancel. В окне пользователь должен ввести пароль (Delphi) и нажать Enter.