Статьи по Делфи
Меню сайта


Категории каталога
Мои статьи [2]
Функции и процедуры Win Api [20]
Работа с мышью [10]
Реестр и Делфи [11]
Работа с файлами [38]
Делфи и Хакер [10]
Инсталлятор собственными руками [6]
Хитрости в делфи [3]
Работа с системой [19]


Форма входа


Поиск по каталогу


Друзья сайта


Наш опрос
Понравились ли вам треки
Всего ответов: 156


Приветствую Вас, Гость · RSS 2020-09-19, 9:31 PM
Начало » Статьи » Хитрости в делфи

Delphi: заметки программиста. Часть 2
Печать в Delphi

Объект Printer автоматически создается в случае, если в программе указана ссылка на модуль Printers. Этот объект предоставляет программисту все необходимое для того, чтобы научить приложение выводить данные на один из подключенных к компьютеру принтеров.

Вывод на принтер в Windows ничем не отличается от вывода на экран: в распоряжение программиста предоставляется свойство Canvas объекта Printer, содержащее набор чертежных инструментов, и методы, свойственные классу TCanvas. Размер листа бумаги в пикселах определяют свойства Height и Width, а набор принтерных шрифтов – свойство Fonts.
Печать текста

Существует множество способов печати текста на принтере. Прежде всего следует назвать глобальную процедуру AssignPrn (она определена в модуле Printers), позволяющую использовать принтер как текстовый файл и печатать текстовые строки с помощью процедуры WriteLn. В листинге 1 (PrintText.dpr) приведен полный текст модуля, на форме которого расположены многострочный текстовый редактор Memo1 и четыре кнопки: для выбора текстового файла и ввода его содержимого в редактор, для выбора нужного шрифта отображения/печати документа, для инициации процесса печати и для завершения работы программы.
Листинг 1
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);
private
{ Private declarations }
public
{ Public declarations }
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, листинг 2):
Листинг 2
procedure TForm1.Button2Click(Sender: TObject);
// Печать содержимого редактора c помощью свойства Printer.Canvas
var
Y,dY,X,k: Integer;
S: String;
begin
if Memo1.Lines.Count=0 then Exit;
Screen.Cursor := crHourGlass;
with Printer do
begin
BeginDoc;
with Canvas do
begin
Font := Memo1.Font;
dY := TextHeight('1'); // Определяем высоту строки
Y := 3*dY; // Отступ от верхнего края листа
X := PageWidth div 15; // Отступ от левого края
for k := 0 to Memo1.Lines.Count-1 do
begin
// Выводим очередную строку
TextOut(X,Y,Memo1.Lines[k]);
// Смещаемся на следующую строку листа
inc(Y,dY);
if PageHeight-Y<2*dY then // Нижний край листа?
begin // Да
NewPage; // Переход на новый лист
// Выводим номер страницы посередине листа:
S := '- '+IntToStr(PageNumber)+' -';
TextOut((PageWidth-TextWidth(S)) div 2, dy, S);
// и отчеркиваем его от текста:
MoveTo(X, 3*dy div 2);
LineTo(PageWidth-X, 9*dy div 4);
// Ордината первой строки:
Y := 3*dY
end; // if PageHeight-Y<2*dY
end; // for k := 0 to Memo1.Lines.Count-1 do
end; // with Canvas do
EndDoc;
end; // with Printer do
Screen.Cursor := crDefault;
end;

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

Во многих случаях для печати документа и внесения в него элементарных средств форматирования (печать общего заголовка, заголовка на каждой странице, номеров страниц и т.п.) проще использовать специальные компоненты, расположенные на странице QReport палитры компонентов Delphi. Эти компоненты разработаны для создания отчетов по базам данных, но могут с успехом использоваться и для печати обычных документов (PrintText.dpr).

Наконец, очень хороших результатов можно достичь, используя специализированные средства просмотра/печати документов, как, например, текстовый процессор MS Word.
Печать изображений

Печать изображений может показаться очень сложным делом, однако свойство Printer.Canvas содержит метод:
procedure StretchDraw(const Rect: TRect; Graphic: TGraphic );

который легко справляется с этой задачей. При обращении к нему в качестве первого параметра указывается прямоугольная область, отводимая на поверхности листа для распечатки изображения, а в качестве второго — объект класса TGraphic, в котором хранится изображение, например:
with Printer do
begin
BeginDoc;
Canvas.StretchDraw(Canvas.ClipRect, Image1.Picture.Graphic);
EndDoc;
end;
Отображение файла в память

Для работы с файлом динамической подкачки страниц виртуальной памяти в 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).

В листинге 3 приводится текст модуля (FileInMemory.dpr), который создает окно.
Листинг 3
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);
private
{ Private declarations }
public
{ Public declarations }
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
// Закрываем файл
CloseHandle(HFile)
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.

Проект создает дисковый файл, состоящий из 100 тыс. случайных вещественных чисел (можно выбрать другую длину файла, если изменить значение редактора Длина массива). Файл с именем test.dat создается путем отображения файла в память (кнопка Память) и традиционным способом (кнопка Файл). В обоих случаях показывается время счета. Чем больше частота процессора и объем свободной оперативной памяти, тем больше будет разница во времени (листинг 3).
О таймере

Компонент Timer (таймер) служит для отсчета интервалов реального времени. Его свойство Interval определяет интервал временив миллисекундах , который должен пройти от включения таймера до наступления события OnTimer. Таймер включается при установке значения True в его свойство Enabled. Единожды включенный таймер все время будет возбуждать события OnTimer до тех пор, пока его свойство Enabled не примет значения False.

Следует учесть, что в силу специфики реализации стандартного аппаратного таймера IBM-совместимого компьютера минимальный реально достижимый интервал отсчета времени не может быть меньше 55 мс (этот интервал называется тиком), более того, любой интервал времени, отсчитываемый с помощью таймера, всегда кратен 55 мс. Чтобы убедиться в этом, проведите эксперимент, в котором подсчитывается среднее время между двумя срабатываниями таймера (Timer.dpr):
Начните новый проект с пустой формой и положите на нее компонент TTimer.
Установите в свойство Enabled таймера значение False.
Напишите такой модуль главной формы (листинг 4):
Листинг 4
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
{ Private declarations }
BegTime: TDateTime; // Начальное время цикла
Counter: Integer; // Счетчик цикла
public
{ Public declarations }
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) иллюстрируется использование мультимедийного таймера (листинг 5).
Листинг 5
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);
private
{ Private declarations }
public
{ Public declarations }
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.

Категория: Хитрости в делфи | Добавил: Admin (2006-12-18)
Просмотров: 4819 | Комментарии: 2 | Рейтинг: 5.0 |

Всего комментариев: 1
0
1 Strelok   [Материал]
молодец,

Имя *:
Email *:
Код *: