Объект TThred
Листинг 14.1. Объект TThred
TThread = class private
FHandle: THandle; FThreadID: THandle;
FTerminated: Boolean; FSuspended: Boolean; FFreeOnTerminate: Boolean; FFinished: Boolean; FReturnValue: Integer;
FOnTerminate: TNotifyEvent;
FMethod: TThreadMethod;
FSynchronizeException: TObject; procedure CallOnTerminate; function GetPriority: TThreadPriority; procedure SetPriority (Value: TThreadPriority);
procedure SetSuspended (Value: Boolean);
protected procedure DoTerminate; virtual;
procedure Execute; virtual; abstract;
procedure Synchronize(Method: TThreadMethod);
property ReturnValue: Integer read FReturnValue write FReturnValue; property Terminated: Boolean read FTerminated; public
constructor Greate(GreateSuspended: Boolean);
destructor Destroy; override; procedure Resume; procedure Suspend; procedure Terminate;
function WaitFor: LongWord;
property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;
property Handle: THandle read FHandle;
property Priority: TThreadPriority read GetPriority write SetPriority;
property Suspended: Boolean read FSuspended write SetSuspended; property ThreadID: THandle read FThreadID;
property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate; end;
Из вышеприведенного листинга можно определить, что объект TThread является прямым потомком объекта TObject, следовательно, он не является визуальным компонентом. Его метод Execute — абстрактный. Поэтому сам объект TThread тоже является абстрактным, и вы не сможете создать экземпляр этого класса. Таким образом, вам придется создавать классы — потомки данного класса для работы с потоками.
Для создания потомка класса TThread выберите в главном меню Kylix команду File/New, затем в появившемся окне (Рисунок 14.1) выберите пиктограмму Thread Object.
Заготовка для ноиого объукта потока
Листинг 14.2. Заготовка для ноиого объукта потока
unit Unit1; interface
uses Classes;
type
TMyThread = class(TThread) private
{ Private declarations }
protected
procedure Execute; override;
end;
implementation
{ Важно: Методы и свойства объектов CLX могут быть использованы только
с помощью вызова метода синхронизации, например
Synchronize(UpdateCaption);
и UpdateCaption должно выглядеть следующем образом:
procedure TMyThzead.UpdateCaption;
begin
Form1.Caption := 'Обновлено внутри потока'; end; }
{ TMyThread }
procedure TMyThread.Execute; begin
{ Разместите код потока здесь } end;
end.
В автоматически сгенерированном файле, модуля вы можете:
инициализировать поток;
заполнить метод Execute объекта потока, разместив там функции и процедуры;
написать код гарантированного разрушения потока (например, строку FreeOnTerminate: =True;).
Проверка прекращения работы потока
Листинг 14.3.Проверка прекращения работы потока
procedure TMyThread.Execute; begin
while not Terminated do
{выполнять какие-либо задачи}; end;
Пример создания многопоточного приложения в Kylix
Теперь настало время создания простого многопоточного приложения.
Мы создадим приложение, которое состоит из трех потоков (главного CLX-потока и двух потоков — потомков класса TThread). Для начала запустим Kylix и выберем в его главном меню пункт File/New Application, после чего разместим на главной форме приложения Form1 поле для редактирования Edit1, индикатор хода выполнения работы ProgressBar1 и системный таймер Timer1. В результате должна получиться форма, похожая на представленную на Рисунок 14.2.
Теперь добавим новый объект потока через пункт главного меню Kylix File/New/Thread Object. Введем имя для нового потомка класса TThread, например TMyThread1. Kylix автоматически добавит модуль Unit2 в наше приложение. В описание объекта TMyThread1 добавим раздел public, в котором опишем глобальную переменную count.
Модуль первого потока
Листинг 14.4.Модуль первого потока
unit Unit2; interface
uses Classes;
type TMyThread1 = class(TThread)
private
{ Private declarations } protected procedure Execute; override;
public
count : integer; // Добавили переменную Count end;
implementation { TMyThread1 }
procedure TMyThread1.Execute; begin
while true do
begin
count:=random (maxint);
end; end;
end.
Теперь создадим второй объект потока, который должен заполнять индикатор хода работы ProgressBar1.
По аналогии с первым объектом потока при помощи главного меню Kylix создадим объект потока с именем TMyThread2. Во вновь добавленный модуль Unit3 включим глобальную переменную prcount, после чего в процедуре Execute объекта TMyThread2 запишем код, представленный в листинге 14.5, также зациклив его.
Модуль второго потока
Листинг 14.5.Модуль второго потока
unit Unit3;
interface
uses Classes;
type
TMyThread2 = class(TThread) private
{ Private declarations }
protected
procedure Execute; override;
public
prcotmt:integer; // Добавили переменную prcount end;
implementation
{ TMyThread2 }
procedure TMyThread2.Execute; begin
while true do begin
prcount;=prcount+1; if prcount>
100 then prcount:=0; end; end;
end.
Теперь сохраним наш проект и модули под теми именами, которые нам предложит Kylix (Project1, Unit1, Unit2, Unit3).
Добавим в модуле Unit1 в описание класса формы в разделе private объекты потоков Thread1 — потомок класса TMyThread1 и Thread2 — потомок класса TMyThread2.
Далее дважды щелкнем на любом свободном пространстве формы Form1. При этом откроется "заготовка" для метода создания формы FormCreate. В обработчике FormCreate напишем код, представленный в листинге 14.6.
Здесь мы создаем объект потока с использованием конструктора Сreate и устанавливаем приоритеты потоков (tpLowest и tpNormal).
Запишем в блоке uses модуля Unit1 используемые модули Unit2 и Unit3.
Нам осталось отразить результаты вычислений, производимых потоками на форме. Для этого создадим обработчик события OnTimer, дважды щелкнув на объекте Timer1. Запишем в обработчик события OnTimer код, представленный в листинге 14.6.
Главный модуль многопоточного приложения
Листинг 14.6. Главный модуль многопоточного приложения
unit Unit1;
interface
uses
SysUtils, Types, Classes, Variants, QGraphics, QControls, QForms, QDialogs, QTypes, QExtCtrls,
QComCtrls, QStdCtrls, unit2, unit3;
type
TForm1 = class (TForm)
Edit1: TEdit;
ProgressBar1: TProgressBar;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
thread1:tmythread1;
thread2:tmythread2;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation {$R *.xfm}
procedure TForm1.FormCreate(Sender: TObjеct);
begin thread1:=tmythread1.create(false);
thread2:=tmythread2.create(false);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
edit1.Text:=inttostr(thread1.count);
progressbar1.Position:=thread2.prcount; end;
end.
Наше первое приложение, которое использует потоки, готово. Теперь, если мы запустим приложение с помощью главного меню Kylix: Run/Run, то сможем увидеть, как два созданных нами потока успешно работают (Рисунок 14.3).
Использование синхронизации
Листинг 14.7. Использование синхронизации
procedure TMyThread.PushTheButton; begin
Button1.Click; end;
procedure TMyThread.Execute; begin
. . . Synchronize(PushTheButton);
. . . end;
Метод синхронизации защитит ваше приложение от ситуации "гонки".
Ситуация "гонки" возникает, когда два потока или более пытаются получить доступ к общему ресурсу и изменить его состояние.
Примечание
Метод синхронизации не может использоваться в консольных приложениях Для защиты одновременного доступа к CLX-объектам в консольных приложениях вы должны использовать другие методы, такие как критические секции
В некоторых случаях вы можете обходиться без метода синхронизации, например, если:
Примечание
Когда вы используете компоненты доступа к данным, вы должны применять синхронизацию в том случае, если устанавливаете связь между компонентами доступа к данным (например, свойство DataSet в объекте DataSource). Но вы можете не прибегать к синхронизации при обращении к данным таблицы базы данных
вместо объектов списков (List), которые не являются потокобезопасными, вы можете использовать потокобезопасный потомок объекта TList — TThreadList.
Объявление локальных переменных в потоке класса TThread
Листинг 14.8.Объявление локальных переменных в потоке класса TThread
type
TMyThread1 = class(TThread)
private
i, j,k,l: integer; // локальные переменные потока типа integer a,b,c: char; // локальные переменные потока типа char
. . . end;
Эффективность объявления локальных переменных в потомке класса TThread очевидна, т. к. доступ к любому полю объекта осуществляется очень быстро (примерно в 10—11 раз быстрее, чем при использовании описания threadvar).
Третий способ хранения локальных переменных (с помощью threadvar) служит для создания в потоках локальных копий глобальных переменных.
Глобальные переменные могут использоваться всеми потоками приложения, при этом может возникнуть ситуация, когда при изменении глобальной переменной одним потоком происходит изменение этой же глобальной переменной другим потоком. В результате значение, установленное первым потоком, бесследно исчезает, приводя к нежелательным последствиям (в данном примере произойдет обработка ошибочного значения глобальной переменной первым потоком). Для исключения такой ситуации Kylix предлагает средство хранения локальных данных потоков (thread-local storage). С помощью данного средства можно создавать локальные копии глобальных переменных для любого потока. При этом требуется всего лишь заменить одно слово var при объявлении глобальных переменных на слово threadvar:
threadvar
х : integer;
Итак, прочитав эту главу, вы узнали некоторые приемы работы с потоками и научились создавать многопоточные приложения. Это вам особенно пригодится при переносе приложений из среды Windows в Linux.
Модуль Ffactlin
Листинг 15.1.Модуль Ffactlin
unit Ffactlin;
interface
uses
SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs,QExtCtrls, QDBCtrls, QStdCtrls, DB, DBClient, QGrids, QDBGrids, QButtons;
type
TForm1 = class (TForm)
Panel1: TPanel;
DBImage1: TDBImage;
DBText1: TDBText;
ClientDataSet1: TClientDataSet;
DataSource1: TDataSource;
Panel2: TPanel;
Label1: TLabel;
DBText2: TDBText;
Panel3: TPanel;
Panel4: TPanel;
DBGrid1: TDBGrid;
BitBtn1: TBitBtn;
DBMemo1: TDBMemo;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.xfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
// Указываем файл таблицы базы данных ClientDataSet1.LoadFromFile('biolife.cds');
end;
end.
Внешний вид формы представлен на Рисунок 15.4.
Содержание типичного файла базы данных
Листинг 18.1. Содержание типичного файла базы данных
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<DATAPACKET Version="2.0">
<METADATA>
<FIELDS>
<FIELD attrname="ID" fieldtype="i4" readonly="true" SUBTYPE="Autoxnc" />
<FIELD attrname="Name" fieldtype="string" WIDTH="50" />
</FIELDS>
<PARAMS DEFAULT_ORDER="" AUTOINCVALUE="1" />
</ METADATA>
<ROWDATA />
</DATAPACKET>
В первой строке содержится заголовок:
<?xml version = "1.0" encoding="UTF-8" standalone="yes" ?>
Вторая строка содержит корневой тэг документа:
<DATAPACKET Version="2.0">
Всю остальную часть файла можно разделить на две части:
непосредственно записи.
Метаданные хранятся в тэге METADATA, а записи — в тэге ROW DATA. После создания новой таблицы базы данных тэг ROWDATA будет пустым.
Внутри тэга METADATA расположены описания полей таблицы (тэг FIELDS и вложенные в него тэги) и другая служебная информация (порядок сортировки по умолчанию, начальное значение автоматически увеличивающегося счетчика).
Теперь давайте запустим наше приложение, вставим в таблицу новую запись, закроем приложение и посмотрим, как изменился xml-файл.
Мы видим, что изменился тэг PARAMS:
<PARAMS CHANGE_LOG="1 0 4" AUTOINCVALUE="2" DEFAULT_ORDER="" />
Кроме того, тэг ROWDATA тоже изменился:
<ROWDATA>
<ROW RowState="4" ID="1" Name="e?AI?" />
</ROWDATA>
Если вы внимательно посмотрите на изменения, то увидите, что внутри таблицы ведется журнал операций. Это дает возможность сделать отмену произведенных действий.
Если вам не нужно, чтобы этот журнал велся, в режиме выполнения программы установите свойство LogChanges в false.
Рассмотрим установку отношений таблиц "главный-подчиненный" (master-detail).
Новым способом организации отношения master-detail в Kylix стало использование вложенных наборов данных. Предположим, что нам нужно получить информацию о покупках, сделанных клиентом.
Сначала очистим набор данных Сlients. Для этого щелкнем правой кнопкой мыши на компоненте Сlients и в выпадающем меню выберем пункт очистки данных Clear Data.
Введем дополнительное описание полей Оrders типа ftDataSet. Данный тип поля предназначен для хранения внутри себя наборов данных. Список полей вложенного набора данных устанавливается в свойстве ChildDefs. Определим в ChildDefs следующие поля (табл. 18.2).
Содержимое файла базы данных
Листинг 18.2. Содержимое файла базы данных
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
- <DATAPACKET Version="2.0">
- <METADATA>
- <FIELDS>
<FIELD attrname="ID" fieldtype="i4" readonly="true" SUBTYPE="Autoinc" />
<FIELD attrname="Name" fieldtype="string" WIDTH="50" />
- <FIELD attrname="0rders" fieldtype="nested">
- <FIELDS>
<FIELD attrname="ID" fieldtype="i4" SUBTYPE="Autoinc" />
<FIELD attrname="OrderName" fieldtype="string" WIDTH="20" />
<FIELD attrname="Price" fieldtype="r8" SUBTYPE="Money" />
</FIELDS>
<PARAMS AUTOINCVALUE="1" />
</FIELD>
</FIELDS>
<PARAMS DEFAULT_ORDER="" AUTOINCVALUE="1" />
</METADATA>
<ROWDATA />
</DATAPACKET>
Нетрудно убедиться в том, что поле Оrders содержит в себе описание подчиненной таблицы. При этом в сетке данных DBGrid1, расположенной на главной форме, появился новый столбец Оrders. При запуске приложения и попытке редактирования этого поля автоматически открывается форма для редактирования вложенного набора данных.
Другим способом организации взаимодействия с вложенным набором данных является размещение в модуле данных дополнительного клиентского набора данных ClientDataSet. Поместим в модуль данных еще один компонент типа TClientDataSet, установив его имя orders. Свойству DataSetField компонента Orders из раскрывающегося списка присвоим значение ClientsOrders. Теперь, пользуясь компонентом Оrders, можно просматривать и редактировать вложенный набор данных.
Достоинства вышеописанного метода в том, что вся база будет храниться в одном xml-файле, недостаток — в том, что нельзя разорвать связь главный-подчиненный и, как следствие, одновременно посмотреть все записи о заказах вне зависимости от выбранного клиента.
Модуль заготовки нового класса
Листинг 19.1.Модуль заготовки нового класса
unit QMyButton;
interface
uses
SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs, QStdCtrls;
type
TMyButton = class(TButton) private
{ Private declarations } protected
{ Protected declarations } public
{ Public declarations } published
{ Published declarations } end; procedure Register;
implementation
procedure Register; begin
RegisterComponents('Samples', [TMyButton]);
end;
end.
Итак, заготовка для нового компонента готова. Она не содержит никаких новых свойств, методов и событий для нового компонента. Нужно отметить, что данный компонент уже имеет все свойства, события и методы, которые определены для класса TButton.
Рассмотрим теперь основные типы методов компонента.
Все методы могут быть одного из нескольких типов: статические (static), виртуальные (virtual), динамические (dynamic) или методы-сообщения (message). По умолчанию методу присваивается статический тип.
Пример создания свойств нового компонента
Листинг 19.2. Пример создания свойств нового компонента
MyButton = class(TButton) private
{ Private declarations }
FMyCount: Integer;
FStirngOfText: String; protected
{ Protected declarations } public
{ Public declarations } published
{ Published declarations }
property MyCount: Integer read FMyCouht write FMyCount;
property StringOfText: String read FStringOfText write FStringOfText; end;
В этом листинге мы задаем два новых поля для компонента TMyButton и определяем два новых свойства компонента, одно типа Integer, другое — String. Для простоты значения данных свойств считываются и записываются в одноименные поля. Задание этих свойств будет гарантировать доступ к ним в окне инспектора объектов (благодаря описанию свойств в разделе published) и не потребует написания дополнительных методов для доступа к свойствам.
Примечание
По взаимной договоренности принято названия полей начинать с буквы f (field — "поле"), а названия компонентов и любых объектов — с буквы t (type — "тип").
Создание перечисляемых свойств компонента
К свойствам перечисляемого типа относятся такие свойства компонента, которые при их редактировании в окне инспектора объектов вызывают раскрывающийся список, содержащий возможные значения данного свойства.К числу таких свойств относятся Align, BorderStyle, Color и др. Для того чтобы самостоятельно добавить в новый компонент перечисляемое свойство, необходимо сначала определить новый перечисляемый тип, например:
TMyEnumType = (eFirst, eSecond, eThird);
После этого нужно определить поле компонента, которое будет хранить значение данного перечисляемого типа, затем определить свойство. Пример добавления перечисляемого типа в новый компонент TMyButton приведен в листинге 19.3.
Создание свойств перечиляемого типа
Листинг 19.3.Создание свойств перечиляемого типа
unit QMyButton; interface
uses
SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs, QStdCtrls;
type
TMyEnumType = (eFirst, eSecond, eThird);
type
TMyButton = class(TButton) private
{ Private declarations }
FMyEnum: TMyEnumType; protected
{ Protected declarations } public
{ Public declarations } published
{ Published declarations }
property MyEnumProp: TMyEnumType read FMyEnum write FMyEnum; end;
procedure Register; implementation
procedure Register; begin
RegisterComponents{'Samples', [TMyButton]);
end;
end.
Таким образом, в окне инспектора объектов при изменении свойства MyEnumProp будет выдан раскрывающийся список, содержащий три пункта:
eFirst, eSecond и eThird (рис 19.3).
Создание свойствамножества unit QMyButton;
Листинг 19.4. Создание свойства-множества
unit QMyButton;
interface
uses
SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs, QStdCtrls;
type
TMyEnumType = (eFirst, eSecond, eThird);
TMySetTypeFirst = {poFirst, poSecond, poThird);
TMySetType = set of TMySetTypeFirst;
type
TMyButton = class(TButton) private
{ Private declarations }
FMyEnum: TMyEnumType;
FMyOptions: TMySetType; protected
{ Protected declarations } public
{ Public declarations } published
{ Published declarations }
property MyEnumProp: TMyEnumType read ЕМуЕnum write FMyEnum;
property MyOptions: TMySetType read FMyOptions write FMyOptions; end;
procedure Register; implementation
procedure Register; begin
RegisterComponents('Samples', [TMyButton]);
end;
end.
Для удобства мы не стали исключать определение перечисляемого свойства в компоненте TMyButton.
В результате в окне инспектора объектов свойство-множество будет отображаться как показано на Рисунок 19 4
Создание потомка TPersistenttype
Листинг 19.5. Создание потомка TPersistenttype
TMyObject = class (TPersistent) private
{ Private declarations }
FProperty1:Real;
FProperty2:Char; protected
{ Protected declarations } public
{ Public declarations }
procedure Assign (Source: TPersistent);
published
{ Published declarations }
property Property1: Real read FProperty1 write FProperty1;
property Property2: Char read FProperty2 write FProperty2; end;
В качестве предка нового класса может выступать не только класс TPersistent, но и любой его потомок. В вышеприведенном листинге мы создаем новый класс TMyObject, в котором присутствуют два простых свойства — Property1 и Property2. Кроме того, в новый объект включена процедура Assign. Данная процедура необходима для обеспечения правильного доступа к свойству нашего будущего компонента TMyButton. Ниже приведен листинг 19.6, в котором мы добавляем в компонент TMyButton новое свойство-объект.
Добавление свойстваобъекта в компонент TMyButtontype
Листинг 19.6. Добавление свойства-объекта в компонент TMyButtontype
TMyButton = class(TButton) private
{ Private declarations }
FMyObject:TMyObject;
procedure SetMyObject (Value: TMyObject);
protected
{ Protected declarations } public
{ Public declarations }
constructor Create (AOwner: TComponent);
override;
destructor Destroy; override; published
{ Published declarations }
property MyObject: TMyObject read FMyObject write SetMyObject; end;
Как вы можете видеть, мы добавляем в код нового компонента конструктор и деструктор объекта.
Теперь осталось дописать конструктор и деструктор для компонента TMyButton, в которых необходимо, соответственно, создать и уничтожить, кроме компонента TmyButton, объект TMyObject. Также нужно написать код метода SetMyObject, который будет помещать новое значение в свойства объекта TMyObject. Ну и, конечно, написать код метода Assign для объекта TMyObject. Полная версия кода представлена в листинге 19.7. Здесь, помимо ранее описанного, приводится код ко всем этим методам.
Полный листинг для нового компонента
Листинг 19.7. Полный листинг для нового компонента
unit QMyButton;
interface
uses
SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs, QStdCtrls;
type
TMyObject = class (TPersistent) private
{ Private declarations }
FProperty1:Real;
FProperty2:Char; protected
{ Protected declarations }
public
{ Public declarations }
procedure Assign (Source: TPersistent);
published
{ Published declarations }
property Property1: Real read FProperty1 writhe FProperty1;
property Property2: Char read FProperty2 write FProperty2; end;
type
TMyButton = class(TButton) private
{ Private declarations }
FMyObject:TMyObject;
procedure SetMyObject (Value: TMyObject);
protected
{ Protected declarations } public
{ Public declarations }
constructor Create (AOwner: TComponent);
override; destructor Destroy; override; published
{ Published declarations }
property MyObject: TMyObject read FMyObject write SetMyObject; end; procedure Register;
implementation
procedure Register; begin
RegisterComponents('Samples', [TMyButton]);
end;
procedure TMyButton.SetMyObject(Value: TMyObject);
begin
if Assigned(Value) then FMyObject.Assign(Value);
end;
constructor TMyButton.Create(AOwner: TComponent);
begin
inherited Create (AOwner);
FMyObject:=TMyObject.Create; end;
destructor TMyButton.Destroy; begin
FMyObject.Free;
inherited Destroy; end;
procedure TMyObject.Assign(Source: TPersistent);
begin if Source is TMyObject then begin
FProperty1:=TMyObject(Source).Property1; FProperty2: = TMyObject (Source) .Property2; inherited Assign (Source);
end; end;
end.
Пример компонента TWeek
Листинг 19.8.Пример компонента TWeek
unit Week; interface
uses
SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs;
type
TWeek = class(TComponent) private { Private declarations }
function GetMonthName (const AIndex: Integer): String;
function GetMonthNurnber (const AMonthName: String) : Integer; protected
{ Protected declarations } public
{ Public declarations }
property MonthName[const AIndex: Integer]: String read GetMonthName; default;
property MonthNumber[const AMonthName: String]: Integer read GetMonthNumber; published
{ Published declarations } end; procedure Register;
implementation
const
MonthNames: array[l..12] of String[8],*('Январь','Февраль','Март', 'Апрель','Май','Июнь','Июль','Август','Сентябрь','Октябрь','Ноябрь', 'Декабрь');
function TWeek.GetMonthName(const AIndex: Integer): String; begin
if (AIndex<=0) or (AIndex>
12) then raise Exception.Create('Номер месяца должен быть числом от 1 до 12')
else Result;=MonthNames [Alndex3]; end;
function TWeek.GetMonthNumber(const AMonthName: String): Integer; var
i:integer; begin
Result:=0;
for i:=l to 12 do begin
if Uppercase(AMonthName)=UpperCase(MonthNames[ i ] ) then Result:=i;
end; end;
procedure Register;
begin RegisterComponents('Samples', [ TWeek ] );
end;
end.
Рассмотрим вышеприведенный код более подробно. Как вы можете видеть, свойства типа массив объявляются вместе с индексами. Для свойства MonthName мы определили индекс AIndex, а для свойства MonthNumber — индекс AMonthName. Для доступа к свойствам такого типа необходимо использовать методы. Внутренние поля здесь не используются. Если свойство типа массив многомерно, то свойство-массив объявляется сразу с несколькими индексами. При вызове методов доступа к ним нужно передавать параметры в том же порядке, в каком вы их указали в свойстве.
Функция GetMonthName возвращает строку, содержащую имя месяца, соответствующего целому числу от 1 до 12, переданному в качестве параметра данной функции. В случае передачи функции числа, не принадлежащего данному диапазону, будет сгенерировано исключение командой raise (об исключениях читайте главу 9 книги).
Наконец, функция GetMonthNumber возвращает число от 1 до 12, которое соответствует названию месяца, переданного в качестве параметра в данную функцию. В случае если ни один месяц не соответствует названию, определенному массивом MonthNames, результатом выполнения данной функции будет ноль.
Таким образом, если поместить на форму экземпляр компонента TWeek с именем Week1, при выполнении строки
ShowMessage (Weekl.MonthName[5]);
будет выдано окно с сообщением Май (Рисунок 19.6).
Определение базового
Листинг 19.9. Определение базового класса TPropertyEditor
TPropertyEditor = class(TBasePropertyEditor, IProperty) private
FDesigner: IDesigner;
FPropList: PInstPropList;
FPropCount: Integer;
function GetPnvateDirectory: string; protected
procedure SetPropEntry(Index: Integer; AInstance: TPersistent;
APropInfo: PPropInfo);
override; protected function GetFloatValue: Extended;
function GetFloatValueAt (Index: Integer): Extended;
function GetInt64Value: Int64;
function GetInt64ValueAt(Index: Integer): Int64;
function GetMethodValue: TMethod;
function GetMethodValueAt(Index: Integer): TMethod; function GetOrdValue: Longint;
function GetOrdValueAt(Index: Integer): Longint;
function GetStrValue: string;
function GetStrValueAt(Index: Integer): string;
function GetVarValue: Variant;
function GetVarValueAt(Index: Integer): Variant;
function GetIntfValue: IInterface;
function GetIntfValueAt(Index: Integer): IInterface;
procedure Modified;
procedure SetFloatValue(Value: Extended);
procedure SetMethodValue(const Value: TMethod);
procedure SetInt64Value(Value: Int64);
procedure SetOrdValue(Value: Longint);
procedure SetStrValue(const Value: string);
procedure SetVarValue(const Value: Variant);
procedure SetIntfValue(const Value: IInterface);
protected { IProperty } function GetEditValue(out Value: string): Boolean;
function GetComponentValue: TComponent; virtual;
function HasInstance(Instance: TPersistent): Boolean; public
constructor Create(const ADesigner: IDesigner; APropCount: Integer)
override; destructor Destroy; override;
procedure Activate; virtual;
function AllEqual: Boolean; virtual; function AutoFill: Boolean; virtual;
procedure Edit; virtual;
function GetAttributes: TPrppertyAttributes; virtual;
function GetComponent (Index: Integer) : TPersistent;
function GetEditLimit: Integer; virtual; function GetName: string; virtual;
procedure GetProperties(Proc: TGetPropProc);
virtual;
function GetPropInfo: PPropInfo; virtual;
function GetPropType: PTypeInfo;
function GetValue: string; virtual;
function GetVisualValue: string;
procedure GetValues(Proc: TGetStrProc);
virtual;
procedure Initialize; override;
procedure Revert;
procedure SetValue(const Value: string);
virtual;
functipn ValueAvailable: Boolean;
property Designer: IDesigner read FDesigner;
property PrivateDirectory: string read, GetPrivateDirectory;
property PropCount: Integer read FPropCount;
property Value: string read GetValue write SetValue; end;
Методы данного класса, приведенные ниже, можно переопределять для изменения поведения редактора свойств.
Метод AllEqual вызывается при выборе на форме более одного компонента.
Метод Edit вызывается нажатием кнопки или двойным щелчком мыши на свойстве. Данный метод может вызвать диалоговое окно для редактирования свойства, например, как это происходит при редактировании свойства Font.
Метод Get Attributes возвращает множество значений типа TProperyAttributes, определяющих, каким образом свойство будет отображаться в окне инспектора объектов.
Метод GetComponent предназначен для определения компонента по его номеру (параметр Index) в случае, если на форме выбрано несколько компонентов одновременно.
Метод GetEditLimit возвращает максимальное число символов в строке, которые пользователь может ввести при редактировании свойства.Метод GetName предназначен для получения имени свойства. Данный метод целесообразно изменять только в том случае, когда имя свойства отличается от имени, отображаемого в окне инспектора объектов.
Метод GetPropType применяется для определения указателя на информацию о типе редактируемого свойства.Метод GetValue возвращает значение свойства в виде строки.
Метод Initialize вызывается при создании (инициализации) редактора свойств.
Метод SetValue применяется для установки значения свойства.
В большинстве случаев при создании нового редактора свойств нет необходимости использовать в качестве класса-предка базовый класс TPropertyEditor. Часто разработчик просто переделывает уже существующий для данного свойства редактор, переопределяй некоторые его методы.
Рассмотрим в качестве примера переработанное свойство Hint, которое применяется для показа всплывающей подсказки при задержании указателя мыши над компонентом. В стандартном случае такая подсказка имеет всего одну строку. Попробуем сделать свойство Hint многострочным.
показывает как создать
Листинг 19.10 показывает, как создать новый редактор свойств THintProperty. В качестве класса-предка для данного редактора свойств выберем редактор TStringproperty.
Создание нового редактора свойств
Листинг 19.10.Создание нового редактора свойств
THintProperty = class(TStringProperty) public
function GetAttributes: TPropertyAttributes; override;
function GetValue : String; override;
procedure Edit; override; end;
function THintProperty.GetAttributes: TPropertyAttributes; begin
Result := inherited GetAttributes + [paDialog, paReadOnly]; end;
function THintProperty.GetValue : string;
var i : Byte;
begin
result:=inherited GetValue;
for i:=l to Byte(result[0]) do
if result[i]<#32 then result[ i ]:='>
'; end;
procedure THintProperty.Edit ; var
HintEditDlg : TStrEditDlg; s : string; begin
HintEditDlg:=TStrEditDlg.Create(Application);
with HintEditDlg do try
Memo.MaxLength := 254; s:=GetStrValue+#0; Memo.Lines.SetText(@s[1]);
UpdateStatus(nil);
ActiveControl := Memo; If ShowModal = mrOk then begin s: =StrPas (Memo. Lines. GetText) ; if s[0]>
#2 then Dec(Byte(s[0]),2);
SetStrValue(s);
end; finally Free; end; end;
Рассмотрим методы нового класса:
функция GetValue заменяет символы перевода каретки (#10) и переход на новую строку (#13) на символ больше (>
).
Наконец, процедура Edit применяется для вызова диалога ввода строк всплывающей подсказки.
Для регистрации нового редактора нужно в интерфейсной части модуля поместить Объявление Процедуры Register. После чего В части Implementation модуля написать саму процедуру регистрации (листинг 19.11).
Процедура регистрации нового редактора свойствprocedure Register; begin
Листинг 19.11. Процедура регистрации нового редактора свойств
procedure Register; begin
RegisterPropertyEditor (TypeInfо(String), TControl, 'Hint',
THintProperty);
end;
Данная процедура позволяет привязать один и тот же редактор к свойствам, в зависимости от их названия или типа. Это определяется параметрами, которые передаются процедуре RegisterPropertyEditor. Первый параметр определяет тип свойства (в нашем примере это String). Второй параметр определяет класс компонента. Третий параметр позволяет указать имя свойства, четвертый — имя редактора свойства.
Для того чтобы установить новый редактор свойств в Kylix, необходимо выполнить следующие шаги:
1. Выбрать пункт меню Component/Install Components.
2. Нажать кнопку Add.
3. Указать имя подключаемого модуля.
После того как произойдет компиляция библиотеки, можно создать новую форму и разместить на ней какой-либо компонент, после чего установите у этого компонента свойство ShowHint в true и нажмите кнопку <...>
в свойстве Hint. Вы увидите на экране новый многострочный редактор для свойства Hint.
Команды Default и NoDefault
Итак, мы уже умеем создавать свойства произвольного типа для собственного компонента. Осталось заметить, что многим свойствам можно присвоить конкретное значение, которое будет установлено по умолчанию. Для этого достаточно присвоить это значение полю компонента, например:
FMyProperty := 10;
В результате этого при каждом добавлении компонента на форму двойство MyProperty будет принимать значение 10.
Команды Default и NoDefault применяются для ускорения процесса загрузки формы при работе приложения. Например,
property MyCount: Integer read FMyCount write FmyCount Default 0;
Данный код не присваивает значение 0 свойству MyCount. При выполнении вышеприведенного кода команда default 0 означает следующее: если при сохранении формы, содержащей компонент, значение свойства MyCount не — будет равно нулю, то новое значение сохранится в файле формы, иначе значение данного свойства не будет сохранено.
Примечание
Рекомендуется использовать команду Default во всех случаях, когда это возможно, если вы хотите создать быстро работающее приложение.
Команда NoDefault предназначена для нейтрализации команды Default. Команда применяется для отмены команды Default компонентов-предков. Пример использования команды NoDefault:
TSecondComponent = class (TMyButton)
published
property MyCount NoDefault 0;
Метод диспетчеризации события TControl = class (TComponent) private
Листинг 19.12. Метод диспетчеризации события TControl = class (TComponent) private
FOnClick: TNotifyEvent; protected
procedure Click; dynamic;
property OnClick: TNotifyEvent read FOnClick write FOnClick; end;
implementation
procedure TControl.Click; begin
if Assigned (FOnClick) then FOnClick (Self);
end;
Обратите внимание: свойство OnClick имеет тип TNotifyEvent, который представляет собой процедуру с одним параметром Sender типа TObject:
TNotifyEvent = procedure (Sender: TObject) of object;
Иначе говоря, когда происходит вызов метода Click, осуществляется проверка, ссылается ли FOnClick на какой-либо метод, и если ссылается, то происходит вызов этого метода.
Суть разобранного выше события в том, чтобы иметь представление, что создание событий подразумевает написание кода, определяющего само событие, а также свойства и метода диспетчеризации. Обработчик события пишется пользователем.
При возникновении какого-либо события операционная система передает приложению не только информацию о наступлении данного события, но и некоторую дополнительную информацию. В нашем примере при обработке события нажатия левой кнопки мыши в приложение поступает информация о координатах внутри клиентской части компонента, в которых произошло нажатие левой кнопки мыши. Например, код, приведенный в листинге 19.13, выводит при наступлении события нажатия левой кнопки мыши на форме координаты указателя мыши.
Пример обработки события нажатия кнопки мыши
Листинг 19.13.Пример обработки события нажатия кнопки мыши
procedure TForm1. FormMouseDown (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Canvas.TextOut(X, Y, '('+IntToStr(X) +', '+IntToStr(Y) + ')');
end;
Данный код мы вписали в обработчик события OnMouseDown формы Form1. Если теперь запустить программу на исполнение и пощелкать мышкой в разных частях формы, в тех местах формы, где происходит щелчок мыши, будут выведены координаты этих точек.
Пример создания нового события unit halfmin; interface
Листинг 19.14.Пример создания нового события unit halfmin; interface
uses
SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs;
type
TTimeEvent - procedure (Sender: TObject; TheTime: TDateTime) of object;
THalfMinute = class (TComponent)
private
FTimer: TTimer;
FOnHalfMinute: TTimeEvent;
FOldSecond, FSecond: Word; procedure FTimerTimer (Sender: TObject);
protected
procedure DoHalfMinute (TheTime: TDateTime);
dynamic; public
constructor Create (AOwner: TComponent);
override;
destructor Destroy; override; published
property OnHalfMinute: TTimeEvent read FOnHalfMinute write FOnHalf- Minute;
end;
implementation constructor THalfMinute.Create (AOwner: TComponent);
begin inherited Create (AOwner);
if not (csDesigning in ComponentState) then begin FTimer:=TTimer.Create(self);
FTimer.Enabled:= True; FTimer..Interval:= 500; FTimer.OnTimer:=FTimerTimer; end; end;
destructor THalfMinute.Destroy; begin
FTimer.Free;
inherited Destroy; end;
procedure THalfMinute.FTimerTimer (Sender: TObject);
var
DT: TDateTime; Temp: Word; begin
DT:=Now;
FOldSecond:=FSecond;
DecodeTime (DT,Temp,Temp,FSecond,Temp);
if FSecond <>
TOldSecond then
if ((FSecond=30) or (FSecond=0)) then
DoHalfMinute (DT);
end;
procedure THalfMinute.DoHalfMinute(TheTime: TDateTime);
begin
if Assigned (FOnHalfMinute) then FOnHalfMinute (Self, TheTime);
end;
end.
Для проверки работоспособности вышеприведенного кода вы можете добавить еще одну процедуру для регистрации нового компонента с именем ThalfMinute, предварительно расположив в interface часть программы строку:
procedure Register;
Ниже представлен код для регистрации компонента:
procedure Register; begin
RegisterComponents('Samples', [THalfMinute]}; end;
Для просмотра работоспособности нового компонента, после его регистрации создадим новую форму и разместим на ней новый компонент. Добавим на форму компонент Tedit, а затем — обработчик события OnHalfMinute для формы (листинг 19.15).
Обработчик нового события procedure TForm1 HalfMinutelHalfMinute(Sender TObject;
Листинг 19.15.Обработчик нового события
procedure TForm1.HalfMinutelHalfMinute(Sender: TObject;
TheTime: TDateTime);
begin
Edit1.Text:=('Время '+TimeToStr(TheTime));
Edit1.Refresh; end;
В результате работы данной программы в компоненте Edit1 каждые 30 секунд будет выводиться текущее время.
Использование директивы $IFDEF
Листинг 21.1.Использование директивы $IFDEF
// Если среда - Windows
[$IFDEF MSWINDOWS]
IniFile.LoadfromFile('с:\x.txt');
[$ENDIF]
// Если среда - Kylix
[$IFDEF LINUX]
IniFile.LoadfromFile('/home/name/x.txt') ;
[$ENDIF]
6. Найдите ссылки на пути ко всем файлам проекта:
• укажите правильные пути ко всем файлам Linux;
• смените ссылки на имена дисковых накопителей (например, С:\);
• в местах, где вы указали множество путей, смените разделитель путей с точки с запятой ";" на двоеточие ":";
• так как имена файлов являются в Linux чувствительными к регистру, убедитесь, что в приложении все имена файлов записаны правильно.
Примечание
Пути в Linux используют прямой слэш Т как разделитель (например, /usr/lib). Читатели, которые не знакомы с организацией файловой системы Linux, могут обратиться за краткой информацией в Приложение 3 данной книги.
7. Откомпилируйте проект в Linux. Просмотрите список ошибок, которые укажут, что еще необходимо сделать для того, чтобы ваше приложение работало в среде Linux.
Код для среды Windows
Листинг 21.2.Код для среды Windows
while p^ <>
#0 do
begin
if р^ in LeadBytes then
inc (p) ;
inc(p);
end;
Этот код можно преобразовать в платформонезависимый, как показано в листинге 21.3.
Платформонезависимый код
Листинг 21.3. Платформонезависимый код
while р^ <>
#0 do
begin
if р^ in LeadBytes then
p := StrNextChar(p)
else
inc(p);
end;
Если использование функций библиотек не приводит к работающему решению, можно попробовать изолировать специфичный код в блоки $IFDEF. Однако постарайтесь ограничить число таких блоков.
Неправильная работа директивы $IFDEF
Листинг 21.4.Неправильная работа директивы $IFDEF
{$IFDEF WIN32}
{32-битный код Windows размещаем здесь}
{$ELSE}
{16-битный код Windows находится здесь} //!! По ошибке Linux может
// попробовать выполнить этот код '!!
{$ENDIF}
Обработчик события
Листинг 21.5.Обработчик события AfterPost
procedure TForm1.ClientDataSetlAfterPost(DataSet: TDataSet);
begin
with DataSet as TClientDataSet do
ApplyUpdates(1);
end;
модуля справочных систем CLX и VCL
справочных систем CLX и VCL
Ниже приведен листинг файла /kylix/source/clx/HelpIntfs.pas, который обеспечивает необходимые интерфейсы файла справки, а также менеджер файлов.
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
{ }
{ Kylix и Delphi кросс-платформенная библиотека визуальных компонентов }
{ }
{ Copyright (с) 2000, 2001 Borland Software Corporation }
{ }
{ Этот файл может распространяться и/или модифицироваться в соответствии с условиями GNU General Public License (GPL) версии 2 }
{ http://www.borland.com/kylix/gpl.html. }
{ }
{ Файл лицензии license.txt прилагается к составу данного программного обеспечения. }
{ }
{************************************************************************}
unit Helplntfs;
{***********************************************************************}
{ }
{ Этот модуль является главным для различных справочных систем VCL/CLX }
{ TApplication содержит указатель на интерфейс IHelpSystem, через }
{ который обеспечиваются вызовы менеджера помощи. Менеджер помощи }
{ содержит список программ, обеспечивающих показ файлов справки, и }
{ реализует поддержку интерфейса ICustomHelpViewer. Программы для }
{ просмотра файлов справки взаимодействуют с менеджером помощи через }
{ интерфейс IHelpManager. }
{ }
{ Такой же механизм применяется при разработке пакетов, которые }
{ интегрируются в систему помощи IDE; вызов HelpIntfs.RegisterViewer( ) }
{ внутри процедуры Register() вызовет регистрацию просмотрщика. }
{ }
{*********************************************************************}
interface
uses SysUtils, Classes;
type
{ IHelpSelector. IHelpSelector используется системой помощи для того, чтобы узнать у приложения, какие ключевые слова оно поддерживает. }
IHelpSelector - interface(IInterface)
['{B0FC9358-5F0E-11D3-A3B9-00C04F79AD3A}']
function SelectKeyword(Keywords: TStrings) : Integer;
function TableOfContents(Contents: TStrings): Integer;
end;
{ IHelpSystem. IHelpSystem - это интерфейс, с помощью которого приложение посылает запрос об отображении файла справки. ShowHelp( ) использует функциональность, которая гарантированно поддерживается всеми программами для просмотра файлов справки. ShowContextHelp( ) и ShowTopicHelp( ) поддерживаются только расширенными просмотрщиками файлов справки. В случае, когда расширенные просмотрищики не установлены, ShowTableOfContents запрашивает систему об отображении содержания файла справки и показывает окно диалога, с помощью которого пользователь может выбрать один из просмотрщиков. Если ни один из установленных просмотрщиков не поддерживает отображение содержания, генерируется исключительная ситуация EHelpSystemException. Hook( ) представляет собой механизм, с помощью которого приложение запрашивает
систему помощи для упаковки специфичных winhelp-команд в команды, которые понимают установленные просмотрщики файлов справки.}
IHelpSystem = interface(IInterface)
['{B0FC9353-5F0E-11D3-A3B9-00C04F79AD3A} ' ]
procedure ShowHelp(const HelpKeyword, HelpFileName: String);
procedure ShowContextHelp(const ContextID: Longint; const HelpFileName: String);
procedure ShowTableOfContents;
procedure ShowTopicHelp(const Topic, HelpFileName: String);
procedure AssignHelpSelector(Selector: IHelpSelector);
function Hook(Handle: Longint; HelpFile: String; Comand: Word; Data: Longint): Boolean;
end;
{ ICustomHelpViewer. Справочная система взаимодействует с просмотрщиками
файлов справки с помощью данного интерфейса. В случае, когда в системе
зарегистрировано более одного просмотрщика, справочная система вызывает
функцию UnderstandsKeywordО для каждого из них. Данная функция
возвращает число доступных ключевых слов. В случае, когда более чем один
просмотрщик может работать с нужными ключевыми словами, эти
просмотрщики запрашиваются на список поддерживаемых ключевых строк
с помощью метода GetHelpStrings( );
менеджер помощи предлагает пользователю выбрать один из просмотрщиков
и затем вызывает метод ShowHelp( ) только для выбранной пользователем
программы просмотра файлов помощи. Во время регистрации менеджер
помощи вызывает метод NotifyID для того, чтобы присвоить просмотрщику
уникальный номер. В случае, когда связь с просмотрщиком по каким-либо
причинам оборвалась, вызывается метод Release( ) и менеджеру помощи будет
передан этот номер. Если менеджер помощи сам разрывает связь, будет
вызван метод ShutDown( ) для всех просмотрщиков. Если менеджер помощи
получает просьбу о завершении работы всех просмотрщиков помощи, он
вызывает метод SoftShutDown( ) для всех просмотрщиков. }
ICustomHelpViewer = interface(IInterface)
['{B0FC9364-5F0E-11D3-A3B9-00C04F79AD3A}']
function GetViewerName : String;
function UnderstandsKeyword(const HelpString: String): Integer;
function GetHelpStrings(const HelpString: String): TStringList;
function CanShowTableOfContents : Boolean;
procedure ShowTableOfContents;
procedure ShowHelp(const HelpString: String);
procedure NotifyID(const ViewerID: Integer);
procedure SoftShutDown;
procedure ShutDown;
end;
IExtendedHelpViewer = interface(ICustomHelpViewer)
['{B0FC9366-5F0E-11D3-A3B9-00C04F79AD3A}']
function UnderstandsTopic(const Topic: String): Boolean;
procedure DisplayTopic(const Topic: String);
function UnderstandsContext(const ContextID: Integer;
const HelpFileName: String): Boolean;
procedure DisplayHelpByContext(const ContextID: Integer;
const HelpFileName: String);
end;
ISpecialWinHelpViewer - interface(IExtendedHelpViewer)
['{B0FC9366-5F0E-11D3-A3B9-OOC04F79AD3A}']
function CallWinHelp(Handle: LongInt; const HelpFile: String; Command: Word;
Data: LongInt): Boolean;
end;
IHelpManager = interface
['{B0FC9366-5F0E-11D3-A3B9-OOC04F79AD3A}']
function GetHandle: LongInt; { sizeof(LongInt) = sizeof (HWND) }
function GetHelpFile: String;
procedure Release(const ViewerID: Integer);
end;
EHelpSystemException = class(Exception);
function RegisterViewer(newViewer: ICustomHelpViewer;
out Manager: IHelpManager) : Integer;
function GetHelpSystem(out System: IHelpSystem) : Integer;
{$IFDEF LINUX}
const
HELP_CORTEXT = 1;
HELP_QUIT = 2;
HELP_INDEX = 3;
HELP_CONTENTS = HELP_INDEX;
HELP_HELPONHELP = 4;
HELP_SETINDEX = 5;
HELP_SETCONTENTS = HELP_SETINDEX;
HELP_CONTEXTPOPUP = 8;
HELP_FORCEFILE = 9;
HELP_CONTEXTMENU =10;
HELP_FINDER =11;
HELP_WM_HELP =12;
HELP_SETPOPUP_POS =13;
HELP_TCARD_OTHER_CALLER =17;
HELP_KEY = 257;
HELP_COMMAND = 258;
HELP_PARTIALKEY = 261;
HELP_MULTIKEY = 513;
HELP_SETWINPOS = 515;
HELP_TCARD__DATA = $10;
HELP_TCARD = $8000;
{$ENDIF}
implementation
{$IFDEF MSWINDOWS}
uses Contnrs, Windows, RTLConsts;
{$ENDIF}
{$IFDEF LINUX}
uses Libc, Contnrs, RTLConsts;
{$ENDIF}
type
THelpViewerNode = class(TObject)
private
FViewer: ICustomHelpViewer;
FViewerID: Integer;
public
constructor Create(Viewer: ICustomHelpViewer);
property Viewer: ICustomHelpViewer read FViewer;
property ViewerID : Integer read FViewerID write FViewerID;
end;
ТНеlpManager = class(TInterfacedObject, IHelpSystem, IHelpManager)
private
FHelpSelector: IHelpSelector;
FViewerList: TObjectList;
FExtendedViewerList: TObjectList;
FSpecialWinHelpViewerList: TObjectList;
FMinCookie : Integer;
FHandle: LongInt;
FHelpFile: String;
procedure UnloadAllViewers;
procedure DoSoftShutDown;
procedure DoTableOfContents;
function CallSpecialWinHelp(Handle: LongInt; const HelpFile: String;
Command: Word; Data: LongInt): Boolean;
public
constructor Create;
function RegisterViewer(newViewer: ICustomHelpViewer): IHelpManager;
{ IHelpSystem }
procedure ShowHelp(const HelpKeyword, HelpFileName: String );
procedure ShowContextHelp(const ContextID: Longint; onst HelpFileNawe: String);
procedure ShowTableOfContents;
procedure ShowTopicHelp(const Topic, HelpFileName: String);
procedure AssignHelpSelector(Selector: IHelpSelector);
function Hook(Handle: Longint; HelpFile: String;
Command: Word; Data: Longint) : Boolean;
{ IHelpManager }
function GetHandle: Longint;
function GetHelpFile: String;
procedure Release(const ViewerID: Integer);
property Handle : Longint read FHandle write FHandle;
property HelpFile : String read FHelpFile write FHelpFile;
destructor Destroy; override;
end;
var
HelpManager : THelpManager;
function RegisterViewer(newViewer: ICustomHelpViewer;
out Manager: IHelpManager): Integer;
begin
if not Assigned(HelpManager) then
HelpManager := THelpManager.Create;
Manager := HelpManager.RegisterViewer(newViewer);
Result := 0;
end;
function GetHelpSystem(out System ; IHelpSystem) : Integer;
begin
if not Assigned(HelpManager) then
HelpManager := THelpManager.Create;
System := HelpManager as IHelpSystem;
System._AddRef;
Result := 0;
end;
{ THelpViewerNode }
constructor THelpViewerNode.Create(Viewer: ICustomHelpViewer);
begin
FViewer := Viewer;
Viewer._AddRef;
end;
{ THelpManager }
constructor THelpManager.Create;
begin
inherited Create;
FViewerList := TObjectList.Create;
FExtendedViewerList := TObjectList.Create;
FSpecialWinHelpViewerList := TObjectList.Create;
FHelpFile := ";
FMinCookie := 1;
end;
function THelpManager.RegisterViewer(NewViewer: ICustomHelpViewer): IHelpManager;
var
ExtendedViewer: IExtendedHelpViewer;
SpecialViewer: ISpecialWinHelpViewer;
NewNode: THelpViewerNode;
begin
NewNode := THelpViewerNode.Create(NewViewer);
NewNode.ViewerID := FMinCookie;
FViewerList.Insert(FViewerList.Count, NewNode);
NewViewer.NotifyID(NewNode.ViewerID);
if Supports(NewViewer, IExtendedHelpViewer, ExtendedViewer) then
begin
NewNode := THelpViewerNode.Create(ExtendedViewer);
NewNode.ViewerID := FMinCookie;
FExtendedViewerList.Insert (FExtendedViewerList.Count, NewNode);
end;
if Supports(NewViewer, ISpeciquWinHelpViewer, SpecialViewer) then
begin
NewNode := THelpViewerNode.Create(SpecialViewer);
NewNode.ViewerID := FMinCookie;
FSpecialWinHelpViewerList.Insert(FSpecialWinHelpViewerList.Count, NewNode);
end;
FMinCookie := FMinCookie + 1;
Result := Self as IHelpManager;
end;
procedure THelpManager.UnloadAllViewers;
var
I: Integer;
begin
for I:=0 to FViewerList.Count-1 do
begin
THelpViewerNode(FViewerList[I]).Viewer.ShutDown;
end;
FViewerList.Clear;
FExtendedViewerList.Clear;
FSpecialWinHelpViewerList.Clear;
end;
procedure THelpManager.DoSoftShutDown;
var
I : Integer;
begin
for I:= 0 to FViewerList.Count-1 do
begin
THelpViewerNode(FViewerList[ I ]).Viewer.SoftShutDown;
end;
end;
procedure THelpManager.DoTableOfContents;
var
ViewerNames : TStringList;
I : Integer;
HelpNode : THelpViewerNode;
begin
if FViewerList.Count = 1 then
begin
if THelpViewerNode(FViewerList [ 0 ]).Viewer.CanShowTableOfContents then
THelpViewerNode(FViewerList[0]).Viewer.ShowTableOfContents;
end
else if FHelpSelector <>
nil then
begin
ViewerNames := TStringList.Create;
try
for I := 0 to FViewerList.Count -1 do
begin
HelpNode := THelpViewerNode (FViewerList [I] );
if HelpNode.Viewer.CanShowTableOfContents then
ViewerNames,AddObject(HelpNode.Viewer.GetViewerName, TObject(HelpNode));
end;
if ViewerNames.Count >
1 then
begin
ViewerNames.Sort;
I := FHelpSelector.TableOfContents(ViewerNames);
THelpViewerNode(ViewerNames.Objects[I]).Viewer.ShowTableOfContents; end
else begin
THelpViewerNode(ViewerNames.Objects[0]).Viewer.ShowTableOfContents; end; finally
ViewerNames.Free;
end;
end
else if (FViewerList.Count >
0) and
(THelpViewerNode(FViewerList[0]).Viewer.CanShowTableOfContents) then
begin
THelpViewerNode(FViewerList[0]).Viewer.ShowTableOfContents;
end
else raise EHelpSystemException.CreateRes(ShNoTableOfContents);
end;
function THelpManager.CallSpecialWinHelp(Handle: LongInt;
const HelpFile: String;
Command: Word; Data: LongInt): Boolean;
var
View : ICustomHelpViewer;
begin
Result := false;
if FSpecialWinHelpViewerList.Count >
0 then
begin
if FSpecialWinHelpViewerList.Count = 1 then
begin
View := THelpViewerNode(FSpecialWinHelpViewerList[0]).Viewer;
Result := (View as ISpecialWinHelpViewer).CallWinHelp(Handle, HelpFile, Command, Data);
end else
begin
View := THelpViewerNode(FSpecialWinHelpViewerList[0]).Viewer;
Result := (View as ISpecialWinHelpViewer).CallWinHelp(Handle, HelpFile, Command, Data);
end;
end;
end;
{ THelpManager - IHelpSystem }
procedure THelpManager.ShowHelp(const HelpKeyword, HelpFileName :
String);
var
I, J: Integer;
AvailableHelp: Integer;
HelpfulViewerCount : Integer;
ViewerIndex: Integer;
AvailableHelpList: TStringList;
ViewerHelpList: TStringList;
HelpNode : THelpViewerNode;
KeywordIndex : Integer;
Obj: TObject;
ObjString: String;
begin
ViewerIndex := 0;
HelpfulViewerCount := 0;
if HelpFileName <>
'' then
HelpFile := HelpFileName;
if FViewerList.Count >
0 then
begin
for I := 0 to (FViewerList.Count - 1) do
begin
AvailableHelp := THelpViewer-
Node (FViewerList [I] ).Viewer.UnderstandsKeyword(HelpKeyword);
if AvailableHelp >
0 then
begin
ViewerIndex := I;
HelpfulViewerCount := HelpfulViewerCount + 1;
end;
end;
if HelpfulViewerCount = 0 then
raise EHelpSystemException.CreateResFmt(@hNothingFound,
[PChar(HelpKeyword)]);
if HelpfulViewerCount = 1 then
begin
THelpViewerNode (FViewerList [ViewerIndex]) . Viewer. ShowHelp (HelpKeyword) ;
end;
if HelpfulViewerCount >
1 then
begin
AvailableHelpList := TStringList.Create( );
for I := 0 to FViewerList.Count -1 do
begin
HelpNode := THelpViewerNode(FViewerList [ I ]) ;
AvailableHelp := HelpNode.Viewer.UnderstandsKeyword(HelpKeyword);
if AvailableHelp >
0 then
begin
ViewerHelpList := HelpNode.Viewer.GetHelpStrings(HelpKeyword);
for J ;= 0 to ViewerHelpList.Count - 1 do
begin
AvailableHelpList.AddObject(ViewerHelpList.Strings[J], TOb-
ject(HelpNode));
end;
ViewerHelpList.Free;
end;
end;
if FHelpSelector <>
nil then
begin
AvailableHelpList.Sort;
KeywordIndex := FHelpSelector.SelectKeyword(AvailableHelpList);
if Keywordlndex >
= 0 then
begin
Obj := AvailableHelpList.Objects[KeywordIndex] ;
ObjString := AvailableHelpList.Strings[KeywordIndex];
THelpViewerNode(Obj).Viewer.ShowHelp(ObjString);
end;
end
else begin
Obj := AvailableHelpList.Objects[0];
ObjString := AvailableHelpList.Strings[0];
THelpViewerNode(Obj).Viewer.ShowHelp(ObjString);
end;
AvailableHelpList.Free;
end;
end;
end;
procedure THelpManager.ShowContextHelp(const ContextID: Longint; const
HeIpFileName: String);
var
I : Integer;
View: ICustomHelpViewer;
begin
if FExtendedViewerList.Count = 0 then
raise EHelpSysteroException.CreateRes(@hNoContext)
else begin
for I := 0 to FExtendedViewerList.Count -1 do
begin
View := THelpViewerNode(FExtendedViewerList[ I ]).Viewer;
if (View as IExtendedHelpViewer).UnderstandsContext(ContextID, HelpFile-
Name) then
begin
(View as IExtendedHelpViewer).DisplayHelpByContext(ContextID, HelpFile-
Name) ;
break;
end;
end;
end;
end;
procedure THelpManager.ShowTableOfContents;
begin
DoTableOfContents;
end;
procedure THelpManager.ShowTopicHelp(const Topic, HelpFileName: String);
var
I: Integer;
View: ICustomHelpViewer;
begin
if FExtendedViewerList.Count = 0 then
raise EHelpSystemException.CreateRes(@hNoTopics)
else begin
for I := 0 to FExtendedViewerList.Count - 1 do
begin
View := THelpViewerNode(FExtendedViewerList[ I ]).Viewer;
if (View as IExtendedHelpViewer).UnderstandsTopic(Topic) then
begin
(View as IExtendedHelpViewer).DisplayTopic(Topic);
break;
end;
end;
end;
end;
procedure THelpManager.AssignHelpSelector(Selector: IHelpSelector);
begin
if FHelpSelector <>
nil then FHelpSelector := nil;
FHelpSelector := Selector;
Selector._AddRef;
end;
function THelpManager.Hook(Handle: Longint; HelpFile; String;
Command: Word; Data: Longint): Boolean;
begin
case Command of
HELP_CONTEXT:
begin
ShowContextHelp(Data, HelpFile);
end;
HELP_CONTEXTPOPUP:
begin
ShowCoritextHelp (Data, HelpFile) ;
end;
HELP_QUIT:
begin
DoSoftShutDown;
end;
HELP_CONTENTS:
begin
FHelpFile := HelpFile;
DoTableOfContents;
end;
else
CallSpecialWinHelp(Handle, HelpFile, Command, Data);
end;
Result := true;
end;
{ THelpManager —— IHelpManager }
function THelpManager.GetHandle: LongInt;
begin
Result := Handle;
end;
function THelpManager.GetHelpFile: String;
begin
Result := HelpFile;
end;
procedure THelpManager.Release(const ViewerID: Integer);
var
I : Integer;
begin
for I := 0 to FViewerList.Count-1 do
begin
if THelpViewerNode(FViewerList[ I ]).ViewerID = ViewerID then
FViewerList.Delete( I );
end;
for I := 0 to FExtendedViewerList.Count-1 do
begin
if THelpViewerNode(FExtendedViewerList [ I ]).ViewerID = ViewerID then
FExtendedViewerList.Delete( I );
end;
for I := 0 to FSpecialWinHelpViewerList.Count-1 do
begin
if THelpViewerNode(FSpecialWinHelpViewerList[I]).ViewerID = ViewerID then
FSpecialWinHelpViewerList.Delete( I );
end;
end;
destructor THelpManager.Destroy;
begin
if FHelpSelector <>
nil then FHelpSelector := nil;
inherited Destroy;
end;
initialization
finalization
if HelpManager <>
nil then
begin
HelpManager.UnloadAllViewers;
end;
end.
П2 1 Модуль WinHelpViewer pas
Листинг П2.1.Модуль WinHelpViewer.pas
unit WinHelpViewer;
{********************************************************************* }
{ }
{ Этот модуль обеспечивает поддержку просмотрщика помощи WinHelp (под
{ Windows) или HyperHelp (эмулятор WinHelp) под Linux.}
{ }
{********************************************************************* }
interface
uses Classes;
type
IWinHelpTester - interface(IInterface)
['{B0FC9354-5F0E-11D3-A3B9-00C04F79AD3A}']
function CanShowALink(const ALink, FileName: String): Boolean;
function CanShowTopic(const Topic, FileName: String): Boolean;
function CanShowContext (const Context; Integer;
const FileName: String): Boolean;
function GetHelpStrings(const ALink: String): TStringList;
function GetHelpPath : String;
function GetDefaultHelpFile: String;
end;
var
WinHelpTester : IWinHelpTester;
ViewerName : String;
{$IFDEF LINUX}
HyperHelpWindowName : String;
{$ENDIF}
{====================================================================}
{$IFDEF MSWINDOWS}
uses HelpIntfs, SysUtils, Windows;
{$ENDIF}
{$IFDEF LINUX}
uses HelpIntfs, SysUtils, Libc;
{$ENDIF}
{$IFDEF LINUX}
const
winhelpmodulename = 'winhelp.so';
function WinHelp(HWND: LongInt; HelpFile: PChar; Conmand: LongInt;
Data: LongWord): Boolean; cdecl;
external winhelpmodulename name 'WinHelp';
{$ENDIF}
type
TWinHelpViewer = class(TInterfacedObject, ICustomHelpViewer, IExtended-
HelpViewer, ISpecialWinHelpViewer)
private
FViewerID: Integer;
public
FHelpManager: IHelpManager;
constructor Create;
function HelpFile(const Name: String) : String;
procedure InternalShutDown;
{ ICustoroHelpViewer }
function GetViewerName : String;
function UnderstandsKeyword(const HelpString: String): Integer;
function GetHelpStrings(const HelpString: String): TStringList;
function CanShowTableOfContents: Boolean;
procedure ShowTableOfContents;
procedure ShowHelp(const HelpString: String);
procedure NotifуID(const ViewerID: Integer);
procedure SoftShutDown;
procedure ShutDown;
{ IExtendedHelpViewer }
function UnderstandsTopic(const Topic: String): Boolean;
procedure DisplayTopic(const Topic: String);
function UnderstandsContext(const ContextID: Integer;
const HelpFileName: String): Boolean;
procedure DisplayHelpByContext(const ContextID: Integer;
const HelpFileName: String);
{ ISpecialWinHelpViewer }
function CallWinHelp(Handle: LongInt;
const HelpFileName: String;
Command: Word; Data: LongInt) : Boolean;
property ViewerID : Integer read FViewerID;
property HelpManager : IHelpManager read FHelpManager write FHelpManager;
destructor Destroy; override;
end;
var
HelpViewer : TWinHelpViewer;
{----------------------------------------------------------------------}
{ TWinHelpVIewer }
constructor TWinHelpViewer.Create;
begin
inherited Create;
end;
function TWinHelpViewer.HelpFile(const Name: String): String;
var
FileName : String;
begin
Result := ";
if (Name = '') and Assigned(FHelpManager) then
FileName := HelpManager. GetHelpFile
else FileName := Name;
if FileName = '' then if Assigned(WinHelpTester) then
FileName := WinHelpTester.GetDefaultHelpFile;
{$IFDEF LINUX}
if Assigned(WinHelpTester) then
FileName := WinHelpTester.GetHelpPath + PathDelim + FileName;
{$ENDIF}
Result := FileName; end; procedure TWinHelpViewer.InternalShutDown;
begin
SoftShutDown;
if Assigned(FHelpManager) then
begin
HelpManager.Release(ViewerID);
if Assigned(FHelpManager) then HelpManager := nil;
end;
end;
{----------------------------------------------------------------------}
{ TWinHelpViewer - ICustomHelpViewer }
function TWinHelpViewer.GetViewerNaroe : String;
begin
Result := ViewerName;
end;
function TWinHelpViewer.UnderstandsKeyword(const HelpString: String):
Integer;
var
CanShowHelp : Boolean;
begin
if Assigned(WinHelpTester) then
begin
CanShowHelp := WinHelpTester.CanShowALink(HelpString, HelpFile( ''));
if CanShowHelp then Result := 1
else Result := 0;
end
else begin
{$IFDEF WINDOWS}
Result := 1;
{$ENDIF}
{$IFDEF LINUX}
Result := 0;
{$ENDIF}
end;
end;
function TWinHelpViewer.GetHelpStrings(const HelpString: String): TStringList;
begin
if Assigned(WinHelpTester} then
begin
Result := WinHelpTester.GetHelpStrings (HelpString);
end else
begin
Result := TStringList.Create;
{$IFDEF MSWINDOWS}
Result.Add(GetViewerName +':'+ HelpString);
{$ENDIF}
end;
end;
function TWinHelpViewer.CanShowTableOfContents : Boolean;
begin
Result := true;
end;
procedure TWinHelpViewer.ShowTableOfContents;
begin
WinHelp(HelpManager.GetHandle, PChar(HelpFile(HelpManager.GetHelpFile)),
HELP_CONTENTS, 0);
end;
{$IFDEF MSWINDOWS}
procedure TWinHelpViewer.ShowHelp(const HelpString: String);
const
Macro - 'IE(AL("%s",4),"AL(\"%0:s\",3)","JK(\"%l:s\",\"%0:s\")")';
begin
WinHelp(HelpManager.GetHandle, PChar(HelpFile(" )),/ HELP_COMMAND,
LongInt (PChar (Format (Macro, [HelpString, HelpFile (")]))));
end;
{$ENDIF}
{$IFDEF LINUX}
procedure.TWinHelpViewer.ShowHelp(const HelpString: String);
const
Macro= 'AL(%0s,3,,%ls)';
begin
WinHfelp(HelpManager.GetHandle, PChar(HelpFile(")), HELP_COMMAND,
LongInt(Pchar(Format(Macro, [HelpString, HyperHelpWindowName]))));
end;
{$ENDIF}
procedure TWinHelpViewer.NotifylD(const ViewerID: Integer);
begin
FViewerID := ViewerID;
end;
procedure TWinHelpViewer.SoftShutDown;
begin
WinHelp(0, PChar( " ), HELP_QUIT, 0);
end;
procedure TWinHelpViewer.ShutDown;
begin
SoftShutDown;
if Assigned(FHelpManager) then HelpManager := nil;
if Assigned(WinHelpTester) then WinHelpTester := nil;
end;
{-----------------------------------------------------------------------}
{ TWinHelpViewer —— IExtendedHelpViewer }
function TWinHelpViewer.UnderstandsTopic(const Topic: String): Boolean;
begin
{$IFDEF MSWINDOWS}
Result := true;
{$EMDIF}
{$IFDEF LINUX}
Result := false;
{$ENDIF}
if Assigned(WinHelpTester) then
Result := WinHelpTester.CanShowTopic(Topic, HelpFile(''));
end;
procedure TWinHelpViewer.DisplayTopic(const Topic: String);
var
HelpCommand; array[0..255] of Char;
begin
StrLFmt (HelpCommand, SizeOf (HelpCommand) -1, ' JtmpIDC'", "%s") ', [Topic]);
WinHelp(HelpManager.GetHandle, PChar(HelpFile( " )), HELP_COMMAND,
Longint(@HelpCommand));
end;
function TWinHelpViewer.UnderstandsContext(const ContextID: Integer;
const HelpFileName: String) : Boolean;
begin
{$IFDEF MSWINDOWS}
Result := true;
{$ENDIF}
{$IFDEF LINUX}
Result := false;
{$ENDIF}
if Assigned(WinHelpTester) then
Result := WinHelpTester.CanShowContext(ContextID, Help-
File (HelpFileName));
end;
procedure TWinHelpViewer.DisplayHelpfeyContext(const ContextID: Integer;
const HelpFileName: String);
begin
WinHelp(HelpManager.GetHandle, PChar(HelpFile(HelpFileName)),
HELP_CONTEXT, ContextID);
end;
{------------------------------------------------------------------------}
{ TWinHelpViewer —— ISpecialWinHelpViewer }
function TWinHelpViewer.CallWinHelp(Handle: LongInt; const HelpFileName: String;
Command: Word; Data: LongInt) : Boolean;
begin
Result := WinHelp(Handle, PChar(HelpFile(HelpFileName)), Command, Data);
end;
destructor TWinHelpViewer.Destroy;
begin
inherited Destroy;
end;
{============================================================================}
initialization
HelpViewer := TWinHelpViewer.Create;
Helplntfs.RegisterViewer(HelpViewer, HelpViewer.FHelpManager);
WinHelpTester := nil;
finalization
if Assigned(HelpViewer.FHelpManager) then
begin
HelpViewer.InternalShutDown;
end;
if Assigned(WinHelpTester) then
begin
WinHelpTester := nil;
end;
end.
П2 2 Модуль ManViewer pas
Листинг П2.2.Модуль ManViewer.pas
unit ManViewer;
{*********************************************************************}
{ }
{ Этот модуль поддерживает просмотрщик страниц man в среде Linux. }
{ Он не был опробован на различных unix-системах и формах Linux, }
{ за исключением RedHat. }
{ }
{ *******************************************************************}
interface
{ = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = }
implementation
uses HelpIntfs, Classes, SysUtils, LibC;
type
TManPageViewer = class(TInterfacedObject, ICustomHelpViewer)
private
FHelpStrings : TStringList;
FLastQuery : String;
FViewerID : Integer;
ChildPid : Integer;
procedure ProcessHelpStrings(StringBuf: PChar; HelpString: String);
procedure KillChild;
public
FHelpManager : IHelpManager;
constructor Create;
procedure InternalShutDown;
{ ICustomHelpViewer }
function GetViewerName : String;
function UnderstandsKeyword(const HelpString: String): Integer;
function GetHelpStrings(const HelpString: String): TStringList;
function CanShowTableOfContents : Boolean;
procedure ShowHelp(const HelpString: String);
procedure ShowTableOfContents;
procedure NotifyID(const ViewerID: Integer);
procedure SoftShutDown;
procedure ShutDown;
property HelpManager : IHelpManager read FHelpManager write FHelpManager;
property ViewerID : Integer read FViewerID;
destructor Destroy; override;
end;
var
HelpViewer : TManPageViewer;
const
{ man and its switches }
ExeName = 'man';
AllSwitch = '-a'; { отображает все man-страницы раздела }
WhereSwitch = '-w'; { где располагается man-страница? }
ViewerName = 'xterm';
MoreBugSwitch = '-cu';
ExecSwitch = '-e';
TitleSwitch = '-Т'; {установка заголовка окна }
ViewerTitle = 'Kylix man page viewer';
{ сигнал, используемой для завершения дочерних процессов }
KillSignal = SIGINT;
sFatalFork = 'Unable to fork(). Please consult the disaster manual.';
sNoTableOfContents = 'Unable to provide table of contents for man pages.';
{----------------------------------------------------------------------}
{ TManPageViewer }
constructor TManPageViewer.Create;
begin
inherited Create;
end;
procedure TManPageViewer.ProcessHelpStrings(StringBuf: PChar;
HelpString: String);
var
bufptr, lineptr, valptr, delim: PChar;
searching: boolean;
addstr : String;
begin
bufptr := StringBuf;
searching := true;
while searching do
begin
delim := #10#13;
lineptr := strsep(@bufptr, delim);
if (lineptr = nil) then
begin
searching := false;
end else
begin
delim := '.';
strsep(@lineptr, delim);
valptr := strsep(@lineptr, delim);
if valptr <>
nil then
begin
addstr := HelpString + ' (' + valptr + ') (' + GetViewerName + ')';
FHelpStrings.Add(addstr) ;
end;
end;
end;
end;
procedure TManPageViewer.KillChild;
begin
if ChildPid <>
0 then
begin
kill (ChildPid, KillSignal) ;
waitpid(ChildPid, nil, WNOHANG or WUNTRACED);
ChildPid := 0;
end;
end;
procedure TManPageViewer. IntemalShutDown;
begin
KillChild;
if Assigned(FHelpManager) then FHelpManager.Release(ViewerID);
ShutDown;
end;
{---------------------------------------------------------------------}
{ TManPageViewer —— ICustomHelpViewer }
function TManPageViewer.GetViewerName;
begin
Result := ExeName;
end;
function TManPageViewer.UnderstandsKeyword(const HelpString: String):
Integer;
var
SuccDescr, ErrDescr : TPipeDescriptors;
pid: Integer;
Args : array of PChar;
DescriptorSet : TFDSet;
WaitTime : TTiraeVal;
WaitStatus: Integer;
PipeStream : THandleStream;
ReadBuf : Pointer;
BytesRead: Integer;
Reading : Boolean;
begin
Result := 0;
if FHelpStrings <>
nil then FHelpStrings := nil;
SetLength(Args, 5);
Args[0] := ExeName ;
Args[ l ] := AllSwitch;
Args[2] := WhereSwitch;
Args[3] := PChar(HelpString);
Args[4] := nil;
pipe(SuccDescr) ;
pipe(ErrDescr) ;
pid := fork;
if pid = 0 then
begin
_close(SuccDescr.ReadDes);
_close(ErrDescr.ReadDes) ;
dup2(SuccDescr.WriteDes, stdout);
dup2(ErrDescr.WriteDes, stderr);
execvp (PChar(Args[0]), @Args[0]);
end
else begin
if pid = -1 then
begin
raise EHelpSystemException.Create(sFatalFork);
end else
begin
WaitStatus := waitpid(pid, nil, WUNTRACED);
if WaitStatus >
0 then
begin
WaitTime.tv_sec := 0;
WaitTime.tv_usec := 0;
FD_ZERO(DescriptorSet);
FD_SET(TSocket(SuccDescr.ReadDes), DescriptorSet);
FD_SET(TSocket(ErrDescr.ReadDes), DescriptorSet);
select(__FD_SETSIZE, @DescriptorSet, nil, nil, @WaitTime);
if FD_ISSET(TSocket(SuccDescr.ReadDes), DescriptorSet) then
begin
if FHelpStrings = nil then FHelpStrings := TStringList.Create;
PipeStream := THandleStream.Create(SuccDescr.ReadDes);
ReadBuf := Libc.malloc(1024);
memset(ReadBuf, 0, 1024);
Reading := true;
while Reading do
begin
BytesRead := PipeStream.Read(ReadBuf^, 1024);
if (BytesRead < 1024) then Reading := false;
ProcessHelpStrings(ReadBuf, HelpString);
memset(ReadBuf, 0, 1024);
end;
Libc.free(ReadBuf);
PipeStream.Free;
Result := FHelpStrings.Count;
FLastQuery := HelpString;
end else
begin
end;
end else
begin
if FHelpStrings = nil then FHelpStrings := TStringList.Create;
end;
end;
end;
_close(SuccDescr.WriteDes);
_close(ErrDescr.WriteDes);
_close(SuccDescr.ReadDes);
_close(ErrDescr.ReadDes);
end;
function TManPageViewer.GetHelpStrings(const HelpString: String): TStringList;
begin
Result := FHelpStrings;
end;
function TManPageViewer.CanShowTableOfContents:Boolean;
begin
Result := false;
end;
procedure TManPageViewer. ShowTableOfContents ;
begin
raise EHelpSystemException.Create(sNoTableOfContents);
end;
procedure TManPageViewer.ShowHelp(const HelpString: String);
var
KeywordEnd, Section, CompResult, CompString, Comparator: PChar;
Args : array of PChar;
pid : Integer;
begin
KillChild;
SetLength (Args, 9) ;
Args[0] = ViewerName;
Args[1 ] = MoreBugSwitch;
Args[2] = TitleSwitch;
Args[3] = ViewerTitle;
Args[4] = ExecSwitch;
Args[5] = ExeName;
Args[6] = AllSwitgh;
Args[7] = PChar(HelpString);
Args[8] = nil;
CompString := PChar(HelpString);
Comparator := Libc.malloc(2);
Comparator[0] := '(';
Comparator[1] := #0;
CompResult := strstr(CompString, Comparator);
Libc.free(Comparator);
if (CompResult <>
nil) then
begin
Section := Libc.malloc(2) ;
KeywordEnd := AnsiStrPos(PChar(HelpString), '(');
Section[0] := KeywordEnd[1];
Section [1] :=» #0;
Args[6] := Section;
{ #DEFINE DUMB_НАСК_ВУ_ТIRED_РROGRAMMER }
Args[7] := PChar(FLastQuery);
end
else begin
Section := nil;
end;
pid := fork;
if pid = 0 then
begin
execvp(PChar(Args[0]), @Args[0]);
end
else begin
if pid = -1 then
begin
raise EHelpSystemExceptiorv.Create (sFatalFork);
end
else begin
ChildPid := pid;
end;
end;
if Section о nil then Libc.free(Section);
end;
procedure TManPageViewer.NotifyID(const ViewerID: Integer);
begin
FViewerID := ViewerID;
end;
procedure TManPageViewer.SoftShutDown;
begin
KillChild;
end;
procedure TManPageViewer.ShutDown;
begin
KillChild;
if Assigned(FHelpManager) then FHelpManager := nil;
end;
destructor TManPageViewer.Destroy;
begin
inherited Destroy;
end;
{====================================================================}
initialization
if not Assigned(HelpViewer) then
begin
HelpViewer :=TManPageViewer.Create;
HelpIntfs.RegisterViewer(HelpViewer, HelpViewer.FHelpManager);
end;
finalization
if Assigned(HelpViewer) then
begin
HelpViewer.InternalShutDown;
end;
end.
Листинги модулей для создания системы
для создания системы
Листинги всех трех файлов приводятся
Листинги всех трех файлов приводятся в конце книги, в Приложении 2.
Методы
Методы
Методы — это процедуры или функции, принадлежащие объекту. Методы определяют поведение объекта. Для вызова метода объекта нужно указать имя объекта, с которым ассоциирован данный метод, затем, через точку, — название метода. Например:
MyObject.Method1;
Вызывается метод Method1 объекта MyObject.
Для создания метода его нужно сначала объявить внутри описания класса или компонента, содержащего данный метод. Например:
type
TMyObject = class(TObject)
. . . procedure DoSomething; // Объявление метода DoSomething
. . . end;
Здесь, внутри описания нового класса, объявляем метод DoSomething с помощью служебного слова procedure. Эта процедура может находиться где угодно внутри модуля, в котором был описан данный класс. Например:
procedure TMyComponent.DoSomething; begin
// Здесь размещаем команды и операторы, которые должны выполняться
// при вызове метода DoSomething на выполнение end;
Заметим, что при создании процедуры DoSomething мы должны указывать ее полное имя, вместе с указанием имени компонента или класса (procedure TMyComponent.DoSomething;).
В зависимости от вида метода, он может вызываться различными способами. Методы бывают следующих видов:
виртуальные (virtual);
динамические (dynamic);
перегруженные (override);
методы обработки сообщений (message);
абстрактные (abstract).
После заголовка метода в описании класса через точку с запятой указывается один из вышеперечисленных идентификаторов (virtual, ..., abstract).
По умолчанию методы являются статическими и вызываются как любые другие подпрограммы.
Более подробно о методах мы расскажем в пятой части книги, где речь пойдет о создании собственных компонентов и пакетов компонентов.
Модуль данных
Рисунок 18.10. Модуль данных
Модули
Модули
Кроме рассмотренных выше программ и подпрограмм, язык Object Pascal позволяет создавать так называемые модули.
Модуль (unit) — предназначен для записи в него различных элементов, таких как подпрограммы, переменные, константы и др.
Модуль не может быть запущен на исполнение как программа. Чтобы использовать модуль в программе, его необходимо подключить. Для этого имя модуля указывается в разделе uses основной программы.
Наглядно демонстрирует результат работы вышеприведенной программы
Рисунок 19.7 наглядно демонстрирует результат работы вышеприведенной программы.
 |
Наиболее успешные сделки совершаются в направлении трендаНаиболее успешные сделки совершаются в направлении тренда Преимущество торговли по тренду состоит в том, что это то направление, в котором торгуют трейдеры крупного масштаба, а импульс, вызванный новыми деньгами, приходящими на рынок, вероятно, продолжит двигать цены в направлении тренда, пока не появятся серьезные причины для разворота. Причины могут быть фундаментальными событиями или просто взятием прибыли. Ниже приводятся несколько способов определить направление тренда. Написание переносимого кодаНаписание переносимого кода Для создания кроссплатформенного приложения следуйте приведенным ниже советам: устраните конструкции PostMessage и SendMessage внутри приложения; используйте объект TMemIniFile вместо TregIniFile; обращайте внимание на регистр символов при наименовании файлов или каталогов; откажитесь от кода ассемблера TASM (ассемблер GNU не поддерживает синтаксис TASM); попробуйте написать код, использующий платформонезависимые библиотеки и константы, находящиеся в модулях System, SysUtils и других модулях, одинаковых для обеих платформ. Приведем пример, который позволяет использовать многобайтные символы для обеих платформ (Windows и Linux). Среда Windows традиционно сопоставляет только два байта каждому многобайтному символу. В Linux многобайтная кодировка символов может содержать намного больше байтов на один символ (до шести байтов в кодировке UTF-8). Обе платформы могут использовать одинаковую кодировку с помощью функции StrNextChar, находящейся в модуле SysUtils. В листинге 21.2 приведен код для среды Windows.
Непереносимые возможностиНепереносимые возможности При создании объекта CLX с помощью палитры компонентов или написания кода, использующего метод Create, компилятор создает экземпляр widget. Этот экземпляр принадлежит данному объекту CLX. Если вы вызываете метод Free для уничтожения объекта CLX или автоматически уничтожаете родительский контейнер, содержащий объект CLX, экземпляр widget данного объекта будет также уничтожен. Эта функция характерна для VCL в приложениях Windows. Если вы создаете объект GLX с помощью метода Create (AHandle), то этот объект не будет иметь в собственности Qt widget. Таким образом, при вызове метода Free будет уничтожен только объект GLX. В VCL Windows это невозможно. Назад
Содержание
Вперед
Объекты и классыОбъекты и классы В этой главе мы кратко рассмотрим основы объектно-ориентированного программирования. Изучим такие понятия, как инкапсуляция, наследование и полиморфизм. Рассмотрим классы, поля, свойства, события, методы объектов. В заключение мы узнаем, что такое типы времени выполнения (RTTI). Основы объектно-ориентированного программирования Язык Object Pascal является объектно-ориентированным языком. Таким образом, готовое приложение, написанное на данном языке, будет иметь в своем составе объекты. Итак, рассмотрим, что такое класс. Класс — это тип данных, который включает в себя какие-либо данные и операции над ними. Объект — это экземпляр какого-либо класса. Таким образом, класс — это описание (тип), а объект — это то, что создано в соответствии с этим описанием. Например, все вы хорошо представляете, что такое стол. Стол — это нечто, имеющее столешницу и четыре ножки. Такое вот описание стола и будет классом, а конкретный экземпляр стола, за которым вы сейчас сидите, читая эту книгу, является объектом данного класса. До создания объектно-ориентированных языков программирования данные и операции над данными рассматривали как отдельные элементы. Что такое объект, достаточно просто можно понять, если вспомнить работу с записями. Записи состоят из областей, которые содержат данные разных типов (каждая область записи имеет собственный тип данных). Объекты — это тоже хранилища разных типов данных. Данные объекта называются полем (field) и аналогичны полям записи. Но объекты, в отличие от записей, содержат еще процедуры и функции, которые применимы к полям данного объекта. Эти процедуры и функции называются методами (methods). Изменять поля объекта можно при помощи свойств (properties) объекта. Каждое свойство объекта в Kylix представляет собой поле и методы (так называемые методы доступа), которые позволяют считывать значение поля и задавать его. Свойства можно изменять в процессе разработки приложения с помощью инспектора объектов. Примечание Информацию о работе с инспектором объектов Kylix, а также другими окнами вы найдете во второй части этой книги. К основным принципам объектно-ориентированного программирования относятся: Инкапсуляция — это объединение данных и обрабатывающих их методов внутри одного класса. Наследование обозначает, что объекты могут получать свои свойства и методы от других объектов (которые называют в данном случае предками). Объекты-наследники берут от предков все свойства, методы и поля. Эти свойства, методы и поля в объекте-наследнике могут сохраняться либо в неизменном виде, либо в измененном. Кроме того, объекты-наследники могут иметь в своем составе дополнительно новые поля, методы или свойства. Полиморфизм подразумевает, что методы различных объектов могут иметь одинаковые имена, но отличаться по своему содержанию. Это получается в результате переопределения метода объекта-предка в объекте-наследнике. При этом обращение к одному и тому же методу у объекта-предка и объекта-потомка может привести к разным результатам. Содержание
Вперед
Области видимости объектов (компонентов)Области видимости объектов (компонентов) Область видимости объекта (компонента) — это часть программного кода, в пределах которой существует прямой доступ к свойствам, событиям и методам объекта (компонента) без явного указания его имени. Таким образом, когда вы пишите код, находящийся в области видимости объекта (компонента), можно не указывать его имя для доступа к его свойствам, событиям и методам. В качестве примера приведем часть программы (см. листинг 7.1), которая показывает действие области видимости объекта (в данном примере формы Form1).
Обновление экранаОбновление экрана Во время работы приложения многие объекты на экране изменяют свое состояние. Может измениться текст или графика, содержащаяся внутри объекта. Для того чтобы эти изменения отображались на экране, необходимо обновление объектов. Обновление (refresh) объектов — это процесс, выполняемый операционной системой для перерисовки окон и компонентов, расположенных внутри окон. Для самостоятельного вызова метода обновления компонента вы можете использовать метод Refresh, который имеется у всех компонентов CLX, поддерживающих обновление. При обновлении объекта генерируется событие OnPaint. Вы можете написать собственный обработчик события OnPaint. Приведем пример перехвата события обновления формы. Будем выводить окно c текстовым сообщением всякий раз, когда произойдет обновление формы. Создадим новое приложение — File/New Application. Теперь разместим на форме Form1 кнопку Button1 (Рисунок 13.1). Обозначения окна проводникаРисунок 6.9. Обозначения окна проводника Для перехода из окна проводника в окно просмотра и редактирования кода и наоборот можно использовать комбинацию клавиш <Ctrl>+<Shift>+<E>. В окне проводника можно использовать пошаговый поиск. Чтобы найти любой класс, свойство, метод, переменную или программу (процедуру или функцию), достаточно набрать на клавиатуре необходимое имя. Между окном проводника и окном просмотра и редактирования кода существует прямая связь. При выборе объекта в окне проводника курсор в окне просмотра и редактора кода сместится на раздел реализации (Implementation) для данного объекта. И наоборот, при перемещении в окне просмотра и редактирования кода будут подсвечиваться соответствующие объекты в окне проводника. Для добавления (переименования) объекта в окне проводника достаточно щелкнуть правой кнопкой мыши в соответствующем узле окна проводника и выбрать в контекстном меню New (Rename). Окно проводника также можно настроить с помощью окна настройки среды (Environment Options) (Рисунок 6.10). Оно вызывается с помощью пункта меню главного окна Kylix Tools/Environment Options (Средства/Настройки среды).  Обработка исключительных ситуацийОбработка исключительных ситуаций Чтобы сделать свое приложение устойчивым к ошибкам, вам необходимо распознать исключение и обработать его. Если вы не напишете обработчик исключения, приложение отобразит окно сообщения об ошибке. Обработчик исключения — это программа, которая начинает свое выполнение в случае возникновения определенной исключительной ситуации. Обработник исключения выполняется вместо стандартной реакции приложения на ошибку. При обработке исключительных ситуаций Kylix работает с так называемыми объектами исключений. Так как Kylix — объектно-ориентированная среда программирования, то логично, что и исключительная ситуация — тоже объект. Для работы с этим объектом в Kylix присутствуют специальные языковые конструкции, которые мы и рассмотрим далее. Программисту чаще всего известно, в каком именно месте программы может возникнуть исключительная ситуация (например, место, где происходит открытие файла, расположенного на диске). Для того чтобы обработать ее, нужно этот кусок кода защитить. Таким образом, данный блок кода будет называться защищенным. Рассмотрим языковые конструкции, предоставляемые средой Kylix, которые обеспечивают защищенный код. Первая конструкция имеет вид, представленный в листинге 9.1. Общий обзор языкаОбщий обзор языка В этой главе мы расскажем о языке Object Pascal. Для начала, небольшой исторический экскурс в историю языка Pascal. Исторически первый, недоступный широкой аудитории технический отчет языка Pascal был сделан Швейцарским федеральным технологическим институтом ЕТН (Eidgenoessische Technische Hochschule) в ноябре 1970 года. Официальной же датой рождения языка считается начало 1971 года, когда вышеупомянутый отчет был перепечатан в первом номере журнала Acta In-formatica. Автором языка является швейцарский профессор Никлаус Вирт (Niklaus К. Wirth). Во время активного использования языка наблюдалось острая конкуренция с языком С. Большую роль в массовом распространении языка Pascal сыграла компания Borland, создавшая версию Тurbo Раsсаl. После этого уже стали появляться многочисленные модификации: в версии 3.0 появилась возможность работы со встроенной графикой, в версии 4.0 — модули, в версии 5.5 — возможность работы с объектами. Версия 7.0 поменяла название и стала называться Borland Pascal. Наконец, при появлении Delphi язык стал называться Object Pascal. Среда Kylix также использует язык Object Pascal. Содержание
Вперед
Общий обзор потоковОбщий обзор потоков Поток (Thread) — это объект операционной системы, заключенный в процесс и реализующий какую-либо задачу. Любое приложение (процесс) содержит несколько потоков (как минимум, один, который называется основным, стандартным. В большинстве приложений вы можете использовать объект потока, который позволяет вам использовать потоки в ваших приложениях. Объекты потоков инкапсулируют в себе основные свойства и методы, необходимые для написания многопоточных приложений. Итак, любой поток — это объект, получающий определенное процессорное время. Всякое приложение Linux является процессом операционной системы. Примечание Объекты потоков не позволяют вам управлять атрибутами безопасности или размером стека ваших потоков. Для того чтобы контролировать их, вам необходимо использовать функцию BegmThread, которая рассматривается далее. Для того чтобы использовать объекты потоков в вашем приложении, вам нужно создать потомок класса TThread. Класс TThread был создан для облегчения написания приложений с несколькими потоками. Он гарантирует совместимость при работе с библиотекой визуальных компонентов (CLX) Kylix. Вообще, при создании многопоточных приложений необходимо следовать приведенным ниже рекомендациям: используйте синхронизацию в случае, когда несколько потоков пытаются получить доступ к одному ресурсу; большинство методов, которые обращаются к объектам CLX и изменяют содержимое формы, должны вызываться из главного CLX-потока или использовать объект синхронизации. Определение объекта TThread находится в модуле Classes и имеет вид, приведенный в листинге 14.1.
Окно Environment OptionsРисунок 6.10. Окно Environment Options Окно настройкиРисунок 6.2. Окно настройки В окне настройки имеются три вкладки: Toolbars, Commands и Options. Вкладка Toolbars (см. Рисунок 6.2) позволяет показывать или скрывать вкладки панели инструментов. На вкладке Commands (Рисунок 6.3) располагаются категории команд и сами команды, которые можно выбирать, щелкнув на их названии и на необходимой панели инструментов. В результате вышеописанных действий на выбранной панели инструментов появится новая кнопка. Для удаления ненужной кнопки с панели инструментов достаточно щелкнуть на кнопке мышью и, удерживая ее, переместить на любое место экрана вне панелей инструментов. Вкладка Commands — это очень удобное средство добавления практически любых команд на панель инструментов для быстрого доступа. Наконец, вкладка Options (Рисунок 6.4) позволяет работать со всплывающими подсказками (tips) панелей инструментов. Если вы обратили внимание, когда вы подводите курсор к любому объекту панелей инструментов, появляются надписи, объясняющие назначение этого объекта.  Окно New ItemsРисунок 18.1. Окно New Items  Окно появляющееся при обработке события OnKeyDownРисунок 8.21. Окно, появляющееся при обработке события OnKeyDown Событие OnKeyPress наступает при нажатии пользователем символьной клавиши. Данное событие имеет параметр Key, который содержит символ нажатой, клавиши и имеет тип Сhar. При этом различаются символы верхнего и нижнего регистров, а также раскладка клавиатуры. Примечание Событие OnMouseDown наступает при нажатии пользователем любой кнопки мыши в тот момент, когда указатель мыши находится над компонентом. Данное событие имеет параметры Button, Shift, X и Y. Параметр Button определяет, какая кнопка мыши нажата: mbLeft — левая кнопка; mbMiddle — средняя кнопка; mbRight — правая кнопка. Параметр Shift равносилен параметру Shift для событий, связанных с обработкой клавиатуры. Таким образом, можно обрабатывать нажатие любой кнопки мыши одновременно с клавишами <Shift>, <Ctrl> или <Alt>. Параметры X и Y содержат координаты указателя мыши в области компонента. Событие OnMouseUp наступает, когда пользователь отпускает любую кнопку мыши над компонентом. По своим функциям и параметрам данное событие аналогично событию OnMouseDown. Событие OnMouseMove наступает при перемещении указателя мыши над компонентом. Данное событие возникает независимо от того, нажаты какие-либо кнопки мыши или нет. Примечание Событие OnPaint наступает, когда приложение получает сообщение о необходимости перерисовки испорченного изображения. Изображение может испортиться от перекрытия окон одного или нескольких приложений. В обработчике данного события программист должен разместить процедуру, выполняющую перерисовку изображения. Например, если на форме был размещен рисунок, хранящийся в компоненте BitMap, можно для перерисовки изображения использовать следующий обработчик события OnPaint: Canvas.Draw (0, 0, BitMap ); Событие OnProgress наступает при прохождении медленных процессов, связанных с изменением графического изображения. Данное событие позволяет строить индикаторы хода выполнения процесса. Событие OnProgress имеет следующие параметры: Stage, PercentDone, RedrawNow,R и Msg. Параметр Stage предназначен для указания стадии прогресса (начало, продолжение, окончание) и может принимать значения psStarting (начало), psRunning (продолжение), psEnding (окончание). Параметр PercentDone показывает, какая часть процесса выполнена. Параметр RedrawNow показывает, может ли в настоящий момент изображение успешно отобразиться на экране. Параметр R служит для указания области изображения, которая изменена и требует перерисовки. Наконец, параметр Msg служит для отображения сообщений о ходе процесса. Этот параметр имеет строковый тип. Параметр Msg может быть пустым. 
|