Статьи Королевства Дельфи

  35790931     

L3_pas


unit F_TbDef;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Db, DBTables, ExtCtrls, Buttons, ComCtrls, DbItfT, DbItf, MnT;

Type

TTbDefFr = class (TForm)

TbFieldsListBox: TListBox;

NewFieldButton: TButton;

OkButton: TButton;

CancelButton: TButton;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Label7: TLabel;

Label8: TLabel;

Label9: TLabel;



Bevel1: TBevel;

Label10: TLabel;

TbNameLbl: TLabel;

procedure NewFieldButtonClick(Sender: TObject);

procedure CancelButtonClick(Sender: TObject);

procedure OkButtonClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure TbFieldsListBoxClick(Sender: TObject);

procedure FormActivate(Sender: TObject);

private

FModalRes : Boolean;

FpTTableInfo : pTTableInfo;

FDbInterface : TDbInterface;

FpTInfoCategory : pTInfoCategory;

procedure Set_FDbInterface(const Value: TDbInterface);

procedure Set_FpTInfoCategory(const Value: pTInfoCategory);

public

{ Public declarations }

Function Execute : Bool;

Property ppTTableInfo : pTTableInfo read FpTTableInfo write FpTTableInfo;

Property ppTInfoCategory : pTInfoCategory read FpTInfoCategory

write Set_FpTInfoCategory;

published

Property DbInterface : TDbInterface read FDbInterface write Set_FDbInterface;

end;

Var

TbDefFr: TTbDefFr;

implementation

uses

F_FldDlg;

{$R *.DFM}

procedure TTbDefFr.NewFieldButtonClick(Sender: TObject);

begin

if FldDlgFr = nil then

FldDlgFr := TFldDlgFr.Create(nil);

try

// Создаем новую структуру таблицы

FldDlgFr.DbInterface := FDbInterface;

FDbInterface.Init_NpTFieldInfo;

FDbInterface.Current_pTTableInfo := FDbInterface.N_pTTableInfo;

FldDlgFr.ShowModal;

if FldDlgFr.Execute then

begin { Структура заполнена успешно - сохранить ее }

TbFieldsListBox.Items.AddObject(

FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldCaption'],

Pointer(FDbInterface.N_pTFieldInfo));

FpTTableInfo.sFieldsL.Add(Pointer(FDbInterface.N_pTFieldInfo));


end

else { Структура не нужна - удалить из памяти }

FDbInterface.Kill_NpTFieldInfo;

finally

FreeAndNil(FldDlgFr);

end;

end;

// Завершение создания таблицы в БД

Function TTbDefFr.Execute: Bool;

Var

wTb : TTable;

begin

Result := False;

if not FModalRes then

Exit;

wTb := TTable.Create(nil);

wTb.DatabaseName := FDbInterface.DatabaseName;

try

wTb.TableName := 'T_Tables';

if not wTb.Exists then

Create_T_Tables(wTb);

wTb.TableName := 'T_Fields';

if not wTb.Exists then

Create_T_Fields(wTb);

finally

wTb.Free;

end;

FpTTableInfo.spTInfoCategory := FpTInfoCategory;

Result := FDbInterface.CreateFbTableBySQL(FpTTableInfo,

TbFieldsListBox.Items);

end;

procedure TTbDefFr.CancelButtonClick(Sender: TObject);

begin

FModalRes := False;

Close;

end;

procedure TTbDefFr.OkButtonClick(Sender: TObject);

begin

FModalRes := True;

Close;

end;

procedure TTbDefFr.FormCreate(Sender: TObject);

begin

Label4.Caption := '';

Label5.Caption := '';

Label7.Caption := '';

Label8.Caption := '';

TbNameLbl.Caption := '';

end;

// Вывод сведений о поле для наблюдения

procedure TTbDefFr.TbFieldsListBoxClick(Sender: TObject);

Var

k : Integer;

wpFldInfo : pTFieldInfo;

wTFieldType : TFieldType;

begin

Label4.Visible := False;

Label5.Visible := False;

Label7.Visible := False;

Label8.Visible := False;

if TbFieldsListBox.Items.Count = 0 then

Exit;



k := TbFieldsListBox.ItemIndex;

if TbFieldsListBox.Items.Objects[k] = nil then

Exit;



wpFldInfo := pTFieldInfo(TbFieldsListBox.Items.Objects[k]);

wTFieldType := wpFldInfo.sFieldType;

Label4.Caption := FDbInterface.FbFieldArray[wTFieldType].sDescr;

Label5.Caption := IntToStr(wpFldInfo.sFieldSize) +

'/' + IntToStr(wpFldInfo.sFieldMBytes);

Label7.Caption := wpFldInfo.sFieldAttr.Values['sFieldCaption'];

Label8.Caption := wpFldInfo.sFieldAttr.Values['sFieldDescr'];

Label4.Visible := Label4.Caption <> '';

Label5.Visible := Label5.Caption <> '';

Label7.Visible := Label7.Caption <> '';

Label8.Visible := Label8.Caption <> '';



Label2.Visible := Label4.Visible;

Label3.Visible := Label5.Visible;

Label6.Visible := Label7.Visible;

Label9.Visible := Label8.Visible;

end;

procedure TTbDefFr.Set_FDbInterface(const Value: TDbInterface);

begin

FDbInterface := Value;

end;

procedure TTbDefFr.Set_FpTInfoCategory(const Value: pTInfoCategory);

begin

FpTInfoCategory := Value;

apAutoID := True;

end;

procedure TTbDefFr.FormActivate(Sender: TObject);

Var

k : Integer;

wpTFieldInfo : pTFieldInfo;

begin

Label10.Show;

TbNameLbl.Caption := FpTTableInfo.sTableAttr.Values['sTableCaption'];

// ..прикрепить и показать имеющиеся поля

for k := 0 to FpTTableInfo.sFieldsL.Count - 1 do

begin

wpTFieldInfo := pTFieldInfo(FpTTableInfo.sFieldsL[k]);

TbFieldsListBox.Items.AddObject(

wpTFieldInfo.sFieldAttr.Values['sFieldCaption'],

Pointer(wpTFieldInfo));

end;

end;

end.


Литература


Billy Gates — MSDN. Гордеев О. В. — Программирование звука в Windows. СПб.: БХВ — Санкт-Петербург, 1999 384 с.

Сергей Козлов




Подробное рассмотрение упомянутых функций API выходит за рамки этой статьи, поэтому интересующихся отсылаю к справке Delphi по Win32 (она, по моему скромному мнению, организована лучше, чем MSDN), а также к книге Джеффри Рихтера "Windows для профессионалов".



Менеджер объектов


В задачу менеджера входит организация взаимодействия между визуальным компонентом инспектора и инспектируемым объектом. Может возникнуть вопрос, для чего нужен посредник? Для ответа на этот вопрос можно выделить несколько моментов: желание отделить визуальную часть инспектора от какой бы то ни было связи с конкретными объектами и конкретными методами работы с ними. Тем, кто программировал на Microsoft Visual C++, прекрасно знакома методология "документ-вид", а программисты на SmallTalk сразу вспомнят "модель-контроллер-вид", желание предоставить потенциальную возможность конструирования информации для инспектирования различными способами, обеспечение независимости от способа предоставления метаданных. Например, для какого-то конкретного проекта мы предпочли бы описывать метаданные на XML или каким-то иным способом, потенциальная возможность использования визуального компонента для реализации клона Delphi-инспектора, используя только ту информацию, которую в виде RTTI формирует компилятор (без предоставления дополнительных метаданных). А кроме того, в этом случае нам потребовалось бы два различных представления - для свойств и для методов, потенциальная возможность групповой инспекции объектов. Учитывая эти аргументы, введение посредника становится достаточно обоснованным. Основные задачи менеджера объектов можно сформулировать так: отделить визуальное представление инспектора от данных, с которыми он работает, представить инспектору свойства инспектируемого объекта в наиболее удобной для него форме, то есть, в виде древовидной структуры свойств, передавать инспектору значения свойств объекта и изменять значения свойств объекта при их изменении в инспекторе, взаимодействовать с метаданными и перенаправлять классам метаданных запросы на требования инспектора, например, на отображение какого-то специфического диалога, заполнение списка перечислимых значений свойства и так далее. Используя терминологию паттернов проектирования можно заметить, что менеджер объектов является фасадом, который сводит к минимуму зависимость подсистем инспектора друг от друга и контролирует обмен информации между ними. Далее будет описана только одна реализация менеджера. Конкретика этого менеджера состоит в том, что он использует те метаданные, которые формируются на основе метаклассов, то есть, поддерживает описанный выше способ организации метаданных. Как уже было сказано, можно было бы построить целое семейство различных менеджеров, но в данной версии инспектора я ограничился только одним менеджером.


TGsvObjectInspectorObjectInfo = class public constructor Create; destructor Destroy; override; function ObjectName: String; virtual; function ObjectTypeName: String; virtual; function ObjectHelp: Integer; virtual; function ObjectHint: String; virtual; function PropertyInfo(Index: Integer): PGsvObjectInspectorPropertyInfo; procedure FillList(Info: PGsvObjectInspectorPropertyInfo; List: TStrings); virtual; procedure ShowDialog(Inspector: TComponent; Info: PGsvObjectInspectorPropertyInfo; const EditRect: TRect); virtual; function GetStringValue(Info: PGsvObjectInspectorPropertyInfo): String; virtual; procedure SetStringValue(Info: PGsvObjectInspectorPropertyInfo; const Value: String); virtual; function GetIntegerValue(Info: PGsvObjectInspectorPropertyInfo): LongInt; virtual; procedure SetIntegerValue(Info: PGsvObjectInspectorPropertyInfo; const Value: LongInt); virtual; property TheObject: TObject read GetObject write SetObject; end;
Можно заметить, что методы менеджера напоминают методы базового класса метаданных TGsvObjectInspectorTypeInfo. И это не случайно, ведь в большинстве случаев менеджер просто перенаправляет запрос соответствующему методу конкретного класса метаданных, то есть, играет роль диспетчера. Метод PropertyInfo напоминает метод ChildrenInfo метакласса - для каждого значения индекса функция возвращает указатель на метаданные свойства, а при завершении итерации по всем свойствам она возвращает nil. Наиболее существенное отличие от ChildrenInfo состоит в том, что PropertyInfo рекурсивно обходит все вложенные свойства и дополняет структуру TGsvObjectInspectorPropertyInfo несколькими динамически формируемыми полями. Здесь уместно упомянуть, что при описании записи TGsvObjectInspectorPropertyInfo мы опустили несколько полей, которые были неважны с точки зрения метаданных. Вот эти поля: HasChildren: Boolean; Level: Integer; Expanded: Boolean; TheObject: TObject; NestedObject: TObject; HasChildren - указывает на наличие у данного свойства вложенных подсвойств, Level - уровень свойства в полном дереве свойств, Expanded - признак того, что вложенные свойства раскрыты и отображаются, TheObject - объект или заместитель, которому принадлежит свойство, NestedObject - объект или заместитель вложенного свойства. Первые три поля используются только визуальным компонентом инспектора, а последние два поля - менеджером и метаклассами. Для доступа к метаданным менеджер обращается к реестру метаданных, используя при поиске имя типа инспектируемого объекта. Кроме того, менеджер обращается к реестру при рекурсивном обходе вложенных свойств. Назначение остальных методов: FillList - перенаправляет запрос на заполнение списка перечислимых значений свойства конкретному метаклассу вложенного свойства, ShowDialog - перенаправляет запрос на отображение диалога-мастера конкретному метаклассу вложенного свойства, GetStringValue - получает значение свойства инспектируемого объекта в строковом виде на основе RTTI. Если свойство имеет вложенный метакласс, то используется его специализация (запрос перенаправляется метаклассу), а иначе выполняется стандартное преобразование, например, из типа Double в тип String, SetStringValue - устанавливает значение свойства на основе заданного строкового значения, GetIntegerValue и SetIntegerValue - подобны двум предыдущим методам, но специализированы не на строковом, а на целочисленном значении свойства. Говоря о перенаправлении запросов от менеджера, нельзя не упомянуть о тех методах метаклассов, которых мы только коснулись в первом разделе статьи. В текущей версии инспектора определено несколько вспомогательных специализированных классов, порожденных от базового класса TGsvObjectInspectorTypeInfo. Это: TGsvObjectInspectorTypeListInfo - предоставляет дополнительную функциональность при работе со свойствами, реализующими перечислимые типы. Такие свойства отображаются в инспекторе как выпадающие списки, TGsvObjectInspectorTypeSetInfo - помогает описывать свойства-множества, TGsvObjectInspectorTypeFontInfo - специализируется на описании свойства типа TFont и инкапсулирует стандартный Windows-диалог выбора шрифта, TGsvObjectInspectorTypeColorRGBInfo - специализируется на описании простого свойства типа TColor и инкапсулирует стандартный Windows-диалог выбора цвета. Все эти классы являются вспомогательными и уменьшают трудозатраты на описание конкретных классов метаданных. Для примера рассмотрим подробнее парочку из указанных вспомогательных классов.



type TGsvObjectInspectorListItem = record Name: String; // имя элемента списка Data: LongInt; // значение элемента списка end; PGsvObjectInspectorListItem = ^TGsvObjectInspectorListItem; TGsvObjectInspectorTypeListInfo = class(TGsvObjectInspectorTypeInfo) protected class function ListEnumItems(Index: Integer): PGsvObjectInspectorListItem; virtual; public class procedure FillList(AObject: TObject; List: TStrings); override; class function IntegerToString(const Value: LongInt): String; override; class function StringToInteger(const Value: String): LongInt; override; end; class function TGsvObjectInspectorTypeListInfo.ListEnumItems( Index: Integer): PGsvObjectInspectorListItem; begin Result := nil; end; class procedure TGsvObjectInspectorTypeListInfo.FillList(AObject: TObject; List: TStrings); var i: Integer; p: PGsvObjectInspectorListItem; begin i := 0; p := ListEnumItems(0); while Assigned(p) do begin List.AddObject(p^.Name, TObject(p^.Data)); Inc(i); p := ListEnumItems(i); end; end; class function TGsvObjectInspectorTypeListInfo.IntegerToString( const Value: Integer): String; var i: Integer; p: PGsvObjectInspectorListItem; begin Result := ''; i := 0; p := ListEnumItems(0); while Assigned(p) do begin if p^.Data = Value then begin Result := p^.Name; Break; end; Inc(i); p := ListEnumItems(i); end; end; class function TGsvObjectInspectorTypeListInfo.StringToInteger( const Value: String): LongInt; var i: Integer; p: PGsvObjectInspectorListItem; begin Result := 0; i := 0; p := ListEnumItems(0); while Assigned(p) do begin if p^.Name = Value then begin Result := p^.Data; Break; end; Inc(i); p := ListEnumItems(i); end; end;
Как уже было сказано, класс TGsvObjectInspectorTypeListInfo предоставляет дополнительную функциональность при работе со свойствами - перечислимыми типами. Класс переопределяет методы IntegerToString, StringToInteger и FillList, а для задания списка перечислений вводит новый виртуальный метод ListEnumItems - этот метод напоминает ChildrenInfo базового класса, но возвращает не типовые метаданные, а свойства каждого элемента перечисления - его имя и ассоциированное с ним значение - эти параметры определены записью TGsvObjectInspectorListItem. Конкретный метакласс, описывающий свойства-перечисления может быть порожден от класса TGsvObjectInspectorTypeListInfo, причем достаточно будет переопределить только метод ListEnumItems. Метод FillList выполняет итерацию по всем перечислимым значениям, вызывая ListEnumItems с монотонно возрастающим индексом до тех пор, пока ListEnumItems не вернет значение nil. Результаты итерации передаются визуальному компоненту инспектора через параметр List. Для преобразования строкового вида значения перечисления к целочисленному виду и для обратного преобразования служат методы StringToInteger и IntegerToString, алгоритм которых очень похож - оба они итерируют список перечислений, но в первом случае критерием для поиска является строковое имя, а во втором случае - ассоциированное с ним значение. Очевидно, что такой базовый класс может быть использован для любых перечислимых типов, причем даже таких, в которых значения перечисления не образуют упорядоченную монотонную последовательность.



type TGsvObjectInspectorTypeFontInfo = class(TGsvObjectInspectorTypeInfo) public class procedure ShowDialog(Inspector: TComponent; Info: PGsvObjectInspectorPropertyInfo; const EditRect: TRect); override; class function ObjectToString(const Value: TObject): String; override; end; class procedure TGsvObjectInspectorTypeFontInfo.ShowDialog( Inspector: TComponent; Info: PGsvObjectInspectorPropertyInfo; const EditRect: TRect); var dlg: TFontDialog; fnt: TFont; begin if not Assigned(Info) then Exit; if not Assigned(Info^.NestedObject) then Exit; if not (Info^.NestedObject is TFont) then Exit; fnt := TFont(Info^.NestedObject); dlg := TFontDialog.Create(Inspector); try dlg.Font.Assign(fnt); if dlg.Execute then fnt.Assign(dlg.Font); finally dlg.Free; end; end; class function TGsvObjectInspectorTypeFontInfo.ObjectToString( const Value: TObject): String; begin if Assigned(Value) then if Value is TFont then with TFont(Value) do Result := Format('%s, %d', [Name, Size]); end;
Класс TGsvObjectInspectorTypeFontInfo демонстрирует способ создания метакласса для специфического редактора свойства, в данном случае, для свойства-шрифта, имеющего тип TFont. Здесь переопределяются два метода - ShowDialog и ObjectToString. Методу ShowDialog передаются три аргумента: Inspector - родительский компонент для формы-диалога, Info - метаданные свойства, EditRect - прямоугольник, представляющий собой экранные координаты поля редактирования визуального компонента инспектора. Эти координаты можно использовать для того, чтобы расположить диалог, скажем, прямо под значением редактируемого свойства (подобно списку). Конечно, это имеет смысл только для небольших по размеру диалогов. Для свойств, отображающих диалог, менеджер заполняет поле метаданных NestedObject - оно указывает на инспектируемый объект или его заместитель. В данном случае менежер увидит, что свойство-шрифт является объектом-классом и определит его адрес, используя адрес объекта верхнего уровня в дереве объектов-свойств и имя свойства. Если бы это было простое свойство, например, TColor, то менеджер заполнил бы поле NestedObject указателем на объект текущего уровня. После того, как мы определили, что инспектируемое свойство действительно является объектом нужного нам типа (в данном случае TFont), мы создаем диалог, инициализируем его данные текущим значением свойства, отображаем диалог и при успешном завершении переносим новое значение свойства в инспектируемый объект. Другой метод класса - ObjectToString определяет то, как будет выглядеть значение свойства в инспекторе. В данном случае мы считаем, что основные свойства шрифта - это его имя и размер. Такой способ отображения отличается от того, что мы видим в инспекторе Delphi - в качестве значения объекта Delphi отображает имя его типа.


Метаданные


Можно придумать, вероятно, много различных способов организации метаданных. Например, метаданные объектов различных типов можно описывать в отдельном файле (или файлах) в каком-либо формате, например, как текст на языке XML. Структура метаданных может быть в этом случае сколь угодно сложной и содержать такие крупные разделы, как категория пользователя или локализация. Файлы метаданных можно распространять вместе с программой или внести их в ресурсы, размещаемые в самой программе или в DLL. Для доступа к метаданным потребуется некоторого рода база или список метаданных, индексируемых именем типа, а также XML-парсер для разбора текста. Я остановил свой выбор на таком способе - хранение метаданных в виде статических классов, регистрируемых в реестре метаданных. Статическими классами будем называть классы, которые содержат только классовые методы и ничего больше. Особенностью таких классов является то, что с ними можно работать без динамического инстанцирования экземляров во время выполнения. Метаданные вводятся как локальные константные записи, доступ к которым выполняется с помощью классовых методов. Все классы метаданных порождаются от базового статического класса TGsvObjectInspectorTypeInfo, виртуальные классовые методы которого переопределяются в классах метаданных. Определение TGsvObjectInspectorTypeInfo выглядит так:

TGsvObjectInspectorTypeInfo = class public class function ObjectName(AObject: TObject): String; virtual; class function TypeName: String; virtual; class function TypeInfo: PGsvObjectInspectorPropertyInfo; virtual; class function ChildrenInfo(Index: Integer): PGsvObjectInspectorPropertyInfo; virtual; class procedure FillList(AObject: TObject; List: TStrings); virtual; class procedure ShowDialog(Inspector: TComponent; Info: PGsvObjectInspectorPropertyInfo; const EditRect: TRect); virtual; class function IntegerToString(const Value: LongInt): String; virtual; class function StringToInteger(const Value: String): LongInt; virtual; class function CharToString(const Value: Char): String; virtual; class function StringToChar(const Value: String): Char; virtual; class function FloatToString(const Value: Extended): String; virtual; class function StringToFloat(const Value: String): Extended; virtual; class function ObjectToString(const Value: TObject): String; virtual; end;

Не вдаваясь пока в подробности, опишем, в целом, назначение методов класса. ObjectName - метод возвращает имя конкретного экземпляра инспектируемого объекта. Объект (или его заместитель) передается функции как аргумент, TypeName возвращает имя типа. Например, имя типа может быть таким - «Синхронный двигатель», а имя объекта - «Д 4/8», TypeInfo предоставляет метаданные о типе в целом, а ChildrenInfo - о всех его свойствах. ChildrenInfo за одно обращение возвращает информацию об одном свойстве, которое индексируется аргументом Index. При выходе за индекс последнего свойства ChildrenInfo возвращает nil. Так выполняется итерация по всем свойствам - инспектор вызывает функцию ChildrenInfo с монотонно возрастающим (от нуля) значением индекса и завершает итерацию, когда функция возвращает nil, FillList и ShowDialog реализуют необходимую функциональность в том случае, когда свойство представлено как список значений или когда для редактирования свойства требуется специализированный диалог-мастер. Все остальные функции реализуют различные вспомогательные преобразования, которые служат для преобразования значений свойств в строковый вид для отображения в инспекторе и, наоборот, преобразования строковых значений, измененных в инспекторе, к реальным типам свойств. Методы класса не являются абстрактными, а реализуют свою функциональность для некоторого общего случая (по умолчанию), например, в качестве имени объекта возвращается пустая строка, а преобразование из целого в строку выполняется стандартной функцией IntToStr. Это позволяет переопределять в наследуемых классах только некоторые, действительно нужные, методы. Наибольший интерес для нас будет представлять тип PGsvObjectInspectorPropertyInfo - указатель на структуру типа TGsvObjectInspectorPropertyInfo. Данные именно этого типа возвращаются методами TypeInfo и ChildrenInfo. Каждое инспектируемое свойство (а также весь тип в целом) описывается константной записью. Для простоты опустим служебные поля, которые неважны с точки зрения метаданных, и которые не задаются в константной записи:


TGsvObjectInspectorPropertyInfo = record Name: String; Caption: String; Kind: TGsvObjectInspectorPropertyKind; Tag: LongInt; NestedType: String; NestedClass: TGsvObjectInspectorTypeInfoClass; Help: Integer; Hint: String; end; PGsvObjectInspectorTypeInfo = ^TGsvObjectInspectorTypeInfo;
Поле Name содержит имя published-свойства в инспектируемом объекте или в его заместителе. Доступ к свойствам основан на RTTI и требует, чтобы инспектируемые объекты (или их заместители) компилировались с созданием RTTI, Поле Caption содержит имя свойства, под которым оно будет отображаться в инспекторе, Kind. Это поле декларирует особенности отображения значения свойства в инспекторе, например, значение может быть текстом, списком, множеством, сложным объектом, который редактируется специальным редактором и так далее, Tag используется для задания специфических данных свойства. В текущей версии инспектора он использует только для описания свойств-множеств, NestedType и NestedClass. Два этих поля предоставляют альтернативные возможности указания типа вложенного свойства. Здесь целесообразно отметить, что вложенные свойства рассматриваются и описываются как самостоятельные - это позволяет описать их один раз и использовать в других классах метаданных. Забегая вперед, скажу что NestedType используется в том случае, если класс метаданных регистрируется в реестре метаданных, а NestedClass - если вложенный объект описывается в известном программном модуле и доступен при компиляции. Вложенное свойство трактуется весьма широко и, в общем случае, служит для ссылки на другой класс метаданных, который может быть действительно сложным объектом, или предоставлять метаданные об одном-единственном простом свойстве. Важным здесь является то, что классы метаданных могут ссылаться на другие метаклассы и создавать внутреннюю иерархическую структуру свойств инспектируемого объекта, Поля Help и Hint в особых комментариях не нуждаются. Поле Kind может принимать (в данной версии инспектора) следующие значения: pkText - значение свойства отображается как текст, доступный для редактирования, pkDropDownList - значение свойства доступно для выбора из списка возможных значений, pkDialog - значения свойства редактируются специализированным диалогом-мастером, pkFolder - фиктивное свойство, не имеющее значения, но позволяющее выстроить иерархический список дочерних подсвойств, pkReadOnlyText - аналогично pkText, но доступно только для чтения, pkImmediateText - аналогично pkText, но изменение значения свойства фиксируются немедленно при любом изменении текста, pkBoolean - свойство отображается как CheckBox, pkTextList - подобно pkDropDownList, но значение свойства можно редактировать, то есть, диапазон значений не ограничен списком, pkSet - свойство-множество, отображается как родительское для вложенного списка элементов множества, каждый из которых представляется как логическое значение, pkColor - свойство для выбора цвета из заданного списка, pkColorRGB - подобно предыдущему, но цвет задается и редактируется в виде R.G.B и имеется возможность выбора цвета с помощью стандартного Windows-диалога. Для иллюстрации всего сказанного приведем конкретный пример. Для простоты предположим, что мы будем инспектировать объекты всем известного типа TLabel. Причем, будем считать, что пользователю доступны для инспекции только свойства Caption, Font, Color, а также координаты и размеры. Класс метаданных для TLabel будет, в данном случае, таким:



type TLabel_INFO = class(TGsvObjectInspectorTypeInfo) public class function ChildrenInfo(Index: Integer): PGsvObjectInspectorPropertyInfo; override; end; class function TLabel_INFO.ChildrenInfo(Index: Integer): PGsvObjectInspectorPropertyInfo; const DSK: array[0..3] of TGsvObjectInspectorPropertyInfo = ( ( Name: 'Caption'; Caption: 'Надпись'; Kind: pkImmediateText ), ( NestedClass: TGsvBounds_INFO ), ( Name: 'Font'; NestedType: 'TFont' ), ( Name: 'Color'; Caption: 'Цвет фона'; NestedType: 'TGsvColorRGB' ) ); begin if Index
Первый элемент массива метаданных описывает свойство Caption, для него задается вид pkImmediateText, чтобы любое изменение названия метки сразу же отображалось на форме. Второй элемент очень короток - это ссылка на другой метакласс, описывающий положение и размеры метки. В данном случае мы предполагаем, что метакласс TGsvBounds_INFO описан либо в текущем программном модуле, либо в другом модуле, указанном оператором uses. Отметим, что мы не задаем здесь никаких других аттрибутов, полагая, что они будут взяты из класса TGsvBounds_INFO, хотя можно было бы их явно указать - в этом случае инспектор использовал бы явно указанные аттрибуты, а не аттрибуты вложенного свойства. Следующий элемент подобен предыдущему, но для него мы указываем имя published-свойства, а имя метакласса передаем через поле NestedType, предполагая, что этот тип зарегистрирован в реестре метаданных. И, наконец, последний элемент - цвет, для которого мы указываем имя свойства, название и имя класса, который реализует функциональность по представлению значения цвета в виде RGB. Последнее, что мы должны сделать, чтобы объекты типа TLabel были доступны для инспекции,- это зарегистрировать класс TLabel_INFO в реестре метаданных. Удобнее всего это можно сделать так:

initialization GsvRegisterTypeInfo(TLabel_INFO);
Поскольку в предложенном описании даны ссылки на другие метаклассы, то продолжим пример и предоставим их реализацию.

type TGsvBounds_INFO = class(TGsvObjectInspectorTypeInfo) public class function TypeInfo: PGsvObjectInspectorPropertyInfo; override; class function ChildrenInfo(Index: Integer): PGsvObjectInspectorPropertyInfo; override; end; class function TGsvBounds_INFO.TypeInfo: PGsvObjectInspectorPropertyInfo; const DSK: TGsvObjectInspectorPropertyInfo = ( Caption: 'Положение и размер'; Kind: pkFolder; Help: 1234; Hint: 'Координаты верхнего левого угла и размеры' ); begin Result := @DSK; end; class function TGsvBounds_INFO.ChildrenInfo(Index: Integer): PGsvObjectInspectorPropertyInfo; const DSK: array[0..3] of TGsvObjectInspectorPropertyInfo = ( ( Name: 'Left'; Caption: 'Левый край'; Kind: pkText ), ( Name: 'Top'; Caption: 'Верхний край'; Kind: pkText ), ( Name: 'Width'; Caption: 'Ширина'; Kind: pkText ), ( Name: 'Height'; Caption: 'Высота'; Kind: pkText ) ); begin if Index
Метакласс TGsvBounds_INFO перегружает два метода базового класса. Метод TypeInfo возвращает указатель на метаданные всего класса в целом. Это позволяет задать аттрибуты свойства в одном метаклассе и ссылаться на них из множества других метаклассов. Метод возвращает указатель на константную запись, в которой мы задаем название, вид поля и справочную информацию о свойстве. Метод ChildrenInfo описывает координаты верхнего левого угла прямоугольника и его размеры, ссылаясь на соответствующие published-свойства компонента. Метакласс для шрифта будет задавать имя шрифта, его размер, стиль и цвет:



type TFont_INFO = class(TGsvObjectInspectorTypeFontInfo) public class function TypeInfo: PGsvObjectInspectorPropertyInfo; override; class function ChildrenInfo(Index: Integer): PGsvObjectInspectorPropertyInfo; override; end; class function TFont_INFO.TypeInfo: PGsvObjectInspectorPropertyInfo; const DSK: TGsvObjectInspectorPropertyInfo = ( Caption: 'Шрифт'; Kind: pkDialog ); begin Result := @DSK; end; class function TFont_INFO.ChildrenInfo(Index: Integer): PGsvObjectInspectorPropertyInfo; const DSK: array[0..3] of TGsvObjectInspectorPropertyInfo = ( ( Name: 'Name'; Caption: 'Имя'; Kind: pkText; Hint: 'Имя шрифта' ), ( Name: 'Size'; Caption: 'Размер'; Kind: pkText; Hint: 'Размер в пунктах' ), ( Name: 'Style'; Caption: 'Стиль'; Kind: pkSet; NestedClass: TFontStyles_INFO ), ( Name: 'Color'; Caption: 'Цвет'; Kind: pkColor; NestedClass: TGsvColor16_INFO ) ); begin if Index
Класс TFont_INFO порожден от класса TGsvObjectInspectorTypeFontInfo, в котором переопределены методы ShowDialog и ObjectToString. Метод ShowDialog вызывает стандартный Windows-диалог выбора шрифта, а метод ObjectToString выводит в качестве значения свойства Font строку, включающую имя шрифта и его размер. Свойства стиля и цвета заданы собственными метаклассами:

type TGsvColor16_INFO = class(TGsvObjectInspectorTypeListInfo) protected class function ListEnumItems(Index: Integer): PGsvObjectInspectorListItem; override; public class function TypeInfo: PGsvObjectInspectorPropertyInfo; override; end; TFontStyles_INFO = class(TGsvObjectInspectorTypeSetInfo) public class function ChildrenInfo(Index: Integer): PGsvObjectInspectorPropertyInfo; override; end; class function TGsvColor16_INFO.ListEnumItems(Index: Integer): PGsvObjectInspectorListItem; const DSK: array[0..15] of TGsvObjectInspectorListItem = ( ( Name: 'Черный'; Data: clBlack ), ( Name: 'Коричневый'; Data: clMaroon ), ( Name: 'Темнозеленый'; Data: clGreen ), ...... ( Name: 'Розовый'; Data: clFuchsia ), ( Name: 'Голубой'; Data: clAqua ), ( Name: 'Белый'; Data: clWhite ) ); begin if Index 'Цвет'; Kind: pkDropDownList ); begin Result := @DSK; end; class function TFontStyles_INFO.ChildrenInfo( Index: Integer): PGsvObjectInspectorPropertyInfo; const DSK: array[0..2] of TGsvObjectInspectorPropertyInfo = ( ( Name: 'Style'; Caption: 'Полужирный'; Kind: pkBoolean; Tag: Ord(fsBold) ), ( Name: 'Style'; Caption: 'Курсив'; Kind: pkBoolean; Tag: Ord(fsItalic) ), ( Name: 'Style'; Caption: 'Подчеркнутый'; Kind: pkBoolean; Tag: Ord(fsUnderline) ) ); begin if Index
Метакласс TGsvColor16_INFO порожден от TGsvObjectInspectorTypeListInfo, который переопределяет методы IntegerToString, StringToInteger и FillList, а для задания списка перечислений вводит новый виртуальный метод ListEnumItems - этот метод напоминает ChildrenInfo, но возвращает не типовые метаданные, а данные по каждому элементу перечисления - его имя и ассоциированное с ним значение. Метакласс TFontStyles_INFO порожден от TGsvObjectInspectorTypeSetInfo, переопределяющего метод IntegerToString. Вот каким получится вид инспектора при инспектировании объекта типа TLabel для определенных нами метаданных:
Может показаться, что нам потребовалось довольно много описаний, но нужно учесть, что все определенные выше метаклассы могут быть использованы в большом числе других классов, создавая, таким образом, дерево классов метаданных. Например, если бы мы захотели теперь создать метаданные для TButton, то нам потребовалось определить всего один метакласс TButton_INFO. Вы, вероятно, уже обратили внимание на то, как образуются имена метаклассов - к имени инспектируемого типа добавляется суффикс _INFO. Это основное соглашение об именовании метаклассов. Кроме него, можно вводить дополнительные соглашения. Если при инспектировании объектов предполагается учет категории пользователей, то имя метакласса может состоять из имени класса, категории и суффикса, например, TButton_EXPERT_INFO. Возможен и другой вариант, при котором метаклассы различных категорий пользователей располагаются в различных DLL. Последний вопрос, который остался неосвещенным - это реестр метаданных. Для того, чтобы инспектор мог получить доступ к метаданным, инспектор должен на основе типа объекта, который передан ему для инспекции, сформировать имя соответствующего метакласса и запросить реестр о ссылке на метакласс. Метаклассы, в свою очередь, должны иметь возможность регистрировать себя в реестре. Для этого имеются три глобальных процедуры:



procedure GsvRegisterTypeInfo(AClass: TGsvObjectInspectorTypeInfoClass); procedure GsvRegisterTypesInfo(AClasses: array of TGsvObjectInspectorTypeInfoClass); function GsvFindTypeInfo(const ATypeName: String): TGsvObjectInspectorTypeInfoClass;
Процедура GsvRegisterTypeInfo регистрирует метакласс в реестре метаданных. Регистрируемый метакласс передается по ссылке на класс, которая определяется как:

TGsvObjectInspectorTypeInfoClass = class of TGsvObjectInspectorTypeInfo;
Вторая процедура подобна первой, но позволяет зарегистрировать сразу несколько метаклассов, например:

GsvRegisterTypesInfo([TLabel_INFO, TFont_INFO, TButton_INFO)];
Удобнее всего регистрировать метаклассы в секции initialization того программного модуля, в котором они определяются. Третья функция выполняет поиск метакласса в реестре на основе его имени, причем она самостоятельно добавляет к имени суффикс _INFO, например, поиск метакласса по имени инспектируемого типа может выглядеть так: cls := GsvFindTypeInfo(obj.ClassName); Здесь obj - это экземпляр инспектируемого класса, а cls - ссылка на его метакласс. Если метакласс не найден в реестре, то функция возвращает nil. Реализация реестра метаданных весьма проста:

var GsvTypesInfo: TStringList; procedure GsvRegisterTypeInfo(AClass: TGsvObjectInspectorTypeInfoClass); begin if not Assigned(GsvTypesInfo) then begin GsvTypesInfo := TStringList.Create; GsvTypesInfo.Duplicates := dupIgnore; GsvTypesInfo.Sorted := True; end; GsvTypesInfo.AddObject(AClass.ClassName, TObject(AClass)); end; procedure GsvRegisterTypesInfo(aClasses: array of TGsvObjectInspectorTypeInfoClass); var i: Integer; begin for i := Low(AClasses) to High(AClasses) do GsvRegisterTypeInfo(AClasses[i]); end; function GsvFindTypeInfo(const ATypeName: String): TGsvObjectInspectorTypeInfoClass; var i: Integer; begin Result := nil; if Assigned(GsvTypesInfo) then if GsvTypesInfo.Find(ATypeName + '_INFO', i) then Result := TGsvObjectInspectorTypeInfoClass(GsvTypesInfo.Objects[i]); end;
Фактически, реестр представляет собой объект сортированного списка строк TStringList. Этот объект создается при регистрации первого метакласса. Поскольку список сортирован, то поиск в нем выполняется достаточно быстро. Каждый элемент списка содержит имя метакласса и ассоциированную с ним ссылку на метакласс.


Miniprog


Hello, MiniProg 1
Раздел Подземелье Магов

Я не знаю, к какой области "Королевства" отнести эту статью. В принципе, данная публикация подготавливалась для раздела "Hello, World".

Однако оказалось, что подавляющее количество достаточно опытных программистов, имеют лишь приблизительное понятие об изложенном материале. Почти полное отсутствие в интернете и литературе информации, по данной тематике и использованным в статье методам, оставляют надежду на то, что кому-то, возможно, будет интересно, а может быть и познавательно то, о чем здесь написано.
Первоначальная идея была проста, написать несложную программу, исходный текст которой можно было бы использовать как некий шаблон, с реализованной функциональностью, отвечающей наиболее часто выдвигаемым требованиям. Следует помнить о данной публикации то, что она навеяна темой форума "Delphi Kingdom VCL :)".

Желающие могут присоединиться: покритиковать, дополнить, исправить; и если изменения или найденные ошибки будут существенны, то будет написана новая статья.

Начнем, с требований, которым должна соответствовать программа:
1. Избегать использования компонентов сторонних производителей, стараться написать программу с помощью стандартных, для текущей версии Delphi, функций и процедур.
2. Исходный текст программы необходимо снабдить системой автоматической проверки корректности программного кода.
3. Интерфейс - SDI (MDI хорош для приложений вроде Word или Exceel).
4. Желательно предусмотреть возможность масштабирования размеров окон, а также размеров и положения всех визуальных элементов, расположенных на ней, после изменения размеров экранного шрифта. Размеры окон и визуальных компонентов не должны меняться при изменении разрешения экрана.
5. Программа должна следить за тем, что бы она была запущена в единственном числе, на данном компьютере, при этом при запуске второй копии должна активизироваться первая копия, даже если она находится в свернутом состоянии. Данная функция призвана защитить лишь от случайных или ошибочных действий пользователя, и ни как не претендует на роль "серьезной" защиты.
6. Программа должна иметь возможность запуска с командной строки, с использованием управляющих ключей.
7. Программа должна иметь возможность запуска, как в режиме консоли, так и в режиме с графическим интерфейсом.
8. Программа должна уметь показывать при запуске заставку, и иметь возможность, как изменения времени показа, так и полного отключения заставки. Данные режимы должны быть управляемы как с помощью командной строки, так и в режиме графического интерфейса.
9. Управляющие ключи командной строки, должны поддерживать, как минимум ключ "?" и/или "help"- вывод краткого пояснения о программе, и подсказки о доступных ключах, в режиме консоли. Ключ "concole" - запуск в режиме консоли. Ключ "nologo" - отключение показа заставки. Ключ "logo " c параметром, определяющим время показа заставки.
10. Необходимо предусмотреть возможность взаимодействия программы с конфигурационным файлом, для хранения и восстановления определенных параметров. Нужно уметь хранить в конфигурационном файле время показа заставки, а так же состояние и позицию окон.
11. Необходимо иметь возможность, в режиме с графическим интерфейсом, подключения к программе языковых настроек в виде перевода на различные языки надписей и сообщений. Основной язык программы английский.
Пункт 7 и все, что с ним связано, можно считать моим личным капризом, но мне приходится писать именно такие программы - исполняющиеся в обоих режимах. Для начала, реализации таких требований, должно хватить при создании приложений.

Ну что же, первый шаг, создание директории проекта, назовем его MiniProg, в которой расположим поддиректории:

DCU - откомпилированные dcu (такова моя привычка :), DOC - поместим текст данной статьи, DUNIT - система автоматического тестирования от SourceForge, IMAGE - для картинок и иконок, SOURCE - исходные тексты самой программы, TEST - исходные тексты тестирующих файлов.

Будем считать, что основная директория, MiniProg, предназначена для размещения в ней откомпилированной программы, файлов конфигурации и языковых настроек, а так же, для откомпилированной тестовой программы.
Создаем проект, главную форму называем просто и незатейливо - FMain. Cохраняем как файл Main.pas в поддиректории SOURCE. Проект сохраняем как MiniProg.dpr, там же :). Открываем меню Project | Options, переходим на страницу Directories/Conditionals, заносим в Output directory и в Unit output directory соответствующие пути. В нашем случай это будут "..\..\MiniProg" и "..\..\MiniProg\DCU". Можно и короче записать, но так нагляднее. Если есть иконка для программы, то устанавливаем её на странице Application, через Load Icon. Создадим новый unit, сохраним под именем Appl.pas. Зачем? Как задел на будущее, будем размещать в нем функции и процедуры, реализующие наши требования.
Теперь начнем выполнять пункт 2 наших требований, т.е. создавать тестирующую программу. В подкаталоге DUNIT расположены некоторые необходимые нам файлы, взятые из оригинального DUNIT , версии от 2002/01/17. И так, создаем новый проект, закрываем Unit1.pas, отказываемся от сохранения, проект назовем, без особой фантазии, testMiniProg.dpr и сохраняем в TEST. Удаляем всё из этого файла и помещаем в него такой код:

program testMiniProg; uses Forms, TestFrameWork, GUITestRunner; {$R *.res} begin Application.Initialize; GUITestRunner.RunRegisteredTests; end.

В настройках проекта, на странице Directories/Conditionals, заполняем поля Output directory и Unit output directory, так же, как и у проекта MiniProg. Дополнительно пропишем в Search path поддиректорий SOURCE и DUNIT. Вот теперь, можно создать новый unit с названием (как бы вы думали?) testAppl.pas и следующим содержанием:

unit testAppl; interface uses TestFramework, SysUtils, Controls, Forms, Appl; type TTestUnitAppl = class(TTestCase) published end; implementation initialization TestFramework.RegisterTest(TTestUnitAppl.Suite); end.

Можно откомпилировать testMiniProg и посмотреть на внешний вид нашей тестирующей программы. В дереве просмотра, с именем Test Hierarchy, будут заноситься наши тесты, серые квадратики, при успешном прохождении теста, будут окрашиваться зеленым цветов, иначе - красным или розовым (цвет может быть и синим). Тесты можно отключать галочками. В окнах, расположенных ниже, можно будет наблюдать сообщение о всякой всячине, в том числе и некоторое пояснение о крахе теста. Да, кстати, тесты запускаются кнопочкой, с изображением зеленого треугольника, но пока он окрашен в серый цвет, так как ни одного реального теста у нас нет. Вот, вкратце и всё, что пока нужно знать о DUNIT. Товарищи, желающие узнать о DUNIT больше, а так же патологические "ХочуВсёЗнайки", могут самостоятельно поискать дополнительную информацию. Хочу только заметить, что данная система проверки является портом с JUNIT, и создавалась для применения в проектах с использованием Xtreem Programming (сокращенно XP). Одной из отличительных особенностей данной методологии является глубокая неприязнь к ведению документации :). Подробнее и по-русски можно посмотреть здесь , там же приведены ссылки по этой тематике. Конечно же, возможности DUNIT гораздо шире, чем это будет показано в данном материале (перед самым окончанием статьи была найдена интересная ссылка - по ней можно ознакомиться с более изощренным применением DUNIT).

Попытаемся разобраться с проблемой масштабирования форм. Проведя то, что обычно называется предварительным расследованием; покопавшись в интернет, заглянув в хелп, почитав книги, спросив товарищей (нужное подчеркнуть); выяснилось что, можно принудить форму автоматически масштабировать собственные размеры, а так же размеры и положение размещенных на ней визуальных компонентов, при изменении размера экранного шрифта. Для этого необходимо проверить и если нужно установить свойства формы, в нашем случае FMain, ParentFont = False, Scaled = True, AutoScroll = False и PixelsPerInch равный PixelsPerInch текущего экрана. Данное утверждение верно для форм созданных с помощью Delphi 6.2, для более ранних версий не проверялось. Но, судя по количеству воплей на различных форумах - у некоторых такая проблема была. Впрочем, помнится, еще у М. Канту в "Delphi 2 for Windows95/NT" существовала небольшая глава, освещающая именно такой подход. После рассмотрения исходных кодов VCL Delphi выяснилось, что существует другая проблема, связанная с масштабированием. Дело в том, что свойства Constraints компонентов, к большому сожалению, не масштабируются. Придется заняться этим отдельно, иначе может нарушиться внешний вид формы.
Что делает программа, когда создает форму? Если у формы установлены свойства как было указано выше, то в зависимости от того, отличается PixelsPerInch (сокращенно PPI) формы от PPI экрана или нет, происходит умножение значений местоположения компонентов на "новый" PPI и деление на "старый" PPI (в действительности, конечно, всё сложнее, но на первых порах и такого понимания достаточно). Будем называть эту функцию ScaleValue.
Откроем проект testMiniProg, и откроем в нем файлы testAppl.pas и Appl.pas из поддиректории SOURCE. Теперь самое странное: в testAppl.pas создаем процедуру проверки TestScaleValue, и объявляем её в published свойствах TTestUnitAppl:

unit testAppl; interface uses TestFramework, SysUtils, Controls, Forms, Appl; type TTestUnitAppl = class(TTestCase) published procedure TestScaleValue; end; implementation procedure TTestUnitAppl.TestScaleValue; var Test: integer; begin Test := ScaleValue(120,96,120); Check( Test = 96, Format('return wrong %d',[Test])); end; initialization TestFramework.RegisterTest(TTestUnitAppl.Suite); end.

Главное действие в этом unit, происходит в теле процедуры TestScaleValue, по вызову функции Check, в которой проходит проверки первого параметра, и если он False, то тест считается неудачным. Второй параметр функции Check - сообщение, в котором можно написать, в краткой форме, всё, что вы думаете об отрицательном результате тестирования :). Почему, при заданных значениях входных параметров, в результате должно получиться именно 96? - можно понять в результате несложных математических преобразований исходной формулы. Менее успешные математики могут проверить на калькуляторе :). Что же, мы создали тестирующую процедуру, которая проверит корректность работы нашей функции, при чем сделает это автоматически, стоит лишь запустить тесты. Следует сказать, что проверяться функция будет при каждом запуске тестовой программы, т.е. если вы впоследствии поменяете текст функции, и сделаете это некорректно, то программа тут же сообщит вам об этом. Еще одним положительным свойством такого тестирования, является то, что в саму программу не вносится ни каких посторонних тестирующих и проверяющих функций. Далее, в файле Appl.pas, создаем саму функцию:

function ScaleValue(Value, NewPPI, OldPPI: integer): integer; begin Result := MulDiv(Value, NewPPI, OldPPI); end;

Компилируем, запускаем программу, нажимаем на зеленый треугольник - всё зеленое! Замечательно, первый и пока единственный тест пройден. Если кто-то не заметил, то поясню, что сначала была создана тестирующая процедура, проверяющая результат функции, и только потом создавалась сама функция. Несколько необычно, но именно такой порядок рекомендует методология XP. Вообще, если призадуматься, то в этом можно узреть глубокий смысл, который заключен в том, что до создания функции мы ДОЛЖНЫ хорошо себе представлять результат :). Вроде бы тривиальная мысль, но многих ошибок в программах не было бы, если бы кодеры всегда следовали этому правилу. Подход, продемонстрированный выше, просто вынуждает поступать именно так. Другим положительным моментом предварительного создание тестовых функций является то что, в конечном счете, изначально "большие" функции будут разбиты на более мелкие и легко тестируемые, что то же неплохо. Кстати, XP настоятельно рекомендует заниматься рефакторингом, по-простому - переписыванием исходного текста, с целью его улучшения. Правда, в отличие от банального исправления ошибок и внесения уточнений, рефакторить рекомендуется только тогда, когда в этом действительно возникла необходимость. Но вообще, код пишется исключительно в требованиях текущего момента, т.е. даже если вы знаете, что какая то дополнительная функциональность вам обязательно понадобиться в дальнейшем - не прилагайте ни малейшего усилия, для её реализации. На этапе рефакторинга всегда можно вернуться к этому, если конечно понадобиться :).
Очевидно, что нам нужны функции, которые бы возвращали значения PPI как времени создания, так и времени исполнения программы, назовем их RtmPPI и DsgnPPI. Напишем тест. Подумав, решаем, что RtmPPI и DsgnPPI должны быть равны по значениям, если разработка программы и тестирование происходит при одних и тех же режима экрана:

procedure TTestUnitAppl.TestDsgnVsRtmPPI; begin Check( DsgnPPI = RtmPPI, Format('Design time PixelsPerInch not %d DPI', [RtmPPI])); end;

По крайней мере, такой тест напомнит вам, что при тестировании значение DsgnPPI должно быть равно PPI вашего экрана. Один совет, связанный с масштабированием форм - старайтесь создавать все свои формы при одном и том же PPI, это убережет вас от неприятных эффектов в дальнейшем, либо вам придется написать специальный тест, который будет проверять значения PPI всех форм, а это часто очень утомительно :). Кстати, этот тест наводит на мысль о том, что не плохо было бы завести функцию, которая бы сообщала, изменилось PPI или нет, и она нам нужна именно сейчас, что бы включить в тест. Сам текст функций выглядит следующим образом:

function RtmPPI: integer; begin Result := Screen.PixelsPerInch; end; function DsgnPPI: integer; begin Result := 120; end; function IsChangePPI: boolean; begin Result := DsgnPPI <> RtmPPI; end;

К сожалению, функция DsgnPPI возвращает результат, просто используя константу, которая выставляется в зависимости от конкретного PPI, используемого при дизайне (у меня это 120, у вас может быть и другое значение). Несмотря на то, что в хелп указано TForm.PixelsPerInch как свойство, хранящее значение времени создания, проверка показала, что это не так. Рассмотрение исходных текстов подтвердило факт изменения значения TForm.PixelsPerInch при масштабирование формы, во время исполнения. Так как простого и надежного решения данной проблемы у меня ПОКА нет, то поступим в соответствии с принципами Экстремального Программирования - "Если есть что-то что можно отложить на завтра - отложите это". Прошу прощение, у адептов XP, за столь вольную трактовку принципа.
Пришло время заняться процедурой, которая будет масштабировать Constraints компонентов. Собственно говоря, это свойство наследуется от TControl, по этому, будем обращаться именно к нему. Подумаем, как тестировать изменение Constraints. Первое, что приходит в голову, это создать специальную тестовую форму. Конечно, такой путь несколько сложноват, однако эта форма, скорее всего, пригодиться и в дальнейшем. Выбираем меню File | New | Form, даем название testForm и сохраняем как testUnit в поддиректории TEST, если Delphi предложит сохранить еще и проект, смело откажитесь. Не забудьте установить свойства формы так, как было описано ранее. Добавьте, в uses Appl. Проверьте, в меню Project | Options, новая форма должна располагаться в Available Forms, то есть не должна создаваться автоматически, при запуске приложения. Создайте в Events формы событие OnClose:

procedure TtestForm.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end;

Это заставит удалиться форму из памяти самостоятельно, после закрытия. Не забудьте, выполнить, для testAppl.pas, дополнение через File | Use Unit: Вот, теперь создадим TestChangeConstraints. Что бы легче было тестировать, и избежать неоднозначности, воспользуемся опытом тестирования ScaleValue и зададим размеры формы кратные 120, например 480, после масштабирования должно получиться 384. Так как, отдельные числа используются в unit более чем один раз, то вынесем их в константы.

const testOldPPI = 120; testNewPPI = 96; ... procedure TTestUnitAppl.TestChangeConstraints; var OK1, OK2: boolean; Size1, Size2: integer; begin OK1 := False; OK2 := False; Size1 := testOldPPI * 4; Size2 := ScaleValue(Size1, testNewPPI, testOldPPI); testForm := TtestForm.Create(Application); try testForm.Constraints.MaxHeight := Size1; testForm.Constraints.MinHeight := Size1; testForm.Constraints.MaxWidth := 0; testForm.Constraints.MinWidth := Size1; ChangeConstraints(testForm as TControl, testNewPPI, testOldPPI); OK1 := (testForm.Constraints.MaxHeight = Size2) and (testForm.Constraints.MinHeight = Size2) and (testForm.Constraints.MaxWidth = 0) and (testForm.Constraints.MinWidth = Size2); ChangeConstraints(testForm as TControl, testOldPPI, testNewPPI); OK2 := (testForm.Constraints.MaxHeight = Size1) and (testForm.Constraints.MinHeight = Size1) and (testForm.Constraints.MaxWidth = 0) and (testForm.Constraints.MinWidth = Size1); finally testForm.Close; Check(OK1 and OK2, 'failed test'); end; end;

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

procedure ChangeConstraints(Control: TControl; NewPPI, OldPPI: integer); begin with Control.Constraints do begin if MaxHeight > 0 then MaxHeight := ScaleValue(MaxHeight, NewPPI, OldPPI); if MinHeight > 0 then MinHeight := ScaleValue(MinHeight, NewPPI, OldPPI); if MaxWidth > 0 then MaxWidth := ScaleValue(MaxWidth, NewPPI, OldPPI); if MinWidth > 0 then MinWidth := ScaleValue(MinWidth, NewPPI, OldPPI); end; end;

Запускаем тест - "Шеф!!! Всё пропало!!!" - в чем же дело? А дело в том, что Constraints для минимальных и максимальных значений взаимозависимы. Максимальное значение не может быть меньше минимального и наоборот, и если происходит присвоение некорректного, с этой точки зрения значения, то оно изменяется в нужную сторону. Такое поведение весьма логично, но нас оно не всегда устраивает, по тому что, нам бы хотелось, что бы такое выравнивание сработало после наших изменений. Кстати, вот вам и первый пойманный баг, и довольно хитрый :). Поспешный поиск дихлофоса от Borland. , среди методов TControl, напоминавших по духу, что-то вроде DisabledAlign ничего не дал. Пришлось воспользоваться простым дедовским антитараканным средством - типа "тапочек":

procedure ChangeConstraints(Control: TControl; NewPPI, OldPPI: integer); begin with Control.Constraints do begin if NewPPI > OldPPI then begin if MaxHeight > 0 then MaxHeight := ScaleValue(MaxHeight, NewPPI, OldPPI); if MinHeight > 0 then MinHeight := ScaleValue(MinHeight, NewPPI, OldPPI); if MaxWidth > 0 then MaxWidth := ScaleValue(MaxWidth, NewPPI, OldPPI); if MinWidth > 0 then MinWidth := ScaleValue(MinWidth, NewPPI, OldPPI); end else begin if MinHeight > 0 then MinHeight := ScaleValue(MinHeight, NewPPI, OldPPI); if MaxHeight > 0 then MaxHeight := ScaleValue(MaxHeight, NewPPI, OldPPI); if MinWidth > 0 then MinWidth := ScaleValue(MinWidth, NewPPI, OldPPI); if MaxWidth > 0 then MaxWidth := ScaleValue(MaxWidth, NewPPI, OldPPI); end; end; end;

Тест, зеленый цвет, "едем" дальше... Дальше? А дальше, расположим на testForm какие-нибудь визуальные компоненты, ...даааа побольше :). В принципе, TestChangeConstraints показал, что процедура работает успешно, с наследником TForm, но не мешало бы, проверить её и с другими компонентами, хотя бы некоторую их часть (нет у нас такого требования - тестировать VCL). Так как предполагаемый процесс тестирования вполне однообразен, то создадим функцию, которой будем передавать компонент, из числа тех, которые расположены на форме, а возвращать она будет - "да" или "нет".

function TTestUnitAppl.TestScaleControl(Control: TControl): boolean; var OK1, OK2: boolean; Size1, Size2: integer; begin OK1 := False; OK2 := False; Size1 := testOldPPI; Size2 := ScaleValue(Size1, testNewPPI, testOldPPI); testForm := TtestForm.Create(Application); try Control.Constraints.MaxHeight := Size1; Control.Constraints.MinHeight := 0; Control.Constraints.MaxWidth := Size1; Control.Constraints.MinWidth := Size1; ChangeConstraints(Control, testNewPPI, testOldPPI); OK1 := (Control.Constraints.MaxHeight = Size2) and (Control.Constraints.MinHeight = 0) and (Control.Constraints.MaxWidth = Size2) and (Control.Constraints.MinWidth = Size2); ChangeConstraints(Control, testOldPPI, testNewPPI); OK2 := (Control.Constraints.MaxHeight = Size1) and (Control.Constraints.MinHeight = 0) and (Control.Constraints.MaxWidth = Size1) and (Control.Constraints.MinWidth = Size1); finally testForm.Close; Result := OK1 and OK2; end; end;

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

procedure TTestUnitAppl.TestScaleLabel; begin Check(TestScaleControl(testForm.Label1 as TControl), 'failed test '); end;

Если все тесты проходят успешно, то с определенной долей вероятности можно утверждать, что мы теперь знаем, как настроить форму так, что бы она автоматически масштабировались, по крайней мере в пределах, которые обеспечивает Delphi. Так же сможем масштабировать Constraints отдельно взятого контрола окна, при необходимости. Думаю, сфера использования ChangeConstraints довольно ограниченна, но в большинстве случаев результаты, полученные с помощью таких простых средств - вполне удовлетворительные. Можно было бы разработать функцию, которая бы сама изменяла Constraints у всех элементов формы. Желающие могут попробовать свои силы самостоятельно, не забудьте только прислать пример с тестом, и он будет включен в проект. По моему скромному мнению, решить эту проблему кардинально и качественно, можно лишь на уровне изменения исходного кода VCL. Хотя, "неумение" Constraints корректировать свои значения во время масштабирование окна и не является "официальным" багом но, очень хочется надеяться, что а можно создать собственный вариант формы, в котором проблема будет решена, но для данного проекта это будет расцениваться как выход за рамки требований (см. пункт.1). Впрочем, повторюсь, если у кого-то есть возможность исправить - пишите.
И так, мы провели некоторые технологические тесты, и убедились в работоспособности функций и процедур основной программы. Пришло время заняться функциональными тестами, то есть тестами, в которых проводится общая проверка на соответствие наших решений требованиям. Наиболее наблюдательные читатели должны были заметить, что к самой программе мы еще и не прикасались, но уже имеем для неё несколько работоспособных функций :). Проводить функциональное тестирование можно по-разному, и в принципе, лучше всего на рабочем приложении. У нас, его пока нет, кроме того, оценить правильность масштабирования можно на любом примере, ведь от нас не требуется реакция (нажатие кнопки, движение мыши и т.д.). Нам нужно просто посмотреть. Так что, воспользуемся testForm и разместим на ней 3 компонента TLabel. В свойство Caption каждой занесем такой текст "0123456789". У Label2 установим Constraints равными Width, у Label3 минимальное и максимальное значения отличающееся не менее чем на 50%, у Label4 минимальное и максимальное значения отличающееся на 5%.

procedure TTestUnitAppl.TestFuncScale; begin if IsChangePPI then begin testForm := TtestForm.Create(Application); try testForm.ShowModal; finally testForm.Close; end; end; Check(True, 'very strange '); end;

Тест очень прост, создается и визуализируется окно, рассматривается и закрывается. Процедура выполняется при запуске тестовой программы, если установлено иное значение PPI, чем использовалось при создании. И она всегда завершается успешно, что бы не портить общие "показатели" :). Можно откомпилировать тестовую программу, изменить размер шрифта экрана, перезагрузиться, запустить тест. Естественно, наш тест TestDsgnVsRtmPPI не должен пройти. Зато появиться окно testForm, где можно будет видеть результат масштабирования. Скажу прямо, LabeledEdit меня крайне разочаровал, впрочем, я его всегда подозревал и никогда им непользовался. Зато Label'ы вели себя так как им предписано. Закрываем окно, изменяем шрифт экрана, перезагружаемся, запускаем Delphi. Дальнейшие ухищрения в процессе тестирования, уважаемый читатель, может продолжить и самостоятельно.

Продолжение следует ...

Declaimer aka Отмазка.

Я надеюсь, что люди, привыкшие читать академические труды, или слушать классические оперы, не станут осуждать простую и незатейливую песнь кочевника. Что делал - о том и пел.
Исходную партитуру и ноты можно взять .

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

Все копирайты, если они известны, указаны. Иначе, автор не известен или копирайт утерян.

Brodia@a
Специально для

Проект создан в Delphi6 (44.3K)




Прошло некоторое время, клавиатура остыла


Hello, MiniProg 2
Раздел Подземелье Магов
Продолжение, .

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

Данная тема уже не раз поднималась на просторах , например, или . Огромное множество материала, на данную тематику, чьей то щедрой рукой, разбросано по интернету. Правда, все методы однотипные и сводятся к тому, что программа, при запуске, проверяет какой-нибудь признак, если он не обнаружен - то запускается, если же присутствует... В этом месте возможны самые различные реакции, от сообщений, с требованием ответа/нажатия кнопки, до коварнейших систем оповещения создателей (например, как у M$ XP :). Признаком может служить, либо проверка наличия определенного окна, либо отметка в конфигурационном файле/регистре, либо банальный файл, создаваемый при запуске приложения и удаляемый при выходе из него. Более сложные системы, профессионального уровня, обращаются за советом, "можно, или нельзя", к специализированным лицензионным серверам.
Мы пойдем другим путем, наверное, самым простым, будем проверять наличие определенного мьютекса, реакция же будет вежливая - просто активизация окна. Данный метод не нов. Определенно, он работоспособен, но не мешало бы создать тест, который бы нас убедил, что это так. И это еще одна рекомендация XtremeProgramming - не лениться и стараться тестировать как можно больше. Вообще, если бы программисты знали, как много ошибок может быть, в казалось бы, в надежном и простом коде: Откроем testMiniProg.dpr и в файле testAppl.pas создадим следующую процедуру:

Const StrFailedTest = 'failure test'; ... procedure TTestUnitAppl.TestFindPrevInstance; var Test1, Test2: boolean; Temp: THandle; begin Temp := Mutex; Test1 := not FindPrevInstance('Test'); Test2 := FindPrevInstance('Test'); StopPrevInstance; Check(Test1 and Test2, strFailedTest); Mutex := Temp; end;
Сами функции располагаются в Appl.pas и выглядят так:

Var Mutex: THandle = 0; ... function FindPrevInstance(Name: string): boolean; var Temp: THandle; begin Temp := CreateMutex(nil, False, PChar(Name)); Result := (GetLastError = ERROR_ALREADY_EXISTS); if Result then CloseHandle(Temp) else Mutex := Temp; end; procedure StopPrevInstance; begin if Mutex > 0 then CloseHandle(Mutex); end;


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

Unit testAppl; ... procedure TTestUnitAppl.TestShowPrevInstance; begin Check(ShowPrevInstance('DUnit'), strFailedTest); end; unit Appl; ... function ShowPrevInstance(Name: string): boolean; var PrevInstance: HWND; begin Result := False; PrevInstance := FindWindow('TApplication', PChar(Name)); if PrevInstance <> 0 then begin if IsIconic(PrevInstance) then ShowWindow(PrevInstance, SW_RESTORE); SetForegroundWindow(PrevInstance); Result := True; end; end;
Компилируем, запускаем, проверяем - все работает, как требуется. Следует отметить, что в данном случае, тестировалось только возвращаемое ShowPrevInstance значение, сам эффект 'показа' незаметен. По этому, что бы ни уподобляться тому сапожнику, который без сапог, внесем в testMiniProg.dpr изменения, добавим в секцию uses модуль Appl и следующий код:

program testMiniProg; uses Appl in '..\SOURCE\Appl.pas', Forms, TestFrameWork, GUITestRunner, testAppl in 'testAppl.pas', testUnit in 'testUnit.pas' {testForm}; {$R *.res} begin if FindAndShowPrevInstance('DUnit') then Halt else try Application.Initialize; Application.Title := 'DUnit'; GUITestRunner.RunRegisteredTests; finally StopPrevInstance; end; end.
В модуль Appl.pas, поместим функцию FindAndShowPrevInstance, которая будет искать и активизировать предыдущую копию программы. Её тестирование проведем на функциональном уровне, так как технологическое тестирование, хоть и возможно, но реализовывать его будет обременительно. Впрочем, желающие могут попробовать, не забудьте только мне показать, очень интересно.

function FindAndShowPrevInstance(Name: string): boolean; begin Result := FindPrevInstance(Name); if Result then ShowPrevInstance(Name); end;
Компилируем, запускаем, пробуем запустить вторую копию - у меня всё, как и предполагалось. Ну что же, можем считать, что функциональные тесты данная функция прошла. Есть один момент, который нужно учитывать. Не очень удобно то, что 'DUnit', или какое-то другое, милое вашему сердцу заветное слово, приходится писать два раза. Мне, к сожалению, так и не удалось приравнять Application.Title ни константе, ни переменной. Все время возникала ошибка dcc32.exe, по-видимому, из-за того, что данное значение используется самим Delphi. Возможно изменение, в виде переноса проверки FindAndShowPrevInstance в секцию initialization модуля Appl.pas, StopPrevInstance в секцию finalization, а сам unit прописать в uses dpr вашей программы самым ПЕРВЫМ. В принципе, я обычно так и делаю, в данном же случае пример просто показательный, потому и несколько упрощенный. Не сомневаюсь, даже данный подход можно улучшить. Особенность передаваемого FindAndShowPrevInstance значения в том, что оно должно быть такое же, как и имя главной формы программы, в противном случае невозможно будет правильное выполнение StopPrevInstance. Конечно, проверка мьютекса будет выполнена, и 'лишнее' приложение буде закрыто, но активизации первой копии не произойдет. Если кого-то не устраивает такое положение дел, например, этот кто-то, всегда дает одно и тоже имя главному модулю своих программ, то всё можно поправить. Просто расширьте число предаваемых функции параметров - отдельно имя мьютекса, отдельно имя главного окна.



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

Способность сохранять в конфигурационном файле какие-нибудь значения, например, положение и размеры окна, так же была освещена в интернет очень широко. В , есть неплохой компонент, умеющий многое, я сам пользовался им когда-то. По этому не будем изобретать ничего нового, но просто воспользуемся уже известными приемами. Почему именно ini-файл, а не регистр, или не способ хранение свойств компонентов, так как это делает Delphi? Свои плюсы и минусы есть у всех подходов, но для наших целей вполне хватит возможностей ini-файла. Будем считать, что ini-файл располагается в директории вместе с программой и имеет такое же имя, но другое расширение, например "ini" :). Традиционно, свойства окна хранят в отдельной секции ini-файла, с уникальным, для данного приложения именем. Используем для этого имя формы. И так, тесты:

procedure TTestUnitAppl.TestGetIniFileName; begin Check(ExtractFileName(GetIniFileName) = 'testMiniProg' + cfgFileExt, strFailedTest); end; procedure TTestUnitAppl.TestGetSectionName; begin Check(GetSectionName(Screen.Forms[0]) = 'GUITestRunner', strFailedTest); end;
Сами же функции очень просты. В принципе, GetSectionName можно было бы расширить, включив возможность генерации имени секции для любого компонента, с учетом формы-владельца, но пока не будем этого делать:

Const cfgFileExt = '.ini'; ... function GetIniFileName: string; begin Result := ChangeFileExt(Application.ExeName, cfgFileExt); end; function GetSectionName(Component: TComponent): string; begin Result := Component.Name; end;
Необходимо решить, какие именно значения свойств окна будут сохраняться и восстанавливаться. Вероятно состояние окна: свернуто, максимизировано и т.д. и позицию окна, т.е. положение левого верхнего угла и, либо положение правого нижнего угла, либо размеры окна. Необходимо еще предусмотреть, как средство защиты программы от пользователей - любителей запускать одно и то же приложение при разных значениях PPI, возможности, на выбор:
1) отказа от восстановления параметров окна и установка значений по умолчанию,
2) изменение этих параметров в соответствии с изменением используемого шрифта.
Мне, больше по душе метод 'нумбер 2'. Что нужно сделать? вроде бы совсем не многое - всегда хранить размеры окна приведенными в соответствие с PPI времени создания, и при восстановлении проводить коррекцию, в соответствии с PPI времени выполнения. Положение левого верхнего угла формы изменять не следует, этого не делает Delphi, не будем делать и мы. В первой части статьи, говорилось, что величина масштабирования размеров окна зависит от отношения PPI's времен создания и выполнения, и такого понимания, тогда, было достаточно. Настало время все уточнить. На самом деле все обстоит несколько сложнее. Отношение PPI's используется для масштабирования высоты шрифта, после этого вычисляется высота образцового текста (у Delphi это строка '0' :). Ну а далее, для масштабирования, используется отношение старой и новой высот текста. Это отношение будет равно отношению PPI's в случае использования стандартных, для Windows, установок 'Крупный/Мелкий шрифт'. Размеры обычных экранных шрифтов строго фиксированы, по этому, использование нестандартных значений PPI' s может приводить к возникновению неприятных эффектов. В таких случаях, иногда, способен помочь шрифт TTF, например, как предлагается . Следует отметить еще одну особенность масштабирования форм: непосредственно изменяются не сами размеры формы, а размеры клиентской части.



Вооружившись этими знаниями можно придти к выводу, что придется вносить изменения в функцию RtmPPI и DsgnPPI, и вычислять их результат иначе, чем было сделано ранее. Идея проста, использовать для масштабирования высоту текста, времени создания формы и времени выполнения приложения. Судя по всему - это более корректный способ, однако, в названиях переменных и процедур сохранена аббревиатура PPI. Остается вопрос, где, во время исполнения, взять высоту текста времени создания, ведь при создании окна все размеры изменяются. В принципе, все интересующие нас числа хранятся в ресурсах программы и можно попробовать прочитать их оттуда. Но, все попытки обратиться к ресурсам формы в программе, использую стандартные и рекомендованные для этого средства, ни к чему не привели. Точнее, нужные ресурсы программы успешно читаются, но уже в измененном виде, так уж устроен метод TCustomForm.ReadState :(. По этому, попытаемся прочитать данные из ресурса, так же, как это делает Delphi, но в сильно упрощенном варианте. Если вы загляните в исходный код VCL и просмотрите всё, что хоть как-то касается загрузки ресурсов программы, то поймете, зачем эти упрощения. Сведений, в литературе и интернете, связанных с вопросами чтения ресурсов во время исполнения программы, без создания самих компонентов, очень мало. К моему сожалению, практически, я ничего не нашел, и если кто-то знает, где есть подобного рода информация - поделитесь ссылкой. Текст функции, которая читает ресурсы определенной формы, выглядит так:

unit Appl; ... function ReadFormRes(ResName: string; List: TStringList): boolean; var Prop, Value: string; Stream: TResourceStream; Reader: TReader; HRsrc: THandle; begin List.Clear; HRsrc := FindResource(HInstance, PChar(ResName), RT_RCDATA); Result := HRsrc <> 0; if not Result then Exit; Stream := TResourceStream.Create(HInstance, ResName, RT_RCDATA); Reader := TReader.Create(Stream, 4096); try Reader.ReadSignature; Reader.ReadStr; Reader.ReadStr; while not Reader.EndOfList do begin Prop := Reader.ReadStr; Value := strNil; case Reader.NextValue of vaInt8, vaInt16, vaInt32: Value := IntToStr(Reader.ReadInteger); vaString: Value := Reader.ReadString; else Reader.SkipValue; end; if Value <> strNil then List.Add(Format('%s = %s',[Prop,Value])); end; Reader.CheckValue(vaNull); finally Reader.Free; Stream.Free; end; end;


Как я уже говорил, здесь представлен упрощенный вариант, который ищет определенный ресурс в программе, и сообщает в результате найден он или нет, а так же заполняет List набором строк найденных свойств и их значений. В список записываются не все свойства, а только те, которые определены в ресурсе и имеют тип, либо целого числа, либо строки, и принадлежат самой форме. При желании, можно организовать рекурсивный обход всех компонентов окна и чтение их свойств. Полный тест для данной функции не приводится, по той простой причине, что он довольно велик и явно выходит за рамки данной статьи. Может быть в другой статье :). Скажу лишь что, при построении такого рода функции, вряд ли стоит эмулировать полностью весь процесс загрузки ресурсов программы. В нашем случае, необходимо прочитать лишь некоторые свойства окна, что мы и сделаем. Конечно, можно поступить и так; создать пустую форму, у которой будет известна высота текста времени создания, но во время выполнения программы нам будет известно её масштабированное значение, что, собственно говоря, и нужно. Но, лично мне такой путь не нравиться, как по стилю решения проблемы, так и по тому, что при таком подходе возможна проблема с Constraints. Тестирующая функция довольно проста, хотя, конечно же, при тестировании полного варианта она выглядит иначе:

Procedure TtestUnitAppl.TestReadFormRes; var List: TStringList; Test: boolean; begin List := TStringList.Create; try ReadFormRes('TGUITestRunner', List); Test := List.Values['Caption'] = 'DUnit: An Xtreme testing framework'; finally List.Free; Check(Test, strFailedTest); end; end;
Изменим функцию RtmPPI таким образом, что бы она вычисляла, во время выполнения программы, высоту текста, для определенного нами окна. Соответственно DsgnPPI, изменится так, что вычисление её результата будет происходить с использованием ReadFormRes. Дополнительно, что бы избежать ошибок при определении RtmPPI, в ситуации, когда окно еще не создано, нам понадобится функция, которая по имени окна будет искать его в списке созданных форм и возвращать указатель на найденную форму, иначе nil.

Unit testAppl; ... procedure TTestUnitAppl.TestFindForm; var Test1, Test2, Test3: boolean; begin Test1 := FindForm('testForm') = nil; testForm := TtestForm.Create(Application); try Test2 := FindForm('testForm') <> nil; finally testForm.Free; Test3 := FindForm('testForm') = nil; end; Check(Test1 and Test2 and Test3, strFailedTest); end; unit Appl; ... function FindForm(FormName: string): TCustomForm; var I: integer; begin Result := nil; for I := 0 to Screen.FormCount - 1 do if Screen.Forms[I].Name = FormName then begin Result := Screen.Forms[I]; Break; end; end;


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

unit Appl; ... const strDelphiMagicText = '0'; strResTextHeight = 'TextHeight'; ... function RtmPPI(FormName: string): integer; var Form: TCustomForm; begin Result := 0; Form := FindForm(FormName); if Form <> nil then Result := Form.Canvas.TextHeight(strDelphiMagicText); end; function DsgnPPI(FormName: string): integer; var List: TStringList; Form: TCustomForm; begin List := TStringList.Create; try Form := FindForm(FormName); if Form <> nil then begin ReadFormRes(Form.ClassName, List); Result := StrToInt(List.Values[strResTextHeight]); end; finally List.Free; end; end;
Эти функции проверяют наличие определенного окна . Если значение не равно nil, то считается, что форма уже создана, и у неё можно определить PPI's. Если форма еще не создана, то возвращается 0. В случае успешного выполнения функции, результатом будет значение высоты текста, отличное от 0. Так как сами функции несколько усложнились, то необходимо расширить их тестирование. Изменится так же, процедура TestDsgnVsRtmPPI, но функциональность её сохраниться, и даже несколько расшириться. Функция IsChangePPI удалена, из-за её несоответствия текущему моменту.

const testPPI = 16; ... procedure TTestUnitAppl.TestRtmPPI; var Test: boolean; begin testForm := TtestForm.Create(Application); try Test := RtmPPI('testForm') = testForm.Canvas.TextHeight(strDelphiMagicText); finally testForm.Free; Check(Test, strFailedTest); end; end; procedure TTestUnitAppl.TestDsgnPPI; var OldPPI, PPI: integer; begin testForm := TtestForm.Create(Application); try OldPPI := DsgnPPI('testForm'); finally testForm.Free; Check(OldPPI = testPPI, Format('DsgnPPI=%d, not %d', [OldPPI, testPPI])); end; end; procedure TTestUnitAppl.TestDsgnVsRtmPPI; var Test: boolean; Text: string; OldPPI, NewPPI: integer; begin Test := False; Text := strFailedTest; testForm := TtestForm.Create(Application); try OldPPI := RtmPPI('testForm'); NewPPI := DsgnPPI('testForm'); if (OldPPI > 0) and (NewPPI > 0) then begin Test := OldPPI = NewPPI; if not Test then Text := Format('DsgnPPI=%d not equal RtmPPI=%d DPI', [OldPPI, NewPPI]); end; finally testForm.Free; Check(Test, Text); end; end;


Вроде бы все подготовительные действия выполнены, можно попытаться сохранить/восстановить состояние формы. Текст тестовой функции TestSaveLoadFormState можно посмотреть в testAppl.pas. Логика проверки следующая, создается окно, с некоторой задержкой демонстрируется, запоминается состояние окна в локальной переменной и сохраняется в ini-файле. Устанавливаются другие значения состояния окна, перемещается, сворачивается в левый нижний угол, выжидается некоторое время. Восстанавливается состояние окна, сохраненное в ini-файле. Дополнительно, проводится проверка значений состояния окна, до и после сохранения/восстановления. Если же вас не убедят результаты тестов, то всегда можно будет заглянуть в файл ini и посмотреть всё своими глазами. Сами процедуры сохранения/восстановления, и все процедуры к которым они обращаются, приведены поименно ниже:

... procedure WriteIniShowCmd; procedure ReadIniShowCmd; procedure WriteIniFlags; procedure ReadIniFlags; procedure WriteIniWidth; procedure ReadIniWidth; procedure WriteIniHeight; procedure ReadIniHeight; procedure WriteIniLeft; procedure ReadIniLeft; procedure WriteIniTop; procedure ReadIniTop; procedure ScaleFormConstraints; procedure SaveFormState; procedure LoadFormState; ...
Полный текст процедур довольно велик по своим размерам, по этому здесь не приводится, но его можно посмотреть в Appl.pas, тестовые процедуры в testAppl.pas. Следует отметить, что при загрузке положения формы выполняется ScaleFormConstraints, которая корректирует значения Constraints окна, но другие элементы формы остаются без изменения. Желающие могут расширить её по своему усмотрению.

Те, кто смотрел исходники MiniProg1, заметят, что в исходных файлах MiniProg2 проведены некоторые 'косметические' изменения.

Продолжение следует ...

Declaimer aka Отмазка.
Я надеюсь, что люди, привыкшие читать академические труды, или слушать классические оперы, не станут осуждать простую и незатейливую песнь кочевника. Что делал - о том и пел.
Исходную партитуру и ноты можно взять здесь: (43K). Предложения будут рассмотрены, претензии - проигнорированы.
С особым вниманием будут рассмотрены уточнения списка требований и новые тесты.

Все копирайты, если они известны, указаны. Иначе, автор не известен или копирайт утерян.


Brodia@a
Специально для




Моделирование данных


Раздел Подземелье Магов

Этот цикл статей посвящен моделированию данных, т.е. некоторым правилам и рецептам, которыми следует (или не следует) руководствоваться, отображая сeмантику предметной области в набор взаимосвязанных таблиц реляционной СУБД. Тексты статей не являются строгим изложением теории и не претендуют на "научность", а являются лишь попыткой поделиться скромным опытом в этой области.

Автор: Сергей Королев.

Часть I: Определение нормальных форм.

Процесс нормализации состоит в том, чтобы представить данные в виде набора таблиц, в которых все неключевые поля зависят только от целого - возможно, составного - ключа. Тем самым мы минимизируем избыточность данных, и в каком-то смысле повышаем ее "устойчивость". Известно пять нормальных форм таблиц, однако на практике используются только первые четыре. Первая нормальная форма.
Говорят, что таблица соответствует первой нормальной форме, если в каждом поле каждой ее строки содержится ровно одно значение. Ответ на вопрос что такое «ровно одно значение» может дать только постановка задачи и ее анализ. Например, в одной задаче имя, отчество и фамилия человека являются различными значениями, и тогда хранение их в одном поле таблицы нарушает критерий первой нормальной формы. Если разрабатывается система учета кадров, то - поскольку человек может время от времени менять, например, фамилию, - скорее всего, разумно считать имя, отчество и фамилию различными атрибутами. Однако вполне может случиться, что по условиям задачи допустимо считать эти атрибуты одним значением.

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


Товар (ключ) Склад (ключ) Количество Адрес склада
Т001 Склад 1 15 Вокзальная ул. д.2
Т002 Склад 2 20 Ленинский тупик д.1
Т003 Склад 2 34 Ленинский тупик д.1
Т004 Склад 3 22 Придорожный пер. д.3
Здесь ключ таблицы состоит из двух полей - Товар, Склад, при этом значение поля Адрес склада зависит, очевидно, только от значения поля Склад. В результате применения такой модели может возникнуть рассогласованность данных - у одного и того же склада могут появиться различные адреса, а если склад опустеет, то его адрес вообще будет забыт. Разумно эту таблицу разбить на две - в одной хранить количество товаров на складе, в другой - адреса и прочие данные о складе

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

Табельный № (ключ) Имя Фамилия Отдел Название отдела
1001 Василий Чапаев Н-11 Продажи
1002 Павел Морозов Н-23 Маркетинг
1003 Иван Гадюкин Н-11 Продажи
В этой таблице значение поля Название отдела зависит от значения неключевого поля Отдел. Последствия те же, что и в предыдущем примере: возможна рассогласованность данных. Этот пример также лечится разбиением таблицы на две - для данных о сотрудниках и для данных об отделах.

Четвертая нормальная форма.
Например, в базе данных потребовалось хранить информацию о сотрудниках, в том числе о том, на каких музыкальных инструментах он умеет играть, и какие имеет увлечения (хобби). Эти данные можно расположить в одной таблице:

Сотрудник (ключ) Муз. инструмент (ключ) Хобби (ключ)
Иванов Гитара Горные лыжи
Петров Рояль Подводное плавание
Сидоров Волынка Компьютерные игры
Очевидно, таблица соответствует определениям первых трех нормальных форм, однако, каждая запись содержит два независимых факта относительно сотрудника - именно это и обуславливает нарушение правила четвертой нормальной формы. Чтобы модель данных соответствовала четвертой нормальной форме, необходимо эту таблицу разбить на две, в одной хранить информацию о владении музыкальными инструментами, в другой - о хобби. Следует иметь в виду, что в процессе проектирования анализ предметной области может выявить зависимости между фактами, и тогда приведение модели к четвертой нормальной форме окажется нежелательным.

* * * Общее неформальное правило, касающееся нормализации, таково: полученная в результате анализа задачи модель данных нормализуется насколько это возможно, затем, если SQL-запросы для отчетов получаются чересчур сложными и/или слишком низка производительность их обработки, приходится "сдавать позиции" и денормализовывать модель.

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

Сергей Королев,


Продолжение
Часть II:



Возможно, эта таблица подойдет для записи всех операций с материалами, но, прежде всего пользователям потребуется отчет об остатках материалов по каждому из имеющихся состояний (в пути, разгружено, оприходовано и пр.) По этой таблице этот отчет строить неудобно: на Inter-base для этого придется написать хранимую процедуру, в которой нужно будет объединить результаты двух запросов, в SQL Server, Oracle, DB2 можно сформулировать всего один запрос для вычисления этих цифр: два запроса объединить конструкцией UNION, а затем с помощью select from select или чего-либо подобного задать окончательные агрегатные вычисления. Этот прием, конечно, сработает, но уже на сотне тысяч записей производительность начнет заметно падать. Вообще, сложные запросы - явный признак неудачной модели данных. В данном случае, нашу таблицу нужно перепроектировать. Каждую операцию перемещения будем кодировать не одной, а двумя записями в таблице: NO - номер операции LN_NO - номер позиции в операции DATE - дата TIME - время MATERIAL - идентификатор материала QUANTITY - количество STATE -состояние

Поле LN_NO будет содержать 0 или 1 и будет частью ключа. В записи для исходного состояния количество запишем с отрицательным знаком (это символизирует тот факт, что материал это состояние покинул), в записи для результирующего состояния знак количества будет положительным.

Кроме того, очевидно, что эта схема позволяет хранить операции, состоящие из более чем двух позиций: например, материал разгружается, некоторая его часть приходуется, а другая часть списывается в брак. Ключевое поле LN_NO будет хранить номер позиции. Итак, получается, что в таблицу нужно записать три записи:

№ опер № поз Дата Время Mатериал Кол-во Состояние
2111 1 28.02.2000 12:28 Спички -100 Принят
2111 2 28.02.2000 12:28 Спички 95 Оприходован
2111 3 28.02.2000 12:28 Спички 5 Брак
Такая схема позволит посчитать остатки одним простым запросом: select STATE, SUM(QUANTITY) from operations group by STATE



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

Задача о курсах валют

Вот простая задача - нужно хранить журнал курсов доллара по отношению к рублю. Казалось бы, все просто - создаем таблицу из двух колонок - дата, курс - и методично ее заполняем. После этого обязательно появится сопутствующая задача: есть таблица с суммами в рублях и датой совершения операции. Нужно одним запросом выдать таблицу, в которой все операции пересчитаны в доллары по курсу на дату совершения операции. Вот очевидное неправильное решение: select op.amount * rt.rate, op.reg_date from operations op, rates rt where op.date = rt.date

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

Как сформулировать запрос правильно, при условии, что мы не храним курсы за все дни? Для такой модели данных это достаточно нетривиальная задача, достойная помещения в рубрику головоломок Джо Селко . Но лучше бороться не с последствиями, а с причинами - поэтому модель данных следует немного изменить.

В таблицу курсов добавим еще одну дату и будем следить за тем, чтобы эти даты отражали срок действия курса. В качестве начального значения дата окончания срока действия будет достаточно отдаленной, например, 31 декабря 9999 (ну или максимальной из представимых в базе данных). Манипуляции с таблицей курсов слегка усложняются - при вставке очередного курса необходимо согласованно пересчитать срок действия курса, в который попал новый курс. Это легко программируется триггером: create trigger ti_rate for rates before insert as begin update rates set rate_date = new.rate_date-1; where new.rate_date between (rate_date and end_date);



/* если есть курсы с более поздней датой */ select rate_date-1 from rates where new.end_date between (rate_date and end_date) into new.end_date; end

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

Теперь можно сформулировать запрос: select op.amount * rt.rate, op.reg_date from operations op, rates rt where op.reg_date between

(rt.rate_date and rt.end_date)

Итак, слегка усложнилась работа при «записи» данных - нам пришлось программировать триггеры; в таблице появилось избыточное поле. Но запрос, с помощью которого вычисляются курсы, остался простым, понятным и главное - быстрым.

Суррогатные ключи и автоинкремент

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

Практически все СУБД содержат те или иные средства генерации уникального суррогатного ключа:

Interbase - генераторы Oracle - последовательности (sequence) Paradox - автоинкременты MS SQL Server - автоинкременты (identity) DB2 - специальная функция, генерирующая уникальное значение на основе даты и времени на сервере

Автоинкрементное поле обладает несомненными достоинствами для программиста: об его уникальности заботится система - значение увеличивается всякий раз, когда в таблицу вставляется запись. В этом, однако, состоит и недостаток автоинкремента: не вставив в таблицу записи, его очередное значение нельзя получить.

Вот иллюстрация. В клиент/серверных приложениях сплошь и рядом встречается задача формирования многопозиционных документов на рабочем месте: счетов, накладных и т.п. Такие документы чаще всего моделируют в базе данных двумя таблицами: первая служит для хранения данных заголовка (даты, общей суммы и пр.), а вторая - для хранения позиций документа. Во второй таблице ко всем ключевым полям первой таблицы добавляется номер позиции. Таким образом, чтобы сформировать запись в таблице позиций документа, необходимо знать ключ записи заголовка, который часто и реализуют с помощью автоинкремента.



То есть алгоритм получается примерно таким:

Пользователь нажимает кнопку «Создать документ» Старт транзакции Вставка записи заголовка и получение нового номера документа Формирование позиций документа Пользователь нажимает кнопку «Сохранить документ» Завершение транзакции.

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

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

Наилучшим решением представляется использование механизма получения очередных номеров, независимого от таблиц и транзакций, аналогичного, например, генераторам Interbase. Кстати, если СУБД, на которой вы работаете, не имеет такого механизма, но поддерживает вызов внешних функций, то генераторы a la Interbase достаточно просто разработать самостоятельно. Тогда алгоритм формирования документа станет таким:

Пользователь нажимает кнопку «Создать документ» Получение очередного номера документа Формирование записи заголовка и позиций документа Пользователь нажимает кнопку «Сохранить документ» Сохранение документа: Старт транзакции, запись в таблицы заголовков и позиций, завершение транзакции.

Преимущества этой схемы достаточно очевидны: транзакция открывается только в момент реальной записи документа (т.е. тогда, когда пользователь нажал кнопку «Сохранить»), время ее работы определяется исключительно объемом данных документа и не зависит от настроения пользователя.

Если вы используете Delphi или C++ Builder, то для реализации подобной схемы подойдут компоненты TClientDataSet и TUpdateSQLProvider.

Сергей Королев

¹ - Здесь и далее используется диалект SQL для СУБД Interbase

² - Joe Celko -SQL-гуру, автор постоянной колонки журнала (бывш. DBMS magazine),
в которой часто публикуются интересные задачи для знатоков SQL.


Модуль для расчета формул II


Раздел Подземелье Магов

В этой статье представлена новая версия . Я сделал очень много нововведений, в том числе полностью изменил структуру сценариев. В предыдущем варианте сценарий состоял примерно из равных частей по 4 байта - не рационально, но намного проще. Полное описание структуры новых сценариев приведено в исходном файле модуля. Изменился синтаксис формулы, больше не нужно заключать функции в скобки. Ниже приведены все элементы синтаксиса, многие из них также претерпели изменения:

Single: тип, обозначает вещественное 32 битное число Double: тип, обозначает вещественное 64 битное число Int64: тип, обозначает целое знаковое 64 битное число Integer: тип, обозначает целое знаковое 32 битное число Longword: тип, обозначает целое беззнаковое 32 битное число Smallint: тип, обозначает целое знаковое 16 битное число Word: тип, обозначает целое беззнаковое 16 битное число Shortint: тип, обозначает целое знаковое 8 битное число Byte: тип, обозначает целое беззнаковое 8 битное число if: зарезервированное слово, обозначает логическое выражение and: операнд, используется для связывания двух логических выражений. Аналогично логическому and в Delphi or: операнд, используется для связывания двух логических выражений. Аналогично логическому or в Delphi xor: операнд, используется для связывания двух логических выражений. Аналогично логическому xor в Delphi not: операнд, меняет логическое значение на противоположное. > логическая функция, если первое математическое выражение больше второго, то возвращает истину, в противном случае возвращает ложь : логическая функция, если первое математическое выражение меньше второго, то возвращает истину, в противном случае возвращает ложь <>: логическая функция, если первое математическое выражение не равно второму, то возвращает истину, в противном случае возвращает ложь =>: логическая функция, если первое математическое выражение больше или равно второму, то возвращает истину, в противном случае возвращает ложь : логическая функция, если первое математическое выражение меньше или равно второму, то возвращает истину, в противном случае возвращает ложь =: логическая функция, если первое математическое выражение равно второму, то возвращает истину, в противном случае возвращает ложь Odd: логическая функция, возвращает истину если математическое выражение нечетное True: функция. Возвращает истину. Это величина может принимать значение 1 False: функция. Возвращает ложь. Это величина может принимать значение 0 +: операнд, сложение -: операнд, вычитание *: математическая функция, вычитание /: математическая функция, деление Sqrt: математическая функция, возвращает корень числа. Корень может быть любой степени Div: математическая функция, возвращает целочисленное деление Mod: математическая функция, возвращает остаток от деления Int: математическая функция, возвращает целая часть числа Frac: математическая функция, возвращает дробная часть числа Random: математическая функция, возвращает произвольное число от 0 до 1 Trunc: математическая функция, возвращает целую часть числа Round: математическая функция, округляет число Sin: математическая функция, возвращает синус числа ArcSin: математическая функция, возвращает арксинус числа Sinh: математическая функция, возвращает гиперболический синус числа ArcSinh: математическая функция, возвращает гиперболический арксинус числа Cos: математическая функция, возвращает косинус числа ArcCos: математическая функция, возвращает арккосинус числа Cosh: математическая функция, возвращает гиперболический косинус числа ArcCosh: математическая функция, возвращает гиперболический арккосинус числа Tan: математическая функция, возвращает тангенс числа ArcTan: математическая функция, возвращает арктангенс числа Tanh: математическая функция, возвращает гиперболический тангенс числа ArcTanh: математическая функция, возвращает гиперболический арктангенс числа CoTan: математическая функция, возвращает котангенс числа ArcCoTan: математическая функция, возвращает арккотангенс числа CoTanh: математическая функция, возвращает гиперболический котангенс числа ArcCoTanh: математическая функция, возвращает гиперболический арккотангенс числа Sec: математическая функция, возвращает секанс числа ArcSec: математическая функция, возвращает арксеканс числа Sech: математическая функция, возвращает гиперболический секанс числа ArcSech: математическая функция, возвращает гиперболический арксеканс числа ArcCsc: математическая функция, возвращает арккосеканс числа Csc: математическая функция, возвращает косеканс числа ArcCsc: математическая функция, возвращает гиперболический арккосеканс числа Csc: математическая функция, возвращает гиперболический косеканс числа Abs: математическая функция, возвращает абсолютную величину числа Ln: математическая функция, возвращает натуральный логарифм числа Lg: математическая функция, возвращает десятичный логарифм числа Log: математическая функция, возвращает логарифм двух числа Pi: математическая функция, возвращает число Пи !: математическая функция, возвращает факториал числа ^: математическая функция, возвращает степень числа. Степень может быть дробной Несколько слов о тех изменениях, которые я сделал.
Прежде всего, улучшен контроль ошибок. Теперь идет строгая проверка последовательности функций с учетом их особенностей. Также доработаны сообщения исключительных ситуаций о найденных ошибках. Изменено зарезервированное слово "bool" на "if", которое служит для обозначения логических выражений. На мой взгляд "if" намного лучше, короче и, как Вы заметили, я стараюсь сделать элементы синтаксиса формулы максимально похожими на те же элементы в Delphi. Изменено свойство "Formula", теперь это свойство "Text". Изменены названия методов для работы с математическим сценарием, например RegisterIntFunction теперь называется RegisterNumFunction. Раньше при регистрации функций важно было следить за их порядком. Поясню на примере. Представьте себе, что Вы регистрируете новую функцию "X". А затем Вы регистрируете еще одну функцию "EXP". В памяти программы они будут находиться именно в порядке регистрации, т.е. сначала "X", затем "EXP". При распознавании формулы в таком же порядке будет происходить поиск функций. Поэтому функция "EXP" никогда не будет распознана, т.к. она включает себя функцию "X", которая будет найдена первой. Сейчас порядок регистрации не имеет значения. Но после регистрации нужно вызвать метод SortNumFunctionsData или SortBoolFunctionsData для соответственно математических и логических функций. Эти методы сортируют зарегистрированные функции таким образом, что первыми оказываются самые "длинные" функции. После регистрации новых типов нужно вызвать метод SortTypesData. Важно помнить, что после сортировки функций, изменятся идентификаторы этих функции в соответствии с их новым положением в памяти. Опять же я приведу пример. Представьте, что Вы регистрируете две новые функции, пусть это будут функции "sin" и "sinh" (такие функции регистрируются автоматически при создании объекта класса TDataEditor, но пример чисто гипотетический): ... type TForm1 = class(TForm) ... private FSinID: Integer; FSinhID: Integer; ... end; ... procedure TForm1.FormCreate(Sender: TObject); begin with DataEditor do begin RegisterNumFunction(FSinID, 'sin', False, True); RegisterNumFunction(FSinhID, 'sinh', False, True); // Допустим, что FSinID = 0, FSinhID = 1; SortNumFunctionsData; // После выполнения этой процедуры, FSinID = 1, FSinhID = 0, // т.е. первой функцией стала наиболее длинная - 'sinh'. end; ... end; ...



Мониторинг сообщений Windows и VCL


h2>Аспекты реализации

Технически, мониторинг сообщений любого контрола легко установить, подменив его свойство WindowProc. Именно этот прием используется в предлагаемом проекте. Для удобства, вся работа связанная с установлением и управлением мониторинга инкапсулирована в классе TControlInfo модуля U_Control. Передавая конструктору этого класса ссылку на интересующий вас контрол, вы включаете мониторинг за этим контролом.

Единственной технической сложностью является преобразование номера полученного сообщения в его строковое обозначение. Как, обрабатывая, к примеру, сообщение N24, узнать, что оно носит название WM_SHOWWINDOW? Решая эту проблему, я пошел следующим (возможно нерациональным) путем: так как названия всех Windows и VCL сообщений однотипным образом перечислены в двух файлах (Messages.pas и Controls.pas), то можно написать небольшую программку, которая вычленит названия сообщений из этих модулей и создаст вспомогательный файл, содержащий case оператор вида: case WM_Number of WM_NULL : Result := 'WM_NULL'; WM_CREATE : Result := 'WM_CREATE'; WM_DESTROY : Result := 'WM_DESTROY'; // [ ... Skiped ... ] CN_SYSCHAR : Result := 'CN_SYSCHAR'; CN_NOTIFY : Result := 'CN_NOTIFY'; end;

Таким образом, можно почти автоматически создать функцию, которая преобразует номер Windows или VCL сообщения в его название. Пример такой функции можно увидеть в модуле MonitorMessage.

В заключение отмечу, что проект предназначен для работы в Delphi 5,6. По мере возможностей, весь код проекта снабжен поясняющими комментариями.

Исходники проекта (11K)


Специально для



Мотивация и постановка задачи


При попытке сформулировать требования к инспектору объектов у меня получился такой список : инспектор должен иметь возможность работать с объектами любых типов. Не предполагается происхождение объектов от какого-либо специального базового класса, должна существовать возможность инспектирования объектов, которые были созданы на предыдущих этапах разработки. Это случай, когда инспектор появляется в прикладной программе в результате ее эволюционного развития при длительном времени жизни программы. Инспектируемые объекты могут иметь различную природу, например, вообще быть не объектами, а, например, структурами данных (записями), располагаться в адресном пространстве другого процесса, или находиться на удаленной машине в локальной сети. Инспектор должен однообразно работать с объектами различной природы, инспектируемые объекты могут выглядеть по-разному для разных пользователей или разных контекстов и могут предоставлять для инспекции различные наборы своих свойств. Например, с прикладной программой могут работать пользователи различных категорий: "новичок", "обычный пользователь", "эксперт". Естественно, что "эксперту" доступно большее число инспектируемых свойств, чем "новичку", объекты могут иметь сложную внутреннюю структуру, то есть, содержать вложенные объекты, которые, в свою очередь, также могут иметь вложенные объекты. Вложенность объектов неограничена (в разумных пределах), число инспектируемых свойств может быть достаточно большим, при этом должны существовать средства иерархической упорядоченности, то есть, свойства могут быть представлены, в общем случае, как элементы дерева, веточки которого можно сворачивать и разворачивать, инспектор должен сохранять историю работы с различными объектами, то есть, при повторе инспекции объекта, внешний вид дерева его свойств должен быть таким же, как и при последней инспекции. Это означает, что инспектор должен сохранять историю сворачивания и разворачивания веточек, имена свойств могут быть на любом языке, например, на русском, и могут включать произвольный набор символов. Имена могут иметь достаточно большую длину и составляться из нескольких слов, должна существовать развитая система помощи, включающая, как минимум, два уровня по каждому инспектируемому свойству - подсказка и справка, реализация всех этих условий не должна быть связана с большими трудозатратами со стороны программиста. Может показаться, что это завышенный набор требований, но, тем не менее, все перечисленные пункты были не придуманы, а продиктованы той реальной необходимостью, которую мне пришлось учитывать в одном из выполняемых мною проектов. Как видно из перечисленных выше требований, объекты должны обладать существенно большим набором аттрибутов, чем это требуется нам, программистам, для работы с объектами внутри программного кода. Для обозначения этой дополнительной информации будем использовать термин "метаданные" или "аттрибуты". Приставка "мета" подчеркивает, что это данные, описывающие другие данные, то есть, "данные о данных". Именно такие термины используются в языке C# и в платформе .Net. Примером метаданных является информация RTTI, которую формирует компилятор Delphi. Очевидно также, что метаданные, формируемые Delphi недостаточны для удовлетворения всех поставленных требований, а такая возможность, как описание своих аттрибутов (доступная в C#), в Delphi отсутствует. Кроме того, нужно удовлетворить указанному выше требованию о том, что инспектор должен работать и с такими объектами, которые не были спроектированы в расчете на инспекцию. При анализе поставленных требований я выделил четыре основные задачи, необходимые для создания инспектора. Каждой из этих задач посвящен в статье свой раздел: создание метаданных, размещение метаданных и доступ к ним, создание прокси-объектов (заместителей), работающих с объектами различной природы и унифицирующих способ взаимодействия объектов с инспектором, создание менеджера объектов, который изолирует визуальный компонент инспектора от инспектируемых объектов и метаданных, создание собственно инспектора как визуального компонента.



Набор функций


Здесь приведен текст модуля импорта для использования Timerman.dll.

unit TmImport; interface uses Windows,NotifyDef; const TimerMan = 'TimerMan.dll'; (*** Creating interval timer with object event handler ***) function tmCreateIntervalTimer( hEventProc: TNotifierEvent; // Client event handler Interval : dword; // Time interval, msec Mode : byte; // Timer mode Run : boolean; // Start timer immediately Msg, // Message code (2nd handler parameter) UserParam : dword // User parameter (3rd handler parameter) ) : THandle; external TimerMan name 'tmCreateIntervalTimer'; (*** Creating interval timer ***) function tmCreateIntervalTimerEx( hEventObj : THandle; // Notify object handle Interval : dword; // Time interval, msec Mode : byte; // Timer mode Run : boolean; // Start timer immediately EventType : byte; // Notify object type Msg, // Message code UserParam : dword // User parameter for message ) : THandle; external TimerMan name 'tmCreateIntervalTimerEx'; (*** Closing timer ***) procedure tmCloseTimer(hTimer : THandle); external TimerMan name 'tmCloseTimer'; (*** Starting timer (enable work) ***) procedure tmStartTimer(hTimer : THandle); external TimerMan name 'tmStartTimer'; (*** Stopping timer (disable work) ***) procedure tmStopTimer(hTimer : THandle); external TimerMan name 'tmStopTimer'; (*** Resetting timer ***) procedure tmResetTimer(hTimer : THandle); external TimerMan name 'tmResetTimer'; (*** Set timer mode ***) procedure tmSetTimerMode(hTimer : THandle; Mode : byte); external TimerMan name 'tmSetTimerMode'; (*** Modify timer interval ***) procedure tmSetTimerInterval(hTimer : THandle; Interval : dword); external TimerMan name 'tmSetTimerInterval'; (*** Creating synchronized period timer with object event handler ***) function tmCreateFixedTimer( hEventProc: TNotifierEvent; // Client event handler TimeMask : ShortString;// Time period in CRON format Mode : Byte; // Timer mode Run : Boolean; // Start timer immediately Msg, // Message code UserParam : dword // User parameter for message ) : THandle; external TimerMan name 'tmCreateFixedTimer'; (*** Creating synchronized period timer ***) function tmCreateFixedTimerEx( hEventObj : THandle; // Notify object handle TimeMask : ShortString;// Time period in CRON format Mode : Byte; // Timer mode Run : Boolean; // Start timer immediately EventType : Byte; // Notify object type Msg, // Message code UserParam : dword // User parameter for message ) : THandle; external TimerMan name 'tmCreateFixedTimerEx'; (*** Modify fixed timer CRON mask ***) procedure tmSetTimerMask(hTimer : THandle; TimeMask : shortstring); external TimerMan name 'tmSetTimerMask'; (*** Load fixed timer LastTime ***) procedure tmSetLastTime(hTimer : THandle; var LastTime : TSystemTime); external TimerMan name 'tmSetLastTime'; (*** Save fixed timer LastTime ***) procedure tmGetLastTime(hTimer : THandle; var LastTime : TSystemTime); external TimerMan name 'tmGetLastTime'; implementation end.



Набор объектов-нотификаторов


Раздел Подземелье Магов н,
дата публикации 09 июля 2001г.

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



Начало работы с графикой в Delphi


Разделу Подземелье Магов

Канва и нестандартные приемы рисования

Антон Григорьев, 23 октября 1999г.

Пример №1 Проект Lines
"Резиновая" линия.

Этот пример показывает, как можно сделать "резиновую" линию - то есть такую, которая тянется за курсором, пока пользователь удерживает кнопку мыши. Такие линии применяются во всех современных графических редакторах. Второе, что делает этот пример - рисует особые линии, которые невозможно нарисовать с помощью стандартных перьев. В этом примере пять типов линий: 1) Линия, состоящая из чередующихся отрезков по пять точек красного, зелёного и синего цветов. 2) Каждая точка линии имеет свой случайным образом выбранный цвет. 3) Линия, состоящая из отдельных крестиков. 4) Линия с переменной толщиной. 5) Линия в виде "ёлочки". Метод рисования таких линий очень универсален. При этом не надо программировать алгоритмы построения линий (например, алгоритм Брезенхэма), всё делает Win API. Создание новых типов линий очень просто и ограничивается, в основном, только фантазией программиста. Но, к сожалению, описанный метод пригоден только для прямых линий. Эллипс или дугу так не нарисуешь.

Скачать проект: (106 K)

Пример №2 Проект ArcText
Этот пример демонстрирует, как вывести надпись с непрямой базовой линией.

Идея заключается в том, что для каждой буквы рассчитывается свой угол поворота, зависящий от её положения. В данном случае базовая линия представляет собой дугу окружности с заданным радиусом. Начальная точка этой дуги задаётся углом её радиус-вектора с осью Х, конечная определяется длиной надписи. Комментировать в этом примере особенно нечего, достаточно справки по CreateFontIndirect и знания элементарной геометрии.

Скачать проект: (123 K)

Автор: Антон Григорьев, Черноголовка, 1999, специально для Королевства Дельфи


Как уже отмечалось выше, установка непустой области модификации Update Region не заставляет приложение немедленно перерисоваться. Вместо этого, приложение продолжает получать сообщения из очереди, пока все сообщения не будут обработаны. Затем Windows проверяет область модификации, и если область не пустая, посылает сообщение WM_PAINT окну. При проверке области модификации могут быть посланы так же сообщения WM_NCPAINT и WM_ERASEBKGND, если требуется перерисовать рамку ( неклиентскую часть) окна или необходимо очистить окно.

Например, при увеличении размера окна будут посланы все три сообщения : WM_NCPAINT , WM_ERASEBKGND и WM_PAINT. При уменьшении размеров, окну придет только два сообщения из этой группы, сообщение WM_NCPAINT и WM_ERASEBKGND. По смыслу ситуации это резонно - при уменьшении окна клиентская часть его только урезается, следовательно стереть ее надо, а рисовать, вообще говоря, нечего...

Метод UpdateWindow требует немедленной перерисовки клиентской области в обход общей очереди. Предварительно проверяется состояние области модификации: если область модификации не пустая, окну будет послано сообщение WM_PAINT. Если область модификации пуста сообщение WM_PAINT, наоборот, не будет послано.
Если эта область была помечена для стирания, то окну предварительно будет послано сообщение WM_ERASEBKGND.

Для получения более подробной информации смотрите Help WinAPI по темам: WM_PAINT WM_NCPAINT WM_ERASEBKGND UpdateWindow InvalidateRect , InvalidateRgn GetUpdateRect , GetUpdateRgn BeginPaint & EndPaint
Все вышеперечисленные методы являются методами класса CWnd, доступного через WinAPI.
Для перерисовки окон в Delphi применяются два метода : TWinControl.RePaint TWinControl.ReFresh Метод RePaint заключается в объявлении всей области окна как некорректной и немедленного запроса на перерисовавание окна. Достаточно привести реализацию этого метода из модуля Controls.pas, чтобы это увидеть: procedure TWinControl.Repaint; begin Invalidate; Update; end; Метод Refresh является модификацией метода RePaint. Для класса TWinControl метод Refresh повторяет вызов RePaint.

Таким образом, если Вам необходимо немедленно обновить окно, воспользуйтесь методом RePaint, если в этом нет необходимости и перерисовку нужно запросить, но в порядке общей очереди, лучше использовать метод Invalidate;

Для получения более подробной информации смотрите реализацию методов: TWinControl.Invalidate TWinControl.Update метод Refresh для разных компонент, наследников от TWinControl.

Написание простейшего эксперта


Какой же код нужно написать для создания простейшего эксперта? Для этого нужно написать класс, унаследованный от IOTAWizard (определен в файле ToolsAPI.pas) или одного из его потомков, расположить в модуле процедуру Register, как мы это делали с компонентами, и вызвать внутри ее процедуру RegisterPackageWizard (const Wizard: IOTAWizard);
например: RegisterPackageWizard (TMyExpert.Create as IOTAWizard); передав ей в качестве параметра экземпляр заранее созданного эксперта.

Рассмотрим класс IOTAWizard.

IOTAWizard = interface(IOTANotifier) ['{B75C0CE0-EEA6-11D1-9504-00608CCBF153}'] { Expert UI strings } function GetIDString: string; function GetName: string; function GetState: TWizardState; { Launch the AddIn } procedure Execute; end;

Интерфейс IOTANotifier нам не понадобится, поэтому давайте рассмотрим методы IOTAWizard: Метод GetIDString должен возвращать уникальный идентификатор эксперта. Например: MyCompany.MyExpert Метод GetName должен возвращать название эксперта Метод GetState должен возвращать [wsEnabled], если эксперт функционирует, wsChecked если выбран. Метод Execute вызывается при запуске эксперта из среды IDE.

Итак, если вы хотите сами программировать действия вашего эксперта, включая добавление в меню IDE и прочее и прочее, унаследуйте его от IOTAWizard.

Если вы хотите, чтобы ваш эксперт отображался в репозитарии Delphi на произвольной странице и по щелчку по его иконке вызывался его метод Execute - унаследуйте его от IOTARepositoryWizard

IOTARepositoryWizard = interface(IOTAWizard) ['{B75C0CE1-EEA6-11D1-9504-00608CCBF153}'] function GetAuthor: string; function GetComment: string; function GetPage: string; function GetGlyph: Cardinal; end;

Метод GetAuthor должен возвращать имя от IOTAFormWizard. Он имеет все те же методы и свойства, что и IOTARepositoryWizard, если на странице проектов - от IOTAProjectWizard. Он тоже аналогичен IOTARepositoryWizard.

Если же вы хотите, чтобы пункт меню для вызова метода вашего эксперта Execute помещался в меню Help главного меню IDE, унаследуйте вашего эксперта от IOTAMenuWizard:

IOTAMenuWizard = interface(IOTAWizard) ['{B75C0CE2-EEA6-11D1-9504-00608CCBF153}'] function GetMenuText: string; end;

Метод GetMenuText должен возвращать имя пункта меню для отображения, а метод GetState возвращает стиль элемента меню (Enabled, Checked)

Вот так все просто, оказывается!



Небольшая справка по PGP:


Pretty Good Privacy (PGP) выпущено фирмой Phil's Pretty Good Software и является криптографической системой с высокой степенью секретности для операционных систем MS-DOS, Unix, VAX/VMS и других. PGP позволяет пользователям обмениваться файлами или сообщениями с использованием функций секретности, установлением подлинности, и высокой степенью удобства. Секретность означает, что прочесть сообщение сможет только тот, кому оно адресовано. Установление подлинности позволяет установить, что сообщение, полученное от какого-либо человека было послано именно им. Нет необходимости использовать секретные каналы связи, что делает PGP простым в использовании программным обеспечением. Это связано с тем, что PGP базируется на мощной новой технологии, которая называется шифрованием с "открытым ключом".

Поддерживаемые алгоритмы Deiffie-Hellman CAST IDEA 3DES DSS MD5 SHA1 RIPEMD-160

Реализуемые функции Шифрование и аунтефикация (с использованием перечисленных алгоритмов); Управление ключами (создание, сертификация, добавление/удаление из связки, проверка действительности, определения уровня надежности); Интерфейс с сервером открытых ключей (запрос, подгрузка, удаление и отзыв ключа с удаленного сервера); Случайные числа (генерация криптографически стойких псевдослучайных чисел и случайных чисел, базируясь на внешних источниках); Поддержка PGP/MIME; Вспомогательные функции.



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


"Что мы можем описать?
Увы! Это всегда лишь то, что начинает увядать и портиться".
Ницше "По ту сторону добра и зла".

Оглавление. Постановка задачи. Работы с большой оперативной памятью при 16-разрядной адресации.

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

Статья навеяна многократным изучением книги Д. Кнута "Исскуство программирования для ЭВМ" [1] и личным опытом аммировании алгоритмов, требующих большого объема оперативной памяти. Описанные в [1] методы выделения "наиболее подходящего", "первого подходящего" и "системы близнецов", а также методы освобождения оперативной памяти в настоящее время относятся скорее к операционным системам (ОС) чем к средствам разработки приложений (СРП), что отмечено в конце главы 2.5 II тома [1] самим низации эффективного использования в одной из задач 1 Гбайта оперативной памяти уже в эпоху Windows 95/98/NT/2000. Это обусловило желание высказаться по поводу работы с оперативной памятью в части касающейся СРП. Размер доступной для программы оперативной памяти зависит от разрядности вычислительного устройства, разрядности поддерживаемой ОС и СРП, на которых происходит компиляция или интерпретация алгоритма. Обычно, сначала появляются вычислители с большей разрядностью, затем для них делаются ОС и СРП. В середине 90 г.г. это были 16 и 32-разрядные процессоры, ОС и СРП. Новое тысячилетие, по-видимому, будет эрой 64-разрядных вычислительных средств. Если x0,x1,…,xn-1,xn - адрес идентификатора в программе, где xiО{0,1}, то максимально возможный адрес 2n+1. Для 16-разрядных приложений (n=15) это число составляет 65536, для 32-разрядных приложений 4294967296 (» 4 Гбайта), для 64-разрядных приложений 1,844674407371*10+19. Обычно на эти ограничения в адресации накладываются дополнительные ограничения присущие ОС и СРП. Например, в ОС Windows 95/98/NT/2000 реальный размер максимальной адресации меньше, так как часть доступной оперативной памяти забирает ОС для своих нужд. И ещё СРП позволяют создавать приложения, как правило, с фиксированной разрядностью в смысле адресации. Управление оперативной памятью всегда было актуальной задачей, так как она является одним из дорогостоящих ресурсов предоставляемых вычислительными устройствами. В таблице показана динамика цен оперативной памяти в зависимости от размера для двух фирм в августе 2000 года.

Название фирмы Серийный номер (part number) Объём ОП Цена в долларах США
Kingston Technology KTH6521/64 32 Мбайта 168
Kingston Technology KTH6521/64 64 Мбайта 143
Kingston Technology KTH6521/128 128 Мбайта 269
Kingston Technology KTH6521/256 256 Мбайта 521
Kingston Technology KTH6742/512 512 Мбайта 1220
HP D6522A 64 Mбайт 126
HP D6523A 128 Mбайт 239
HP D6743A 256 Mбайт 479
HP D6742A 512 Mбайт 2643

Тенденция очевидна, за исключением схемы с номером KTH6521/64, из-за большого спроса на оперативную память в 64 Мбайт. Перед тем как приступить к основному повествованию оговорюсь, что далее речь будет идти о структурах данных состоящих из однотипных элементов. Это линейные списки [1] и массивы.

§2 Работы с большой оперативной памятью при 16-разрядной адресации.

Во времена, когда 640 килобайт (conventional memory или обычная память, или основной памятью) была пределом доступной для программистов оперативной памятью, приходилось бороться за десятки "лишних" килобайт, придумывая драйверы, позволяющие выйти за пределы возможностей 16-разрядных приложений и ограничений ОС. Например, стандарты EMS (expanded memory), которая продавалась на отдельной плате со своим процессором, и XMS (extended memory), которая была организована так же, как и основная. В настоящий момент интерес к таким драйверам снизился в связи с появлением процессоров, ОС и СРП с большей разрядностью, но для иллюстрации идей и методов представляется интересным рассмотреть и этот случай управления оперативной памятью. В ОС DOS (disc operation system) оперативная память распределялась следующим образом:

0-640Kбайт - обычная (conventional) память;

640Kбайт-1024Kбайт - старшая (upper) память (UMB);

1024Kбайт-1088Kбайт - верхняя (high) память (HMS);

1088Кбайт и выше - дополнительная (extended) память (XMS);

на отдельной плате - расширенная (expanded) память (EMS). Предположим на Вашем компьютере 2 Мбайта оперативной памяти. К 640 Кбайтам можно адресоваться непосредственно из программы, причём размер одного блока, т.е. максимальная длина оперативной памяти для переменной (идентификатора массива) не должна превышать 65519. ОС брала память для своих нужд также из 640 Кбайт. Видите ли, первоначально (при создании DOS) предполагалось, что максимальный объём требуемой оперативной памяти не превысит 1 Мбайт. Память от 640К до 1М (upper memory, старшая память, но ее нередко называют верхней памятью) была занята чем попало - и видеобуфером экрана, и областями специально для компьютера PS/2, и так далее. В дальнейшем функциональное назначение верхней памяти расширилось, в неё стали записывать резидентные программы в целях экономии основной памяти. Теперь представим, что перед нами стоит задача написать систему управления базой данных, размер записи которой составляет 1 Кбайт, а количество записей может составить несколько тысяч. Причём, для быстроты работы программы все или большая часть записей должны находиться в оперативной памяти. Понятно, что без дополнительных ухищрений в DOS такая задача решена быть не может, т.к. в ОС нет ресурса - оперативной памяти размером в несколько Мбайт с прямой адресацией. Но физически такая память есть. Надо только обойти ограничение, заложенное в ОС, чтобы заставить программу работать быстрее при выполнении операций чтения и записи в оперативную память. Обычно это делается при помощи организации связи между небольшим окном памяти с прямой адресацией, куда можно обратиться с помощью быстрых команд ОС, и большим окном верхней памяти, куда можно обратиться с помощью медленных команд ОС, но всё же более быстрых чем команды чтения/записи на долговременные носители данных. Можно долго рассказывать, как это сделать на уровне команд DOS, а можно воспользоваться библиотекой, например Object Profetional Copyright © фирмы TurboPower Software 1987-1992 и обсудить проблему на более высоком уровне. Что мы и сделаем. Для иллюстрации идей, рассматриваемых в данной статье, будет использовать язык Pascal с его реализацией в виде Borland Pascal 7.0 и Delphi 1/2/3/4/5 Copyright © фирмы Borland International, а позднее фирмы Inprise Corporation 1983-1999г.г. Выбор данных СРП обусловлен тем, что это были одни из первых средств в нашей стране, которые поддерживали объектно-ориентированное программирование (ООП) и динамически развивались. Надеюсь у заинтересованных лиц не вызовет затруднений перевести тексты на другой язык программирования, каждый из которых является канонической формой представления алгоритма, в случае необходимости. В фрагментах программ многоточием отмечены пропущенные для краткости операторы. Жирный шрифт - ключевые слова языка. В библиотеке Object Profetional (программирование на Borland Pascal 7.0) имеется объект OpArray наследуемый от AbstractArray, позволяющий управлять памятью при помощи больших двумерных массивов.



OpArray = object(AbstractArray) constructor Init(Rows, Cols : Word; ElementSize : Word; FileName : String; HeapToUse : LongInt; ArrayOptions: Byte; var Priority : AutoPriority); .... end; Объект поддерживает размещение данных в памяти с прямой адресацией, размещение данных в "верхней" памяти и временных наборах данных на долговременных носителях. Для унификации методов доступа к данным и обработки ошибок, возможно создание дополнительного объекта.

PAsciizStringArray = ^TAsciizStringArray; TAsciizStringArray = object(TObject) ... constructor Init(Rows, Cols, Element : Word; FileName: String; HeapToUse: LongInt); procedure InsertQ(var Item: Asciiz); ... end; var OA: OpArray; ... constructor TAsciizStringArray.Init(Rows, Cols, Element : Word; FileName: String; HeapToUse: LongInt ); const ArrayOptions : Word = LDeleteFile + LRangeCheck; MyDefaultPriority:AutoPriority=(LXmsArray,LRamArray,LEMSArray, LVirtualArray); {массив может располагаться в ОП с прямой адресацией (LRamArray), в "верхней" ОП (LXMSArray и LEMSArray) и во временных наборах данных (LVirtualArray)} ... var E: Word; begin XmsAvailable := TRUE; OA.Init(Rows, Cols, Element, FileName, HeapToUse, ArrayOptions, MyDefaultPriority); Count := 0; E := OA.ErrorA; if E <> 0 then ErrorM(E, Count); {обработка ошибок} OA.ClearA(ItemDefault, ExactInit); {предварительная очистка массива} E := OA.ErrorA; if E <> 0 then ErrorM(E, Count); {обработка ошибок} ... end; procedure TAsciizStringArray.InsertQ(var Item: Asciiz); var E: Word; begin OA.SetA(count, 0, Item); {метод вставки, наследуемый от AbstractArray } E := OA.ErrorA; if E <> 0 then ErrorM(E, count); Inc(Count); end; ... Для использования объекта надо описать его и запросить ресурс в оперативной памяти.

... PS: PAsciizStringArray; AS: Asciiz; ... PS := New(PAsciizStringArray, Init(MaxSize, 1, SizeOf(S), 'kadr.wrk', MaxAvail div 2 )); ... PS^.InsertQ(AS); {вставка новой строки в динамический массив} ... Попутно отметим, что в объекте TAsciizStringArray могут быть решены также вопросы отсева дубликатов, поиска, сортировки и другие, выходящие за рамки тематики статьи. Также обратите внимание на размер запрашиваемой памяти с прямой адресацией - параметр HeapToUse, который равен половине доступной памяти (через функцию MaxAvail). Это необходимо предусматривать, т.к. возможны явные или неявные запросы на свободную память из других мест Вашей программы или из программ работающих параллельно с Вашей и требующей памяти, для избежания коллизий. Программа, фрагменты текста которой приведены выше, будет работать в DOS или как эмулируемое DOS приложение в последующих ОС Windows фирмы Microsft. В поддиректории "XMS в DOS" можно найти исходные тексты системы "Кадры", при программировании которой использовался вышеописанный механизм хранения данных.




Некоторые принципиальные моменты при создании клиентской части


Как уже пояснялось, при создание XML-документа используется его представление в виде DOM модели. Ниже приведен пример части текста Delphi программы создания заголовка xml сообщения.

procedure TThread1.HeaderCreate(Sender: Tobject); var coDoc : CoDomDocument ; // объявление сокласса, необходим для создания Doc : DomDocument ; // объекта XMLDomDocument r : IXMLDOMElement; // объявление объектов DOMElement Node : IXMLDOMElement; // txt : IXMLDOMText; // DOMText attr : IXMLDOMAttribute; // DOMAttribute begin Doc:=coDoc.Create; // создание документа DOM Doc.Set_async(false); // установка синхронного режима обрабработки Doc.LoadXML('<Header/>'); // начальная инициация DOM документа r:=Doc.Get_documentElement; // получение адреса корневого элемента Node := Doc.createElement ( 'Sender'); // создание DOMElement (таг <Sender>) txt := Doc.createTextNode( 'ООО "Тайфун"'); // создание техстового узла 'ООО "Тайфун"' Node.appendChild(txt); // присвоение узлу <Sender> значение // техстового узла 'ООО "Тайфун"' r.appendChild(Node); // добавление элемента <Sender> в корень // документа как дочернего Node := Doc.createElement ( 'From'); // аналогичные операции для тага <From> txt := Doc.createTextNode( 'http://tayfun.ru/xml/default.asp'); Node.appendChild(txt); r.appendChild(Node); Node := Doc.createElement ( 'To'); // аналогичные операции для тага <To> txt := Doc.createTextNode( 'http://irbis.ru'); Node.appendChild(txt); r.appendChild(Node); Node := Doc.createElement ( 'TypeDocument'); // создание DOMElement (<TypeDocument Id>) Att := Doc.createAttribute ( 'Id ', ' Order'); // создание узла XMLDOMAttribute Node.appendChild(Att); // <TypeDocument Id="Order"/> r.appendChild(Node); end;

Следует отметить, что объявление переменной coDoc : CoDomDocument и Doc : DomDocument , а также ее создание методом Create ( Doc:=coDoc.Create;) осуществляется один раз. Объявление переменной находится в секции описания глобальных переменных, а не в локальной процедуре, как было продемонстрировано для наглядности в данном примере (т.е. одна глобальная переменная типа DomDocument на один программный модуль).


Результатом работы вышеприведенной программы будет созданный заголовок <Header>, приминительно к нашему примеру xml-документа: изображен на Рисунок 7.





Рис 7.

Рис 8.

Основное приемущество передачи информации в виде XML-документов в том, что существует возможно формировать сообщение, используя независимые структуры таблиц в СУБД как на принимаемой, так и на передаваемой стороне. Используя наш пример, пусть требуется передать информацию об инвойсах Предприятия А, из СУБД имеющий структуру, изображенную на Рисунок 6

Для формирования xml-документа, содержащего инвойс первоначально строится SQL-запрос (запрос А) с информацией о самом инвойсе:

SELECT * FROM Invoice_General WHERE InvoiceNum = :num // :num - параметр, который задает номер инвойса.

и далее строится SQL-запрос (запрос В) информация о товарах, описываемых в инвойсе (детальная спецификация):

SELECT Goods,Qulity,Price, HZ_cod FROM Goods WHERE InvoiceNum = :num // :num - параметр, который задает номер инвойса.

Ниже представлена часть программы, формирующей тело xml-документа:

procedure TThread1.DataBodyCreate(Sender: Tobject); var //coDoc : CoDomDocument ; // объявление сокласса и объекта XMLDomDocument //Doc : DomDocument ; // должно быть глобальным, для всего модуля. r : IXMLDOMElement; // объявление объектов DOMElement Node, Node2 : IXMLDOMElement; // DOMElement; Node3, Node4 : IXMLDOMElement; // txt : IXMLDOMText; // DOMText str : String; // InvoiceNumber: integer; - глобальная переменная - имеет значение 987654 // queryA, queryB : String; - глобальная переменная, имеет значение, соответсвующее запросу // queryA - запрос А генеральная информацией об инвойсе // queryB - запрос B информация о товарах, описываемых в инвойсе (см. текст) begin Query.Close; // закрывает запрос для доступа Query.Text := queryA; // см. по тексту "запрос А" Query.Params[0].AsInteger := InvoiceNumber; // присваивание значения параметров Query.ExecSQL; // выполнение запроса Query.Open; // открытие доступа к данным запроса r:=Doc.Get_documentElement; // получение адреса корневого элемента Node2 := Doc.createElement ( ' Request '); // создание DOMElement (таг <Request>) Node := Doc.createElement ( 'Invoice'); // создание DOMElement (таг <Invoice >) r.appendChild(Node2); // добавление элемента <Request> в корень Node2. appendChild(Node); // добавление элемента <Invoice> в <Request> Node3 := Doc.createElement ( 'Depurture') ; // создание DOMElement (таг <Depurture>) Node. appendChild(Node3); // добавление элемента <Depurture> в <Invoice> str:= Query.FieldByName('Depurture').AsString; // обращение к полю 'Depurture' запроса txt := Doc.createTextNode( str); // создание техстового узла = значению поля Node.appendChild(txt); // присвоение узлу <Invoice> значение // техстового узла, переменной str // аналогичные операции для тага <Destination>, <DataSend>, <DataDepurture>, <Currency> // <DestinationCompany> (поле DB "Consignee" ) Node := Doc.createElement ( 'Destination'); str:= Query.FieldByName('Consignee ').AsString; // имя поля БД может и не совпадать с именем txt := Doc.createTextNode( str); // тага, в этом приемущество использования Node.appendChild(txt); // DOM интерфейса перед СУБД, имеющим // поддержку XML-интерфейса, типа ORACLE 8i ... // или Ms SQL 2000 // формирование запроса на спецификацию по товарам Query.Close; // закрывает запрос для доступа Query.Text := queryВ; // см. по тексту "запрос В", информац. О товарах Query.Params[0].AsInteger := InvoiceNumber; // присваивание значения параметров Query2.ExecSQL; // выполнение запроса Query.Open; // открытие доступа к данным запроса Node3 := Doc.createElement ( ' Imems') ; // создание DOMElement (таг <Imems>) Node. appendChild(Node3); // добавление элемента <Imems> в <Invoice> while not Eof.Query do begin // цикл по всем строкам запроса Node4 := Doc.createElement ( 'Imem'); Node3.appendChild(Node4); // добавление элемента <Imem> в <Imems> str:= Query.FieldByName('Price').AsString; // формирование данных для тага <Price> txt := Doc.createTextNode( str); Node.appendChild(txt); ... // аналогичные операции для тагов <HZ_Cod>, <Quality>, <GoodName> end; end;

В результате выполнения данной процедуры формируется следующий текст XML-документа:



Для формирования запроса используется метод Open объекта IXMLHttpRequest:

procedure Open(const bstrMethod, - тип метода ="POST" bstrUrl, - Url адрес сервера varAsync, - режим связи асинхронный/синхронный = true bstrUser, - имя пользователя для аутентификации bstrPassword) - пароль

Некоторые решения с применением генераторов.


Раздел Подземелье Магов

Итак, поставлены две задачи для Interbase: 1. Отслеживать процентовку долго выполняющейся хранимой процедуры. 2. Прерывать безопасным способом слишком долго выполняющуюся процедуру. Для задачи 1 потенциально возможны без изменения исходного кода Interbase два решения: а) с применением специально написанных пользовательской функции, передающей "третьему лицу" значение отслеживаемого параметра. б) использование генератора. Генераторы - уникальные объекты Interbase. Уникальны они тем, что их значение изменяется и без вездесущего COMMIT. Стандартные и нестандартные способы применения генераторов описаны Д. Кузьменко в статье http://ib.demo.ru/DevInfo/generator.htm . Получается, что их можно использовать в качестве глобальных целочисленных переменных сервера. Итак, пусть даны две таблицы CREATE TABLE T1( F1 INTEGER ); CREATE TABLE T2( F1 INTEGER ); Отследить надо процесс перекачивания данных из первой таблицы во вторую. Конечно, этот пример слишком прост, так как для этой цели не обязательно использовать процедуры, перекачать можно простым INSERT-ом. Но на этом простом примере отработаем приемы, которые пригодятся в дальнейшем для отслеживания длительных процедур, выполняющих сложные расчеты и т.д.

Зададим три генератора:

генератор автоинкрементного поля для таблицы 1 CREATE GENERATOR j_gen; SET GENERATOR j_gen to 0;

генератор для процентовки CREATE GENERATOR PROC_gen; SET GENERATOR PROC_gen to 0;

генератор, обозначающий код ошибки (по ходу решаем задачу 2) CREATE GENERATOR error_code_gen; SET GENERATOR error_code_gen to 0;

Определим три процедуры

SET TERM ^ ; /* процедура заполнения таблицы 1 */ CREATE PROCEDURE FILL (x INTEGER) RETURNS (error_code INTEGER) /*Возвращающей код ошибки*/ AS declare variable j integer; BEGIN BEGIN /*Сначала обнулим безопасным способом код ошибки*/ error_code=gen_id(error_code_gen, 0); WHILE (error_code<0) DO error_code=gen_id(error_code_gen, 1); j=0; WHILE (j<x) DO begin /*вот здесь и обрабатывается "событие" ошибки, так как значение генератора доступно и другому пользователю*/ error_code=gen_id(error_code_gen, 0); if (error_code<0) then begin Exit; end /*автоинкремент и вставка*/ j=gen_id(j_gen, 1); INSERT INTO T1(F1) VALUES (:j); end END END ^ /*процедура, процентовка которй отслеживается*/ CREATE PROCEDURE TEST_PROC (x INTEGER) RETURNS (error_code INTEGER) AS declare variable i integer; declare variable j integer; declare variable maxj integer; declare variable f1 integer; BEGIN BEGIN /*Сначала обнулим безопасным способом код ошибки*/ error_code=gen_id(error_code_gen, 0); WHILE (error_code<0) DO error_code=gen_id(error_code_gen, 1); /*Сначала обнулим безопасным способом процентовку*/ i=gen_id(PROC_gen, 0); WHILE (I<>0) DO i=gen_id(PROC_gen, -1); /*Узнаем, чему равно 100%*/ SELECT COUNT(F1) FROM T1 INTO :MAXj; j=0; /*Началась процентовка*/ FOR SELECT F1 FROM T1 INTO :f1 do begin /*вот здесь и обрабатывается "событие" ошибки, так как значение генератора доступно и другому пользователю*/ error_code=gen_id(error_code_gen, 0); if (error_code<0) then begin Exit; end j=j+1; IF (j>(i*maxj/100)) THEN BEGIN /*Еще раз напомним, что значение генератора видно другим пользователям до вездесущего COMMIT-а*/ i=gen_id(PROC_gen, 1); END INSERT INTO T2(F1) VALUES (:f1); END END END ^ /* Процедура-останавливалка. Запускается другим пользователем */ CREATE PROCEDURE MAKE_ERROR (do_error_code INTEGER) /*Задаваемый код ошибки*/ RETURNS (error_code INTEGER) AS BEGIN BEGIN /*Сначала обнулим безопасным способом код ошибки*/ error_code=gen_id(error_code_gen, 0); WHILE (error_code<0) DO error_code=gen_id(error_code_gen, 1); /*Установим значение кода ошибки*/ WHILE (error_code<>do_error_code) DO error_code=gen_id(error_code_gen, -1); END END ^ SET TERM ;^

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

Скачать архив (12 K)

Кубанычбек Тажмамат уулу,
30 мая 2001г.
Специально для



Некоторые решения с применением хранимых процедур. ( v.1.02.)


Раздел Подземелье Магов

С учетом замечаний читателей изменена нотация в задаче 1.

Язык SQL поначалу кажется очень неповоротливым. Но по мере его освоения приходит мысль о том, что здесь имеем дело с МНОЖЕСТВОМ записей, отвечающих определенным непротиворечивым условиям. Хранимые процедуры - мост между этим МНОЖЕСТВОМ записей и ОТДЕЛЬНОЙ записью, принадлежащей этому множеству. Вот решения некоторых задач с применением хранимых процедур. Применяемый SQL сервер - народный interbase\firebird. Одновременное отображение физических и юридических лиц, отвечающих дополнительному условию. Перестройка баз данных из источника, не поддерживающего автоматической целостности ссылочной системы с проверкой уникальности первичных ключей и целостности внешних ключей. Выборка пакетами записей с фиксированным числом записей. Примеры из жизни - в поисковой системе отображаются страницы 1-20, 21-31 и т.д. число записей, удовлетворяющих условиям поиска. Другой упрощенный пример: обещанный в firebird 1.0 по просьбам трудящихся select top(n) from ... - выборка первых n записей, отвечающих определенному условию.

Сырцы взяты из текущих проектов, но, думаю, применяемые решения будут понятны (и полезны).

1. Одновременное отображение физических и юридических лиц, отвечающих дополнительному условию.

Иногда бывает необходимо держать данные о физ лицах и юр лицах в разных таблицах.
Краткое описание таблиц PERSON лица NATUR физ лица JURID юр лица NAT_HIST история физ лиц JUR_HIST история юр лиц OWNER владельцы ценных бумаг SECUR ценные бумаги Имена внешних ключей деталей совпадают с соответствующими именами первичных ключей мастеров (мастер-деталь) плюс суффикс (иногда).
Владельцы ценных бумаг считаются просто ЛИЦАМИ, а какое это лицо и его ФИО (в случае физ лица) или НАЗВАНИЕ (в случае юр лица) отобразит хранимая процедура. CREATE TABLE PERSON( PERSON_CODE INTEGER NOT NULL PRIMARY KEY ); CREATE TABLE NATUR( NATUR_CODE INTEGER NOT NULL PRIMARY KEY , PERSON_CODE_E INTEGER NOT NULL , FOREIGN KEY (PERSON_CODE_E) REFERENCES PERSON (PERSON_CODE) ON UPDATE CASCADE ON DELETE CASCADE ); CREATE TABLE JURID( JURID_CODE INTEGER NOT NULL PRIMARY KEY , PERSON_CODE_E INTEGER NOT NULL , FOREIGN KEY (PERSON_CODE_E) REFERENCES PERSON (PERSON_CODE) ON UPDATE CASCADE ON DELETE CASCADE ); А вот и текст процедуры. CREATE PROCEDURE SP_ALL_OWNERS ( /*входные аргументы*/ NAME_FRAG VARCHAR(20), /*вызывающий обрамляет его в %%*/ SECUR_CODE INTEGER, BROKER_CODE INTEGER) RETURNS ( /*выходные аргументы*/ NAME VARCHAR(45), PERSON_CODE INTEGER, SECUR_CODE_G INTEGER, OWNER_CODE INTEGER) AS begin /*условия, общие для физ и юр лиц*/ for select SECUR_CODE_G, OWNER_CODE, PERSON_CODE_G from OWNER where OWNER.SECUR_CODE_G=:SECUR_CODE and OWNER.BROKER_CODE=:BROKER_CODE into :SECUR_CODE_G, :OWNER_CODE, :PERSON_CODE do begin /*условия, частные для физ лиц*/ for select FIO from NATUR ,NAT_HIST where NAT_HIST.FIO LIKE :NAME_FRAG and NATUR.PERSON_CODE_E=:PERSON_CODE and /*лицо*/ NATUR.NATUR_CODE=NAT_HIST.NATUR_CODE and NAT_HIST.VALID_NOW=1 into :NAME do suspend; /*условия, частные для юр лиц*/ for select FULL_NAME from JURID ,JUR_HIST where JUR_HIST.FULL_NAME LIKE :NAME_FRAG and JURID.PERSON_CODE_E=:PERSON_CODE_ and /*лицо*/ JURID.JURID_CODE=JUR_HIST.JURID_CODE JUR_HIST.VALID_NOW=1 into :NAME do suspend; end end^ при создании физ и юр лиц : каждой записи физ лица соответствует одна запись лица; каждой записи юр лица соответствует одна запись лица; множества лиц физических и юридических не пересекаются; одной записи для физ лица соответствует хотя бы одна запись истории физ лица; одной записи для юр лица соответствует хотя бы одна запись истории юр лица. Для автоматического выполнения этого условия надо физ и юр лица создавать следующими процедурами CREATE PROCEDURE ADD_NATUR_E (name VARCHAR(45)) RETURNS (record_no INTEGER, error_code INTEGER, masterkey INTEGER, current_hist INTEGER) AS BEGIN BEGIN record_no=0; error_code=0; /*Создание ЛИЦА*/ EXECUTE PROCEDURE ADD_PERSON :x RETURNING_VALUES :masterkey, :error_code; IF (error_code=0) THEN BEGIN /*Создание физ лица*/ record_no=gen_id(NATUR_gen, 1); INSERT INTO NATUR (NATUR_CODE, PERSON_CODE_E) VALUES (:record_no,:masterkey); /*Создание истории физ лица*/ EXECUTE PROCEDURE ADD_NAT_HIST :record_no, 1 RETURNING_VALUES :current_hist, :error_code; UPDATE NAT_HIST SET FIO = :name WHERE NAT_HIST_CODE = :current_hist; END END END ^ CREATE PROCEDURE ADD_JURID_E (name VARCHAR(45)) RETURNS (record_no INTEGER, error_code INTEGER, masterkey INTEGER, current_hist INTEGER) AS BEGIN BEGIN record_no=0; error_code=0; /*Создание ЛИЦА*/ EXECUTE PROCEDURE ADD_PERSON :x RETURNING_VALUES :masterkey, :error_code; IF (error_code=0) THEN BEGIN /*Создание юр лица*/ record_no=gen_id(JURID_gen, 1); INSERT INTO JURID (JURID_CODE, PERSON_CODE_E) VALUES (:record_no,:masterkey); /*Создание истории юр лица*/ EXECUTE PROCEDURE ADD_JUR_HIST :record_no, 1 RETURNING_VALUES :current_hist, :error_code; UPDATE JUR_HIST SET FULL_NAME = :name WHERE JUR_HIST_CODE = :current_hist; END END END ^ При удалении физ или юр лиц достаточно удалит ЛИЦО, все остальное будет удалено каскадно.


Для отображения в детали (мастер-деталь) результата, возвращаемого хранимой процедурой, в компоненте TIBQuery, как известно можно создать запрос с параметром.

select * from SP_ALL_OWNERS('%некто%', :SECUR_CODE) order by NAME;') а назначив свойство qryDetail.DataSource=masterDataSource, можно дать понять IBX-у, что значение параметра :OWNER надо искать в текущей записи указанного мастера.

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

Проверка уникальности первичных ключей
Описание таблиц: SPORG1 - буферная таблица, полученная средствами, типа IBpump, без определения уникальных полей, первичных ключей и т.д. После выполнения процедуры в ней остаются "плохие" записи OK_SPORG1 - итоговая таблица с описанием первичных ключей CREATE PROCEDURE TEST_UNIQ_SPORG1 ( X INTEGER) AS declare variable iCode integer; begin iCode=0; for select code from SPORG1 into :iCode do begin insert into OK_SPORG1 SELECT * FROM SPORG1 where code=:iCode; delete from SPORG1 where code=:iCode; WHEN SQLCODE -803 DO BEGIN iCode=iCode; end end end ^ Проверка целостности внешних ключей
Описание таблиц: CLIENT_STREET - буферная таблица, полученная средствами, типа IBpump, без определения внешних ключей. После выполнения процедуры в ней остаются "плохие" записи OK_CLIENT_STREET - итоговая таблица с описанием внешних ключей и привязкой к мастер-таблице. CREATE PROCEDURE TEST_INTEG_CLIENT1 ( X INTEGER) AS declare variable iCode integer; begin for select tel from CLIENT_STREET into :iCode do begin insert into OK_CLIENT_STREET SELECT * FROM CLIENT_STREET where tel=:iCode; delete from CLIENT_STREET where tel=:iCode; WHEN SQLCODE -530 DO BEGIN iCode=iCode; end end end ^ При ошибке, оказывается, процедура не вылетает с откатом текущей транзакции, а просто возвращает код ошибки и ЦИКЛ ПРОДОЛЖАЕТСЯ.

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

То же самое наблюдалось при закачивании аналогичной таблицы из формата dbf в interbase с применением препроцессора gpre и низкоуровневым доступом к формату dbf (будет описано в следующей статье).

3. Выборка пакетами записей с фиксированным числом записей.

CREATE PROCEDURE SHOW_PART( SINCE INTEGER, TILL INTEGER) RETURNS ( THE_CODE integer, NAME varchar(10)) AS declare variable i integer; begin i=0; for select THE_CODE, NAME from MY_TABLE where NAME='qq' into :THE_CODE, :NAME do begin i=i+1; if ((SINCETILL) then begin exit; end end ^ при n1>1 приведенное решение немного неоптимально, т.к. серверу приходится перебирать заново все записи, соответствующие поставленному условию.

Верхняя допустимая граница TILL, как известно, определяется простым select count()-ом

Выборку производить следующим образом
select * from SHOW_PART(1,3); - показать с первой по третью записи, удовлетворяющие заданному в процедуре условию.

Кубанычбек Тажмамат уулу,
16 мая 2001г.


Некоторые важные моменты


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

На правом рисунке отчетливо виден шум. Этого отчасти можно было бы избежать, используя неоднороные рисунки с резкими переходами цвета, а также рисунки большего формата. Или можно написать такой хитрый алгоритм кодирования, что второе изображение будет невозможно отличить от первого. В примере вместо увеличения размера рисунка я просто уменьшил количество информации:



Немного истории


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

В начале 90-х годов прошлого века я занимался разработкой контроллеров на i8051 и софта для них (макроассемблер 2500 A.D.). И был тогда сделан "драйвер виртуальных таймеров", расширяющий возможности однокристалки (у нее всего два аппаратных таймера) по обеспечению программы инструментами отсчета времени. Будильников там еще не было. Работа велась в обработчике аппаратного прерывания.

В 1993 году в составе программы верхнего уровня системы учета энергоресурсов в среде DOS (Turbo-Pascal), в разработке которой я участвовал, был таймерный менеджер (тот самый TIMERMAN). Он предоставлял набор интервальных таймеров и ежесуточных будильников, имея обработчики прерываний стандартного таймера ($1C) и будильника RTC ($4A). Интервал в секундах до 65535. Обработка таймеров выполнялась, когда менеджер получал управление в общем цикле программы (была организована кооперативная многозадачность между модулями). Клиент мог сам проверять таймер или передать адрес своей процедуры - натуральный callback. Позднее, с переходом на BP7 и protected mode, менеджер перекочевал в независимую DLL.

В 1997 году Timerman был портирован под OS/2 (Virtual Pascal) без изменений в архитектуре - только прерывание было заменено на Thread.

В 1999 году в связи с разработкой системы учета под Windows CE был разработан заново таймерный менеджер, и был он в виде DLL. Практически это было то, что я сейчас предлагаю, только реализация на VC++ (без использования MFC). В том же году Timerman.dll был переписан на Delphi в современном виде.



Необходимые файлы


Библиотека [crpe32.dll] содержит интерфейс вызовов API функций. Модуль [uCrystalApi.pas] с описаниями API функций. Он был подправлен мной, так как было несколько синтаксических ошибок. Для работы примера необходим источник данных, в качестве которого используется демонстрационная БД MS Access 2000 [source_db.mdb]. В качестве драйвера связи используется OLE DB для MS Jet 4.0. БД должна находиться в той же папке, где и пример отчета. Если вы хотите распространять ваше приложение с отчетами, тогда ознакомьтесь с содержимым файла [crpe32.dep], который содержит список необходимых файлов для работы RE. Пример реализован на Delphi 6.0.



Несколько слов о загрузке DLL




Здравствуйте, коллеги! Поводом для написания этой статьи стало прочтение статьи Криса Касперски .

Вкратце содержание статьи (дается в произвольном виде, со своими коментариями).

Все исполняемые модули (EXE и DLL) грузятся в память Windows(NT/2000/XP) следующим образом (я оставил только важные для нас пункты) Загрузка первой копии приложения: Прочитать служебную информацию из файла. Спроецировать в память все секции файла с защитой PAGE_EXECUTE_WRITECOPY(ну, кроме данных) Некоторые дополнительные приготовления (о них речь и пойдет в статье) Модуль готов. Загрузка всех последующих копий приложения: Прочитать служебную информацию из файла. Спроецировать в память все секции файла с защитой PAGE_EXECUTE_WRITECOPY(ну кроме данных...), здесь система ведет себя несколько по-другому, нежели при первой загрузке, поэтому я выделил ее в другой блок, но это тонкости. Некоторые дополнительные приготовления(о них речь и пойдет в статье) Модуль готов.

Отличий, вроде бы, никаких? Но (!!!) пункт 2 говорит, что память выделяется всем копиям одна и та же(!!!). Таково свойство проецируемых файлов(см. Help. Topic: CreateFileMapping, OpenFileMapping, MapViewOfFile …).
"А как же данные каждого приложения, которые не зависимы от других приложений?"- спросите Вы. А для этого и стоит защита. Как только программа пытается писать что-то в память, система делает копию этой страницы, ставит ей соответствующую защиту, и далее это приложение работает со своей (измененной) страницей, а все остальные с общей. Зачем так сложно? Из экономии памяти и увеличения быстродействия, ведь когда идет SWAP памяти, не измененные страницы система просто удаляет (ведь они остались в исполняемом файле), а измененные скачиваются в SWAP-файл. Когда данные опять понадобятся, они читаются из разных мест (из исполняемого файла или из SWAP-файла).
В первом случае мы имеем огромный плюс: Нет записи в SWAP-файл (а запись, между прочим, примерно в 3 раза медленнее, чем чтение), Не расходуется виртуальная память.

Теперь про упаковку файла. После проецирования, прежде чем модуль будет готов, он распаковывается специальной подпрограммой. Т.е. сразу при загрузке модуль переписывает всю (!!!) свою память, что заставляет систему выделить ее (память) в отдельный блок. Т.е. ни о какой экономии речь уже не идет. Ладно, если Вы запустили упакованный таким образом NotePad, а если Word? Да еще и 3 раза?

А теперь, непосредственно по теме данной статьи.


Хорошо. Мы вняли голосу умного человека и не стали паковать файл(ы). И казалось бы, все хорошо. НО Ваш проект устроен так, что он использует кучу DLL, которые Вы сами и написали. И у всех у них базовый адрес стоит $10000000(0х10000000-на CPP). А теперь вернемся к загрузке (точнее к пункту 3), попробуем понять что такое базовый адрес и зачем он нужен.
В любой программе есть инструкции, которые привязаны к адресу. Например: По адресу $1000000 у нас находится переменная "X";
Где-то мы к ней обращаемся.

... ; Какой-то код и данные org 1000000h X dword ? ; Переменная Х по адресу $1000000 Y dword ? ; Переменная Y по адресу $1000004 ... ; Какой-то код и данные mov eax,[1000000h] ; Обращаемся к переменной inc eax ; mov [1000000h],eax ; ... ; Какой-то код и данные
А теперь представим ситуацию, что загрузили модуль по другому адресу. Для примера, на 4 байта выше. Получим следующее представление:

... ; Какой-то код и данные org 0FFFFFCh X dword ? ; Переменная Х по адресу $0FFFFFC Y dword ? ; Переменная Y по адресу $1000000 ... ; Какой-то код и данные mov eax,[1000000h] ; Обращаемся к переменной inc eax ; mov [1000000h],eax ; ... ; Какой-то код и данные
Смотрим и видим, что программа обращается уже не к переменной X, а к переменной Y. Что совершенно поломает всю логику работы программы. Что делать? Правильно. При загрузке по другому адресу надо аккуратно исправить все такие инструкции. Для этого в модулях есть все данные: Базовый адрес загрузки(Base Address), и таблица перемещений(Relocation Section). После проецирования (шаг 2) система исполняет шаг 3, т.е. если по базовому адресу модуль загрузить не удалось (система всегда сначала пытается загрузить модуль по базовому адресу), то она пытается загрузить его по другому адресу, используя данные о базовом адресе, о действительном адресе и данные из таблицы перемещений(пытается, потому что таблицы перемещений может не быть, тогда говорят, что модуль имеет фиксированный базовый адрес, и загрузить его по другому адресу не возможно). Процесс загрузки по другому адресу долгий. Система пробегает по всему коду, и исправляет адреса на правильные, а таких адресов может быть десятки и сотни тысяч(!!!).

Ну, Вы уже поняли "где собака порылась"? Подсказываю, исправляет код - значит записывает туда другое значение. А теперь понятно? Правильно. Опять вся память модуля летает в SWAP и назад. И системе совершенно все равно, по какой причине произошла запись в код: при распаковке или при исправлении кода. Все равно этот экземпляр уже лежит в памяти "тяжелым грузом".

Причем, как показывает практика, таких DLL(а это относится на 99.9% к ним, т.к. до загрузки EXE в памяти процесса вообще больше ничего нет, и его(EXE) можно грузить куда угодно и по любому адресу), в системе может набираться на мегабайты. У меня например таких DLL набралось на 23М :((((((. Т.е. почти 10% физической памяти(у меня стоит 256M :)))))). Но мне хорошо. Винт быстрый, и 10% это не смертельно. А каково тем, у кого 64М? В конце статьи пример распечатки загруженных DLL для Explorer(Проводника). Жирным выделены модули, загруженные не по базовым адресам. Общая длина модулей ~1.8 метра.:(((((((

Причем самое странное, что не только рядовые программеры не заботятся об этой проблеме (извините, народ, но мы почти все, и я в том числе, относимся к рядовым) но и "бренды" вроде Касперского, Intel, и др. делают то же самое.

Как исправить создавшееся положение? К сожалению, готового решения данной проблемы у меня нет. С Visual Studio идет программа ReBase.exe, которая изменяет базовый адрес указанного модуля. Но это надо сидеть и аккуратно все(!!!) DLL исправлять. А их у меня в системе, более 5 тысяч. Поэтому этот вопрос был, есть, и "будет есть". А эта статья призвана убедить Вас уменьшить обьем хаоса в этом мире. Конечно, разные разработчики вполне могут загнать свои DLL по одному и тому же адресу. Поэтому я, для себя, например, выбрал такую тактику, все свои DLL я гружу, начиная с адреса $20000000, причем ни одна DLL не пересекается с другой, даже из разных проектов. Для этого, правда, приходиться иметь базу данных уже использованных адресов. Как показывает практика и анализ процессов в системе, системные DLL Windows имеют разный базовый адрес. Более того, некоторые из них имеют фиксированный базовый адрес(см. Пример). А также, можно заметить, что с адреса $20000000 и до адреса $30000000 с копейками, пустое пространство. Вот это место я себе и облюбовал :)))).

Вывод. В системе всегда есть "плохие" модули. Но если Вы свои модули будете разносить по разным адресам, то и стандартные модули будут грузиться по базовым адресам, и в конечном итоге Ваша система будет работать быстрее и эфективнее.

Скачать: Пример: Дополнительные утилиты: (110K) это программа для вывода информации о модулях(Пример в статье взят из нее). Проста в использовании. Я думаю коментарии не потребуются. (106K) выдает детальную информацию о состоянии памяти процесса(Используется в связке с ProcInfo)(В статье не используется, но вдруг кому-то будет интересно).

Михаил Басов


Несколько слов об организации документооборота.


Общим правилом разработки системы обмена XML документами является:

во-первых - разработка схемы потоков электронных документов и их структуры;

во-вторых - разработка таблиц функций процессов (подпроцессов) т.е. какую функцию по отношению к какому XML-документу будет реализовывать каждый процесс.

Каждый XML документ, подобно HTML документу, должен состоять из заголовка сообщения (информация заключенная тагами ) и тела сообщения (для запроса эта информация обрамленная тагами для ответа на запрос ). Для того, чтобы XML документ был правильно сформирован, необходимо его две составные части "Заголовок" и "Запрос" обрамить тегами, например <xmlDoc>. Вид типового документа представлен ниже:

Рис 4.

Рис 5.

Заголовок (Рис 4), в отличие HTML документа, должен содержать разного рода служебную информацию, в том числе информацию о типе передаваемого документа и процессе его обработки. В информационную обработку поступает тело документа, т.е. содержательная часть обрамленная тагами . Следует отметить, что структуру заголовков должна быть единой для всех типов документов.

Для запущенного сервером Процесса, алгоритм обработки предпочтительно (но не обязательно) строить следующим образом:

Рис 6.



Ну, если у Вас все готово - продолжим.


Ниже приведена иерархия классов GDI+, опубликованная в статье Виталия Брусенцева. Там же можно прочесть некоторые подробности о классах, ее составляющих.

Итак для начала подключим заголовочные файлы GDI+ в uses модуль вашей программы

uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, ComCtrls, ExtCtrls, ToolWin, GDIPAPI,GDIPOBJ; Как видите их всего два - GDIPAPI,GDIPOBJ; Продолжим , инициализируем библиотеку к работе - Для начала опишем ее var graphicsGDIPlus : TGPGraphics;

как и было раньше заявлено в конструкторе объекта TGPGraphics требуется контекст устройства (DC) куда библиотека будет пере направлять всю графику. Теперь можно и нарисовать что-то в данном примере (см. архив GDIDemo) , в обработчик события OnPaint объекта PaintBox мы выведем , как и всегда при работе с новым языком или библиотекой следующий, знакомый каждому программисту текст "Hello GDI+" четырьмя разными стилями - обычным без сглаживания, обычным с сглаживанием, с градиентной заливкой, с текстурной заливкой и под углом 45 градусов.

procedure TForm1.PaintBox1Paint(Sender: TObject); Const StrHello = 'Hello GDI+'; var R : TRect; FontFamily : TGPFontFamily; Font : TGPFont; SolidBrush : TGPSolidBrush; // Заливка непрерывным цветом GradientBrush : TGPLinearGradientBrush; // Заливка линейным градиетом TextureBrush : TGPTextureBrush; // Заливка текстурой градиетом Image : TGPImage; // Объект - Изображение Matrix : TGPMatrix; // Матрицы begin graphicsGDIPlus := TGPGraphics.Create(PaintBox1.Canvas.Handle); // Имя шрифта FontFamily := TGPFontFamily.Create('Times New Roman'); // Шрифт Font := TGPFont.Create(FontFamily, 32, FontStyleRegular, UnitPixel); // Создаем объект для непрерывной заливки SolidBrush := TGPSolidBrush.Create(MakeColor(255, 0, 0, 255)); // Рисование текста без антиалиасинга с закраской синим цветом // Установка стиля отрисовки текста - TextRenderingHintSingleBitPerPixel graphicsGDIPlus.SetTextRenderingHint(TextRenderingHintSingleBitPerPixel); graphicsGDIPlus.DrawString(StrHello, -1, Font, MakePoint(1, 10.0), solidBrush); // Рисование текста c антиалиасингом с закраской синим цветом // Установка стиля отрисовки текста - TextRenderingHintAntiAlias graphicsGDIPlus.SetTextRenderingHint(TextRenderingHintAntiAlias); graphicsGDIPlus.DrawString(StrHello, -1, Font, MakePoint(1, 40.0), solidBrush); // Рисование текста c антиалиасингом с закраской градиентом R.X := 1; R.Y := 1; R.Width := 100; R.Height := 40; // Создаем объект для градиентной заливки GradientBrush := TGPLinearGradientBrush.Create(R,MakeColor(255, 255, 255, 255),MakeColor(255, 0, 0, 255),LinearGradientModeForwardDiagonal); graphicsGDIPlus.SetTextRenderingHint(TextRenderingHintAntiAlias); graphicsGDIPlus.DrawString(StrHello, -1, Font, MakePoint(1, 70.0), GradientBrush); // Рисование текста c антиалиасингом с закраской текстурой // Шрифт заного создаем Font.Free; Font := TGPFont.Create(FontFamily, 70, FontStyleRegular, UnitPixel); Image := TGPImage.Create('01.jpg'); TextureBrush := TGPTextureBrush.Create(image); graphicsGDIPlus.SetTextRenderingHint(TextRenderingHintAntiAlias); graphicsGDIPlus.DrawString(StrHello, -1, Font, MakePoint(1, 100.0), TextureBrush); // Рисуем под углом - используем трансформацию // Шрифт заного создаем Font.Free; Font := TGPFont.Create(FontFamily, 32, FontStyleRegular, UnitPixel); graphicsGDIPlus.RotateTransform(-45); // производим graphicsGDIPlus.DrawString(StrHello, -1, Font, MakePoint(-200, 200.0), TextureBrush); graphicsGDIPlus.ResetTransform; // сбрасываем // Не забудьте высвободить память Image.Free; GradientBrush.Free; TextureBrush.Free; SolidBrush.Free; graphicsGDIPlus.Free; end;

Итак, для начала не плохо. В следующей статье мы разберем вывод примитивов, вывод графики, использование графических контейнеров. Вот в принципе и все, набор классов библиотеки прост и очевиден, ничего особо сложного в нем нет, но для более подробной информации по библиотеке GDI+ советую обратится на сайт альма-матер Microsoft или запастить демками с того-же

Скачать: (241K) (213K)

С уважением к коллегам, .





Об одном подходе к реализации Инспектора объектов


Раздел Подземелье Магов

Предварительные замечания

В свою очередь хочу поблагодарить Разинкина Игоря за некоторые , до которых я сам не дошёл ("кукушка хвалит соловья за то, что хвалит он кукушку!"). Во-первых, за хорошую мысль насчёт использования в окне Инспектора объектов компонента TPaintBox (в первых реализациях своего Инспектора я изрядно помучился с TStringGrid'ом). Во-вторых, за идею динамического создания/уничтожения редакторов свойств (я ранее размещал сразу все, что здорово притормаживало работу программы).
Ещё один момент… Все предоставленные исходные файлы Инспектора и примеры реализованы в Delphi 6, так что могут возникнуть проблемы с переносом форм в более ранние версии. Но, так как, начиная, по-моему, с пятой версии, формы в DFM-файлах хранятся в текстовом формате, можно "воссоздать" их заново, то есть читать их свойства в моих DFM и переносить в свои. Учитывая то, что многие работают на более ранних версиях, чем моя, я старался не использовать компоненты, классы или процедуры, специфичные для Delphi 6. Правда, есть в одном примере класс TObjectList (он, по-моему, появился в пятой версии), но его можно реализовать таким образом: interface ... type TObjectList = class(TList) private function GetItem(Index: Integer): TObject; public property Items[Index: Integer]: TObject read GetItem; default; function Add(Item: TObject): Integer; end; ... implementation ... function TObjectList.GetItem(Index: Integer): TObject; begin Result := TObject(inherited Items[Index]); end; function TObjectList.Add(Item: TObject); begin Result := inherited Add(Item); end; ... Остальные свойства и методы TList можно не перекрывать, они в примере не задействуются.
Последний нюанс... Инспектор далёк от совершенства: при изменении его размеров возникает "мелькание", при изменении размера полей иногда поля значений налезают на поля названий, при редактировании пропадает список редактируемых объектов. Могут возникать и непредвиденные ошибки. Всё потому, что я хотел показать лишь идею, а детали - дело техники!



Объединение ресурсов


Поскольку MTS освобождает неиспользуемые системные ресурсы в то время, когда компонент находится в состоянии ожидания (idle), эти ресурсы могут быть использованы другими объектами. Это значит, например, что соединение с базой данных (database connection), которое не используется объектом на сервере, может быть отдано другому объекту. Все это называется объединением ресурсов (resource pooling).

Поскольку открытие и закрытие соединения с базой данных процесс не быстрый, MTS использует диспетчер ресурсов (resource dispensers) для уменьшения количества используемых соединений, при этом по возможности вместо создания нового соединения, используется освободившееся. Диспетчер кэширует такие ресурсы, как соединения с базой данных, что позволяет компонентам, расположенным в одном пакете использовать их совместно. Например, если у вас есть компонент, который занимается просмотром базы данных и компонент, который ее модифицирует, то их можно поместить в один пакет для уменьшения количества соединений. Следует иметь в виду, что это возможно только при использовании Free потоковой модели.

Для работы под управлением СОМ+ рекомендуется использовать новую модель - Neutral. Особенностью ее является то, что COM объект не может использовать визуальные компоненты. При установке такого компонета в COM+ гарантируется отсутствие конфликтов при поступлении клиентских вызовов из различных потоков (thread). Данная модель предполагает, что компонент является stateless, и не возникает конфликтов при использовании глобальных переменных (объетов) при обращении из различных потоков.

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

initialization TComponentFactory.Create(ComServer, Ttest, Class_test, ciMultiInstance, {tmApartment} tmNeutral );



Объект ядра "событие"


Наиболее удобным из объектов ядра для нашей цели представляется событие (event). Активизируется он вызовом функции Win32API SetEvent, а контролируется на клиенте следующими функциями:

WaitForSingleObject WaitForMultipleObjects MsgWaitForMultipleObjects

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



Объекты и их заместители


В предыдущем разделе речь шла только о типах инспектируемых объектов. В этом разделе "фокус ввода" перемещается на инспектируемые объекты. Как было сказано, инспектор получает доступ к значениям свойств на основе RTTI. Это означает, что инспектируемые классы должны содержать объявление и реализацию published-свойств. Если мы инспектируем классы визуальных компонентов, порожденных от TComponent, то это условие выполняется автоматически и никаких других усилий нам прикладывать не нужно. Если мы проектируем классы, специально рассчитанные на инспекцию, то мы можем удовлетворить этому требованию, если при объявлении классов укажем директиву {$M+} или будем порождать классы данных от TPersistent. Все свойства, доступные для инспекции, нужно объявить в секции published. В этом случае от нас также не требуется дополнительных усилий. Ситуация осложняется, если нам требуется инспектировать объекты, которые не содержат RTTI или вообще не являются Delphi-объектами. Такое может произойти, например, если: мы вводим инспектор объектов в уже существующий проект, в котором изначально не предполагалось наличие инспектора, требуется инспекция объектов, разработанных сторонними разработчиками, объекты реализуются на другом языке программирования или доступны только через их интерфейсы (например, COM-объекты), объекты размещаются в адресном пространстве другого процесса или на другой машине в локальной сети. Для того, чтобы иметь возможность инспекции объектов различной природы и происхождения, вводится понятие "объект-заместитель" (proxy). Те, кто знаком с книгой Эриха Гамма и др. "Приемы объектно-ориентированного проектирования. Паттерны проектирования" сразу поймут, в чем дело. При инспекции объекта, который не содержит RTTI, динамически создается его заместитель, который, с одной стороны, имеет RTTI и соответствующие published-свойства, а, с другой стороны, содержит ссылку на инспектируемый объект и перенаправляет запросы на получение и изменение свойств соответствующим методам, интерфейсным входам или полям данных реального инспектируемого объекта. После инспекции объекта его заместитель просто уничтожается. Таким образом, для инспектора создается иллюзия, что он работает с родным Delphi-объектом. Способ создания proxy-объекта тесно связан с тем, как реализован сам инспектируемый объект. Естественно, что в каждом конкретном случае потребуется конкретное решение. Для примера предположим, что инспектируемый объект - прямоугольник, то есть, экземпляр записи типа TRect. Тогда реализация объекта-заместителя может быть такой:


type {$M+} TRect_Proxy = class public constructor Create(ARect: PRect); private FRect: PRect; // указатель на экземпляр записи function GetLeft: Integer; function GetTop: Integer; function GetWidth: Integer; function GetHeight: Integer; procedure SetLeft(const Value: Integer); procedure SetTop(const Value: Integer); procedure SetWidth(const Value: Integer); procedure SetHeight(const Value: Integer); published property Left: Integer read GetLeft write SetLeft; property Top: Integer read GetTop write SetTop; property Width: Integer read GetWidth write SetWidth; property Height: Integer read GetHeight write SetHeight; end; {$M-} constructor TRect_Proxy.Create(ARect: PRect); begin Assert(Assigned(ARect)); FRect := ARect; end; function TRect_Proxy.GetLeft: Integer; begin Result := FRect^.Left; end; ... procedure TRect_Proxy.SetHeight(const Value: Integer); begin FRect^.Bottom := FRect^.Top + Value; end;
Для случая, когда инспектируемый объект находится, например, на другой машине локальной сети, реализация прокси-объекта будет сложнее и определится тем, как конкретно реализовано сетевое взаимодействие.


Обработка поступивших данных


Данные, поступившие от DDE сервера представляют собой строку параметров заключенную в апострофы где передаваемые данные разделены запятыми.

Число параметров может колебаться в произвольной степени в зависимости от функции Script Language.

Для чтение параметров создана функция // получить параметр вернутый PM по порядковому значению Function EncodeParams(Value : PChar; NN : Integer) : String; возвращающая параметр в виде строки, причем NN - является номером параметра в переданном списке (причем для чтения самого первого параметра нужно указать NN равным 0)



Обзор существующих библиотек.


Первое что я сделал – сходил на torry.ru и был удивлен обилием библиотек и функций для разного рода шифрования. Функциональность их я проверять не стал, а остановился на PGP-пишных компонентах.

PGPComp - ДОСовская, работает по принципу запуска внешнего exe-файла, сразу отпала по той причине - что нужно будет устанавливать MSDOS версию PGP (Кроме того библиотека только под 1 и 2 Delphi). Вспомнил что в моей любимой почтовой программе The Bat встроена поддержка PGP, зашел на их сайт - скачал библиотеку dklib.dll, любезно предоставленную ими, но почему то у меня не один из примеров не пошел, а за отсутствием исходников, я не мог понять почему. Пробовал обраться к да не отвечает он. А неплохая библиотека, по крайней мере по тому что написано в документации присутствует тот необходимый минимум функций для шифрования-дешифрования, проверки ключа и сама библиотека весит не очень много – 184'832 Байт.

Т.е. меня не устроили эти библиотеки и я пошел на , в поисках истины. Нашел там упоминание про библиотеку для разработчиков – PGPsdk.



Описание архива


Скачать архив (51 K)
Архив содержит следующие файлы:
В каталоге Main: Props.pas - особенности и их контейнеры; PrtCtrls.pas - классы-носители особенностей; PrtEdits.pas - редакторы особенностей; Insp.pas - собственно Инспектор; InspFM.* - форма Инспектора; CheckFM.* - TCheckListBox в виде диалога. Вне каталога Main: ExampleX, UnitX - файлы примеров (X = 1, 2, 3, 4); Article.doc - эта статья. Примечание: Для сокращения размеров архива я удалил некоторые файлы проектов: *.dof, *.cfg, *.res. У меня это к проблемам не привело; компилятор сперва ругнулся и предложил создать эти файлы автоматически.

Внимание! Архив желательно распаковать в новую папку, так как файлы в нём лежат "просто так", не находясь в какой-либо директории!

Если появятся вопросы, возникнут проблемы или идеи, пишите мне! Буду только рад!

Романенко Владимир

Смотрите по этой теме:



Определение кратчайшего пути между двумя точками


лес,
дата публикации 02 июня 2003г.


Предпосылки.

Недавно мне пришлось столкнуться с проблеммой нахождения кратчайшего пути между двумя точками. Существует несколько методов для решения этой задачи (метод Флойда, алгоритм Дейкстры и др.) Но описания этих методов мне показались сложными (и для меня - не математика - не совсем понятными), поэтому хотелось найти, что-нибудь более простое.

Эта тема уже поднималась на страницах нашего сайта (в рубрике Подземелье магов, А. Моисеевым ). Там была приведена реализация алгоритма Дейкстры. Но эта реализация оперирует не совсем понятными мне понятиями типов территорий (всего 6 типов) и, несомненно, предоставляя бОльшие возможности разработчику, становится сложнее по определению. Мне же было необходимо определить всего две вещи: существует ли в принципе какой-нибудь путь, и, если существует, найти кратчайший. (Как это происходит в известных играх Lines или Sokoban).

Здесь я хотел бы описать метод, разработанный мной и моим коллегой Манфредом Рауером (Manfred Rauer). Мы не претендуем на приоритет но, так как не являемся профессиональными математиками и не знаем известен ли уже этот алгоритм (во всяком случае я не нашел похожего описания), мы назвали его Алгоритмом Кегелеса-Рауера.

Задача.

Определить кратчайший путь между двумя точками на плоскости, обходя имеющиеся на ней препятствия.

Алгоритм.

Плоскость (поле) на которой следует определить путь представляется массивом чисел (integer), в котором преграда получает значение "-1", точка финиша (цель) - значение "1", а все остальные точки - значения "0". Затем от цели (элемент со значением "1") веером во все стороны, пока не встретиться преграда (-1) элементам массива, имеющим нулевое значение присваиваются значения на единицу большие, чем у соседнего элемента.

Выглядит это, приблизительно так, если поле символически изобразить таким образом: ####### # S # # ### # # # # F # ####### где # - преграда, S и F - точки старта и финиша; то массив будет иметь следующий вид: после инициализации: после заполнения значениями: -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 0 0 0 0 0 -1 -1 6 7 8 7 6 -1 -1 0 -1 -1 -1 0 -1 -1 5 -1 -1 -1 5 -1 -1 0 0 0 0 0 -1 -1 4 3 2 3 4 -1 -1 0 0 1 0 0 -1 -1 3 2 1 2 3 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1


Теперь проверяется значение соответствующее точке начала движения. Если оно равно 0 - то пути нет, а если оно имеет какое-то значение, то остается проследовать по числам в массиве в убывающем порядке до цифры 1.
Все.

PS.
Есть 2 ограничения. Предполагается, что поле конечно, (например, ограничено со всех сторон преградами) и двигаться можно только по горизонтали или вертикали (диагональное движение отсутствует).

Реализация.
Механизма нахождения кратчайшего пути показан в приводимой ниже процедуре, в которую передаются координаты точек начала и конца движения. Из этой процедуры я намерено вывел все дополнительные проверки (напр., такие как if Map[RowFinish, ColFinish] = - 1 then Exit;), чтобы не затруднять понимание ее сути.

// Я предполагаю, что размер поля не больше, чем 255 х 255 точек (или клеток), // в противном случае, передаваемые аргументы должны быть больших // целочисленных типов, напр., Word или Cardinal. // Кроме того предполагается, что переменные FeldHeight и FeldWidth, // определяющие размеры поля, объявлены как глобальные, если нет, то их // тоже нужно передать в процедуру, в качестве дополнительных аргументов procedure Find(RowStart, ColStart, RowFinish, ColFinish: Byte); var row, // строка массива col, // столбец массива i, // счетчик итераций циклов Number: Word; // количество элементов массива со значением 0 // для определения верхнего предела цикла замены // нулей рабочими значениями Val: Integer; // значение текущего элемента массива Map: array of array of Integer; // главный рабочий массив begin // Задаю размер массива, если размеры поля известны заранее (на этапе проектирования), // и используется статический двумерный массив, то эта комманда опускается SetLength(Map, FeldHeight, FeldWidth); // Заполняю массив значениями: преграда -1, цель (финиш) 1, все остальное 0 // Значения беруться из глобального массива ActiveFeld, определяющего профиль поля for col := 0 to FeldWidth - 1 do for row := 0 to FeldHeight - 1 do if (ActiveFeld[row, col] = '#') then Map[row, col] := -1 else Map[row, col] := 0; // В принципе поле ActiveFeld может быть бОльшим, чем проверяемый нами в данный // момент участок, тогда надо просто в выражении (ActiveFeld[row, col] = '#') задать // смещение для строк и столбцов массива ActiveFeld (ActiveFeld[row+X, col+Y] = '#') // Задаю значение для элемента массива соответствующего точке финиша Map[RowFinish, ColFinish] := 1; // На вский случай обнуляю переменные, хоть это и не обязательно, т. к. Delphi, // при их создании сама присвоит им нулевые значения. Но так понятнее. Number := 0; Val := 0; // Определяю количество незаполненных точек (клеток поля) - элементов // массива с нулевыми значениями. Это нужно для того, чтобы задать верхнюю границу // следующего цикла, заполняющего массив значениями. В любом случае число его // итераций не может превышать количества нулевых элементов for col := 0 to FeldWidth - 1 do for row := 0 to FeldHeight - 1 do if Map[row, col] = 0 then Inc(Number); // Заменяю нулевые значения массива соответствующими числами for i := 1 to Number do begin Inc(Val); for col := 1 to FeldWidth - 2 do for row := 1 to FeldHeight - 2 do if Map[row, col] = Val then begin if Map[row + 1, col] = 0 then Map[row + 1, col] := Val + 1; if Map[row - 1, col] = 0 then Map[row - 1, col] := Val + 1; if Map[row, col + 1] = 0 then Map[row, col + 1] := Val + 1; if Map[row, col - 1] = 0 then Map[row, col - 1] := Val + 1; end; end; // Определяю есть ли путь в принципе. Если пути нет (элемент массива с координатами // точки начала пути равен нулю), то выполняю какие-то действия (напр. Beep; Exit; как // приведено ниже) if Map[RowStart, ColStart] = 0 then begin Beep; Exit; end; // Сохраняю в переменной Val значение элемента массива, // соответствующего точке старта Val := Map[RowStart, ColStart]; // Прокладываю путь, последовательно спускаясь по точкам (клеткам поля) // от значения соответствующего точке старта к единице (точке финиша) // Процедура SetDirection() определяет конкретные действия например, закрашивание // клетки поля или перемещение элемента по полю. Параметром в нее передается // направление движения. Здесь предполагается, что процедура SetDirection // описана как procedure SetDirection (ADir: TDirection); а тип TDirection, как // type TDirection = (L, R, U, D); хоть это и избавляет от дополнительных ошибок, // но не обязательно, можно передавать параметрами числа, или символы. // Например, SetDirection('U'); для направления вверх. // Также предполагается, что SetDirection изменяет координаты ColStart и RowStart, // в противном случае изменение координат необходимо произвести в цикле While, // как это сделано в прилагаемой демонстрационной программе while (Val >= 2) do begin col := ColStart; row := RowStart; if Map[row, col] = Val then begin Dec(Val); if Map[row + 1, col] = Val then SetDirection(D); else if Map[row - 1, col] = Val then SetDirection(U); else if Map[ro, c + 1] = Val then SetDirection(R); else if Map[ro, c - 1] = Val then SetDirection(L); end; //if end; //while end;
Вот и все. Хочу добавить, что в прилагаемой демонстрационной программе я использовал идею А. Моисеева графически отображать путь на канве Timage, да не сочтите это за плагиат. Код программы не снабжен комментариями по двум причинам: во-первых все достаточно подробно объяснено здесь, а во-вторых я работаю на немецком Windows, по-этому писать русские комментарии просто нет возможности (Delphi не позволяет).



Программа работает очень просто. Тремя верхними кнопками задается элемент, который будет рисоваться при щелчке на поле (стенка, точка начала пути и точка конца пути). В случае ошибочно нанесенного элемента, его можно удалить нажав на кнопку Delete (с минусом) и щелкнув на удаляемом элементе. Кнопка Clear очищает поле, Fill in заполняет поле значениями массива (исключительно в демонстрационных целях) и Find - находит путь. Я разделил этот процесс на две процедуры для наглядности. Поскольку программа демонстрационная (читай упрощенная и не претендующая на оптимальность), я не добавлял в нее некоторые проверки на действия пользователя, по-этому просьба: не стирайте бордюр - это может привести к ошибкам.

С глубоким уважением ко всем рыцарям Королевства,


Скачать исходные коды и демо-проект: (190K)


Опыт использования ADO для доступа к базам данных форматов MS Access, xBase и Paradox


Раздел Подземелье Магов

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

Подвигло меня на написание этой статьи то обстоятельство, что когда я приступал к этой работе (я имею в виду использование ADO), я размещал свои вопросы во многих конференциях, а ответов на них не получено до сих пор и, более того, эти же вопросы стали задаваться по новой, а ответов на них как не было, так и нет. На некоторые из них я отвечал, а потом подумал, что не все будут просматривать конференцию целиком, да и когда все сведено в одном месте оно и лучше. Кроме того, толковой литературы по использованию ADO практически нет никакой. Например, мне не удалось найти в солидных по объему книгах г-на Архангельского необходимую мне информацию. Или еще пример - Microsoft Press 'Справочник по OLE DB'. Здесь другой уклон - информации много, слишком много, а примеров никаких (но это вообще проблема справок от Microsoft - написано много, а примеров использования почти нет).

Надеюсь, что те сведения, которые я приведу здесь, помогут коллегам по цеху в решении его задач.



Основные положения


Далее по тексту "особенностью" (Particularity) я буду называть свойство, событие или метод, заменяя тем самым словосочетание одним словом. Особенность - краеугольный камень реализации Инспектора. Физически особенность представляет собой запись TParticul: TParticulKind = (pkProperty, pkMethod, pkEvent); TParticul = record Name: string; Kind: TParticulKind; Data: Word; Enabled: Boolean; Visible: Boolean; Code: string; Info: string; ReadMode: Boolean; end; где Name - имя особенности, отображаемое в Инспекторе, можно (и желательно!) на русском, каждая особенность обладает уникальным именем; Kind - тип особенности, т. е. свойство это, метод или событие; Data - шифр типа данных, служит для назначения данному событию определённого редактора (см. далее); Enabled - показывает, разрешена особенность или запрещена; Visible - показывает, видима особенность или нет (в основном для внутреннего использования, но можно использовать и в явном виде); Code - кодированные данные в виде строки; Info - дополнительные кодированные данные (например, для целых чисел - диапазон), не редактируются Инспектором; ReadMode - особенность только для чтения (не работает в случае, когда особенность является методом). В дальнейшем понадобится понятие массива данных TParticulList = class(TList). Этот класс - простой контейнер особенностей; при добавлении в него особенности он сразу же сортирует весь массив по именам особенностей. Также при добавлении особенности метод TParticulList.Add проверяет имя особенности (TParticul.Name) на уникальность; если особенность с таким именем уже содержится в массиве, создаётся исключительная ситуация EParticul.

Инспектор обрабатывает элементы управления специального вида, которые умеют генерировать массивы особенностей и принимать особенности:

TParticulControl = class(TCustomControl) private FCaption: string; protected function GetTypeName: string; virtual; abstract; function GetParticuls: TParticulList; virtual; abstract; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; public property Caption: string read FCaption write FCaption; property TypeName: string read GetTypeName; property Particuls: TParticulList read GetParticuls; function FullText: string; procedure SetParticul(Value: TParticul); virtual; abstract; end; где Caption - имя элемента управления, отображаемое в Инспекторе (аналог свойства Name: TComponentName в Инспекторе Delphi); GetTypeName - функция, выдающая название типа элемента управления (можно на русском!), также отображаемое в Инспекторе; GetParticuls - функция, формирующая список особенностей данного элемента управления для передачи его в Инспектор; MouseDown - обработчик щелчка мышью на элементе (далее будет рассмотрен подробнее); FullText - формирует строку для отображения списка редактируемых объектов в Инспекторе (Result := FCaption + ': ' + GetTypeName); SetParticul - осуществляет приём изменённой особенности из Инспектора. Элементы TParticulControl можно использовать двумя способами. Первый - прямое использование; создаётся наследник, перекрывается, например, его метод Paint и элемент можно использовать. Этот способ подходит, например, в САПРах, где вся работа заключается только в редактировании элементов. Второй - косвенное использование; при этом способе TParticulControl служит как бы оболочкой для какого-либо другого элемента (не являющегося наследником TParticulControl и, вообще говоря, даже не являющегося наследником TControl). Для второго способа существует более удобный класс: TExternalControl = class(TParticulControl) private FExternalObject: TObject; procedure SetExternalObject(Value: TObject); procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND; protected procedure CreateParams(var Params: TCreateParams); override; procedure Paint; override; public property ExternalObject: TObject read FExternalObject write SetExternalObject; procedure Refresh; end; где ExternalObject - указатель на внешний объект, оболочкой которому служит данный элемент управления; WMEraseBkgnd и CreateParams - перекрыты для обеспечения прозрачности; Refresh - обеспечивает перерисовку при изменении размеров оболочки. Элемент TExternalControl построен таким образом, что если редактируемый объект является наследником TControl, то при редактировании отображается именно он (в силу прозрачности TExternalControl), а если не является - отображается симпатичный квадратик (подобно как в Delphi отображаются невизуальные компоненты).


Элементы управления TParticulControl обрабатываются только одним способом - щелчок мышью (с нажатой клавишей Shift или без неё). При щелчке без нажатия Shift элемент добавляется в список активных элементов (т. е. тех, которые обрабатываются в настоящий момент Инспектором) Actives: TList, который предварительно очищается. При щелчке при нажатой Shift элемент также добавляется в Actives, но без предварительной его очистки.

Для того чтобы особенности отображались в Инспекторе, они должны быть предварительно зарегистрированы процедурой: RegisterData(Data: Word; AEditor: TParticulEditorClass; AExecutor: TExecutor); где Data - уникальный номер для регистрируемого типа; AEditor - ссылка (указатель на класс) на класс редактора (см. ниже); AExecutor - обрабатывающая процедура (см. ниже). Если будет сделана попытка зарегистрировать особенности под уже имеющимся номером, возникнет исключительная ситуация ERegister.
К каждой особенности, благодаря регистрации, привязывается редактор определённого класса и процедура обработки следующего типа: TExecutor = function(Code, Info: string; var Changed: Boolean; ReadMode: Boolean = False): string; где Code - кодированные данные из TParticul.Code; Info - дополнительные кодированные данные из TParticul.Info; Changed - булева переменная, показывающая, были ли сделаны изменения (True) или нет (False); ReadMode - запрещение изменения Code (по умолчанию - False).

Применение этой процедуры будет показано ниже.

Редактор особенностей представляет собой наследника от класса TParticulEditor, описание которого дано ниже: TParticulEditor = class protected FOldCode: string; FParticul: TParticul; FExecutor: TExecutor; procedure Init(AControl: TWinControlClass); procedure SetParticul(Value: TParticul); virtual; public Control: TWinControl; property Executor: TExecutor read FExecutor write FExecutor; property Particul: TParticul read FParticul write SetParticul; constructor Create; virtual; destructor Destroy; override; procedure Make; end; TParticulEditorClass = class of TParticulEditor; где Init - процедура, создающая редактор класса AControl, строго обязательна в конструкторе; Control - то, что будет отображено в Инспекторе (собственно редактор); Partucul - редактируемое свойство; Executor - процедура-обработчик типа TExecutor; Make - обновление Инспектора. Немного остановлюсь на методе SetParticul, который изменяет внешний вид Control при различных значениях полей TParticul (Code, Info, Enabled, ReadMode). Так, например, во всех редакторах Enabled присваивается элементу управления (Control.Enabled := Value.Enabled); ReadMode в TEditEditor'е присваивается TEdit'у ((Control as TEdit).ReadMode := Value.ReadMode); а через Info в ComboBox передаются все элементы, из которых необходимо сделать выбор.


Особенности отладки DLL под Windows XP


Если вы работаете под операционной системой Windows XP, то при отладке DLL-библиотек у вас возникнут трудности. Они заключаются в том, что отладчик Delphi не загружает символы отладочной информации из библиотеки.

Эта ошибка уже исправлена в Delphi 7, но если вы работаете с более ранними версиями, вам пригодится этот совет: выполните все приготовления к отладке, как было описано выше, запустите отладку. После того, как главное приложение запустится, переключитесь в Delphi и нажмите комбинацию клавиш Ctrl+Alt+M. В открывшемся окне списка загруженных модулей найдите ваш модуль, щелкните на нем правой кнопкой мыши и выберите пункт ReloadSymbol Table. В окне, которое появится, введите полный путь к вашей DLL и нажмите ОК. Таблица отладочных символов должна перезагрузиться и вы получите возможность устанавливать точки прерывания и следить за поведением вашего Shell extension.



Особенности реализации будильника


Входная строка CRON для синхронизированного таймера не хранится в экземпляре класса и не используется непосредственно для определения необходимости "тикнуть" в основном цикле менеджера. Вместо этого сразу производится разбор строки и преобразование во внутренний формат маски времени. Последний представляет собой массив множеств временных единиц (множество секунд, минут и так далее). Это позволяет выполнять операцию сравнения с текущим временем очень быстро - практически одноактная операция, не зависящая от длины исходной строки.

Как и IntervalTimer, FixedTimer может работать в периодическом и старт-стопном режиме (параметр Mode=tmPeriod,tmStartStop в tmCreateFixedTimer). Но имеется еще дополнительная опция "уверенной синхронизации" (Mode=tmSureSync). В этом режиме производится проверка на пропуск предыдущего момента срабатывания. При этом, если даже в один прекрасный момент что-то помешало таймеру "тикнуть" (в течение более 1 с поток таймерного менеджера не получал управление), в следующую секунду он обязательно сработает "за тот раз". Время последнего срабатывания запоминается, его можно прочитать и установить.



Отладка MTS объектов


К сожалению, в справочной системе Delphi процесс отладки MTS объектов практически не освещен, что создает значительные трудности разработчикам. Хотя на самом деле, использование MTS позволяет достаточно просто проводить эту крайне необходимую операцию.

Для этого необходимо выполнить следующие действия: Откомпилировать проект (dll файл) с установленной опцией Include remote debug symbols flag (Project Options | Linker page, Рисунок 6).

Установить MTS компонент на сервер, используя раздел меню Project | Install MTS Object wizard или MTS консоль (Administrative Tools | Component Services) Рисунок 7.

Установить параметры отладчика Delphi (Рисунок 8) следующим образом: Host Application должен содержать путь к dllhost.exe (папка \system32 ), Parameters должен содержать запись "/ProcessID:{CLSID}".

Для того, чтобы получить CLSID пакета, где находится компонент, можно воспользоваться все той же утилитой Component Services, страницей properties (Рисунок 9), где указан Application ID.

Внимание!
Вам необходим CLSID папки, в которую компонент установлен (dll file) CLSID, а не CLSID компонента. Например, если в ней установлено несколько компонентов, то для их отладки будет использоваться один и тот же идентификатор.

Запустите компонент (dll file) под отладчиком Delphi и установите точки прерывания работы в нужных вам местах. Вызовите методы MTS компонента или обратитесь к его свойствам из внешнего приложения (например, обычного Windows приложения).



Отладка Shell extensions


После всех выполненных приготовлений вы можете нажать кнопку Run (F9) и запустить ваш Shell extension на отладку. Устанавливайте точки прерывания в нужных местах, используйте кнопки Program Pause и Program Reset при необходимости. Отладка Shell extensions более ничем не отличается от отладки обычных приложений Delphi. Не удивляйтесь, если после обрыва отладки проекта через «Program Reset», Windows Explorer будет загружаться сам. Это стандартная реакция Windows на ошибочное завершение процесса Explorer. Для нормального завершения процесса отладки вы можете воспользоваться способом, описанным ранее (через Пуск | Завершение работы). Windows Explorer - приложение многопоточное. Для каждого используемого Shell extension оно создает отдельный поток, в котором и работает с ним в дальнейшем. Поэтому не удивляйтесь, если в процессе пошаговой отладки вас внезапно перекинет в другой участок кода, где вы недавно отлаживались, а потом вернет снова на старое место. За вашими путешествиями сквозь потоки вы можете следить через окно Thread status, которое можно открыть через меню View | Debug Windows | Threads.

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

Ваши коментарии и замечания можете направлять дарности Особую благодарность хочу высказать Акжану Абдулину, благодаря которому я несколько лет назад начал разбираться с Shell extensions. Эта статья так же не избежала участи быть им откорректированной ;-). Посетите его и вы найдете там множество полезного и интересного материала.

Александр Тищенко
июль 2002г.



Перемещение TSplitter с клавиатуры или эмуляция мыши в VCL


Раздел Подземелье Магов

Правило:
В программировании одну и ту же задачу можно решить как минимум 3-мя способами имеющие разную эффективность.



Переподчинение окон Легенд, растровых диалогов и других окон MapInfo


Чтобы изменить (преподчинить) данные окна используется оператор MapBasic Set Window... Parent.
Например, в компоненте переподчинение окна информации реализовано так - ExecuteCommandMapBasic('Set Window Info Parent %D', [FOwner.Handle]);

Реализацию переподчинения других окон я оставляю вам уважаемые читатели

Заметьте, что способ переподчинения окна Информации другой, чем для окна Карты. В последнем случае не используется предложение Set Next Document. Дело в том, что может существовать несколько окон Карты.

Окна Легенды - особый случай. Обычно существует только одно окно Легенды, так же, как и одно окно Информации. Однако при помощи оператора MapBasic Create Legend Вы можете создавать дополнительные окна Легенды.

Для одного окна Легенды используйте оператор MapBasic Window Legend Parent.

Чтобы создать дополнительное окно Легенды, используйте оператор MapBasic Set Next Document и оператор Create Legend. Заметьте, что в этом случае Вы создаете Легенду, которая привязана к одному определенному окну Карты или окну Графика. Такое окно Легенды не изменяется, когда другое окно становится активным.

Совет:
Вы можете создать "плавающее" окно Легенды внутри окна Карты. В операторе Set Next Document укажите окно Карты как порождающее окно. Для получения более подробной информации смотрите в документации по MapBasic.

Продолжение следует….

Конец первой части. Скачать проект (297 К)

2002 год.
Специально для



Переподчинение окон MapInfo


После запуска MapInfo используйте оператор Set Application Window языка MapBasic для обеспечения перехвата управления Вашей программой-клиентом диалоговых окон и сообщений об ошибках программы MapInfo.

Затем, в желаемой точке включения окна MapInfo в Ваше приложение передайте MapInfo оператор Set Next Document, за которым следует MapBasic-оператор, создающий окно.

Оператор Set Next Document позволяет Вам "переподчинять" окна документов. Синтаксис этого оператора требует указания уникального номера HWND элемента управления в Вашей программе. При последующем создании окна-документа MapInfo (с использованием операторов Map, Graph, Browse, Layout или Create Legend) создаваемое окно становится для окна порождающим объектом.

Примеры приведены из компонента но тоже самое можно выполнить и метолом Do непосредственно, но вы это уже я думаю поняли

ExecuteCommandMapBasic('Set Application Window %D', [FOwner.Handle]); ExecuteCommandMapBasic('Set Window Info Parent %D', [FOwner.Handle]); ExecuteCommandMapBasic('Set Next Document Parent %D Style 1', [FPanel.Handle]);

Примечание:
В компоненте это реализовано процедурой WindowMapDef которая ссылается на панель заданную свойством PanelMap.

Для каждого переподчиняемого окна необходимо передать программе MapInfo из Вашей программы пару операторов - оператор Set Next Document Parent, а затем оператор, создающий окно. После создания окна Вам может понадобиться запросить из MapInfo значение функции WindowID(0) - целочисленный ID-номер окна (Window ID) в MapInfo, так как многие операторы языка MapBasic требуют задания этого номера. Этот запрос выполняется на основе компонента следующим образом: WindowID := Eval('WindowID(%D)',[0]).AsInteger; Заметьте, что даже после переподчинения окна Карты, MapInfo продолжает управлять им. клиентская программа может не обращать внимания на сообщения о перерисовке, реализацию данной особенности я оставлю на потом.



Пересылка команд в программу MapInfo


После запуска программы MapInfo необходимо сконструировать текстовые строки, представляющие операторы языкa Map Basic.

Если Вы установили связь с MapInfo, используя механизм управления объектами OLE (OLE Automation), передавайте командную строку программе MapInfo методом Do.
Например: FServer.Do('здесь команда MapBasic');

Примечание:
В компоненте это реализовано процедурой ExecuteCommandMapBasic, но в сущносте вызывается FServer.Do

При использовании метода Do программа MapInfo исполняет командную строку точно так как если б ее ввели в окне команд MapBasic.

Примечание:
Вы можете передать оператор в программу MapInfo, если этот оператор допустим окне MapBasic. Например, Вы не можете переслать MapBasic-оператор Dialog, поскольку его использование не разрешено в окне MapBasic.

Для определения допустимости использования оператора языка MapBasic в окне MapBasic обратитесь к Справочнику MapBasic или откройте Справочную систему; искомая информация находится под заголовком "Предупреждение". Например, в Справке по оператору Dialog дано следующее ограничение: "Вы не можете использовать оператор Dialog в окне исполнения (такие, как For..-Next и Goto), не разрешены для исполнения в окне MapBasic.



Первые шаги в построении платформы


Итак, мы имеем некоторый задел, чтобы решить самую первую задачу настройщика - создать таблицу клиентов. Однако, прежде чем создавать таблицы, научимся сначала загружать системную базу данных и просматривать состав пользовательской базы данных, для чего создадим несложную форму для отображения информации о пользовательской базе данных. Когда я попробовал изложить идею задач загрузки и сохранения информации при работе в режиме конфигуратора, делая "вырезки" из существующей платформы, то после целого дня работы убедился, что это невозможно, - слишком велик программный код, и читатель сразу бы запутался. А если бы я попробовал при этом еще все объяснить, то никогда бы эту статью не закончил. Поэтому пришлось избрать путь создания небольших приложений сугубо для учебных целей. Первое из них мы назовем конфигуратором.

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

Работоспособный проект для Delphi 7 приведен в архиве DPlatform.zip. В этом архиве, в папке DbBackup расположен архив базы данных для MSSQL Server 2000. Для запуска приложения нужно этот архив базы данных развернуть на доступном MS SQL Server 2000 и затем на главной форме приложения (файлы F_Configurator.dfm и F_Configurator.pas) компоненту Database подключить к этой базе данных, создав соответсвующий псевдоним BDE. Детали этого процесса пояснять ну буду, скажу лишь, что база данных создана на SQL Server 2000 с кодировкой 1251 и сортировкой, чувствительной к регистру, что очень важно иметь ввиду при установке базы данных. Ясно, что ваш сервер баз данных должен позволять восстанавливать базу данных из приведенного архива, т.е. иметь соответствующие кодировку и сортировку. Поясним, как работает наш конфигуратор, главная форма которого называется ConfiguratorFr.

После запуска приложение ничего не делает: оно ждет нажатия кнопки DbInterface, после чего происходят главные события, показанные в листинге 4.

Листинг 4. Создание экземпляра TDbInterface и загрузка информации в память.


procedure TConfiguratorFr.Button2Click(Sender: TObject); Var k, i : Integer; wTabSheet : TTabSheet; wListBox : TListBox; wpTTableInfo : pTTableInfo; wpTInfoCategory : pTInfoCategory; wTFbTypeGroup : TFbTypeGroup; begin // Создать объект FDbInterface FDbInterface := TDbInterface.Create(nil); // Загрузить информацию из системной БД FDbInterface.DatabaseName := Database.DatabaseName; // Список категорий информации TbDbTypeComboBox.Items.Clear; TbDbTypeComboBox.Items.Assign(FDbInterface.FbDbTypeList); TbDbTypeComboBox.Sorted := True; // Настройка списка групп данных TypeGroupCmBox.Items.Clear; for wTFbTypeGroup := Low(TFbTypeGroup) to High(TFbTypeGroup) do TypeGroupCmBox.Items.AddObject(apTypeGroupNames[wTFbTypeGroup], TObject(wTFbTypeGroup)); // Показать состав загруженной информации for k:=0 to FDbInterface.InfoCategoryList.Count-1 do begin wpTInfoCategory := pTInfoCategory(FDbInterface.InfoCategoryList[k]); if wpTInfoCategory.sTFbDbType in [icAll, icNoCateg, icVirtual] then Continue; wTabSheet := TTabSheet.Create(FPageControl); wTabSheet.PageControl := FPageControl; wTabSheet.Caption := wpTInfoCategory.sInfoDescr; // Запомним ссылку для последующего использования wTabSheet.Tag := Integer(wpTInfoCategory); wListBox := TListBox.Create(Self); wListBox.Parent := wTabSheet; wListBox.Align := alClient; wListBox.OnClick := ListBoxClick; for i:=0 to FDbInterface.TablesList.Count-1 do begin wpTTableInfo := pTTableInfo(FDbInterface.TablesList[i]); if wpTTableInfo.spTInfoCategory <> wpTInfoCategory then Continue; wListBox.Items.AddObject(wpTTableInfo.sTableAttr.Values['sTableCaption'], TObject(wpTTableInfo)); end; end; Button2.Enabled := FDbInterface = nil; Button3.Enabled := FDbInterface <> nil; end;
Рассмотрим процессы, происходящие при этом, подробнее.
Сначала создается объект FDbInterface FDbInterface := TDbInterface.Create(nil).

В конструкторе этого объекта процедура CreateFbObjects обеспечивает создание всех необходимых списков, а также выполняется инициализация типов данных. Инициализация базовых типов проводится функцией Init_TFbFieldArray, которая заполняет массив FFbFieldArray информацией в соответствии с тем, как разработчик установил список поддерживаемых типов. Сначала производится стандартное заполнение информации в каждом элементе массива FFbFieldArray:

for wTFieldType := Low(TFieldType) to High(TFieldType) do begin FFbFieldArray[wTFieldType].sType := wTFieldType; FFbFieldArray[wTFieldType].sSize := 0; FFbFieldArray[wTFieldType].sBytes := capAllTypes[wTFieldType].sBytes; FFbFieldArray[wTFieldType].sInc := 0; FFbFieldArray[wTFieldType].sDescr := capAllTypes[wTFieldType].sDescr; // Эти типы включены в систему if wTFieldType in [ftAutoInc, ftString, ftMemo, ftBlob, ftInteger, ftFloat, ftDateTime, ftUnknown] then FFbFieldArray[wTFieldType].sInc := 1; // ..а для этих типов - особые условия нужны // apDATE_TIME - признак разделения данных типа ДАТА и ВРЕМЯ with FFbFieldArray[wTFieldType] do case wTFieldType of ftDate : begin if apDATE_TIME then begin sInc := 1; sDescr := 'Дата'; end; sBytes := SizeOf(TDateTime); end; ftTime : begin if apDATE_TIME then begin sInc := 1; sDescr := 'Время'; end; sBytes := SizeOf(TDateTime); end; end; end;
В приведенном цикле видно, что платформа поддерживает список следующих типов ftAutoInc, ftString, ftMemo, ftBlob, ftInteger, ftFloat, ftDateTime, ftDate, ftTime, ftUnknown.

Кроме того, платформа обеспечивает поддержку раздельного учета типов ftDateTime, ftDate, ftTime непосредственно в приложении, т.к. MS SQL Server такое разделение не поддерживает. Применять или нет разделение этих типов, - определяется глобальной переменной булевского типа apDATE_TIME. При желании этот параметр может быть включен в число настроек, что и сделано в штатной версии описываемой платформы. После инициализации базовых типов формируется список FFbFldGroupList, содержащий ссылки на структуры TFbCommonType, причем эти структуры создаются только для тех типов базовой группы данных, которые реально поддерживает платформа, для чего анализируется поле sInc конкретного элемента массива FFbFieldArray. Эта работа выполняется функцией Init_FbFldGroupList:

for wTFieldType := Low(TFieldType) to High(TFieldType) do begin if FFbFieldArray[wTFieldType].sInc <> 1 then Continue; New(wpTFbCommonType); New(wpTFbBaseType); wpTFbCommonType.FbTypeGroup := FldGroup; wpTFbBaseType^ := FFbFieldArray[wTFieldType]; wpTFbCommonType.FbFld := wpTFbBaseType; FFbFldGroupList.AddObject(wpTFbCommonType.FbFld.sDescr, TObject(wpTFbCommonType)); end;
Обратите внимание, что к этому моменту интерфейс к базам данных FDbInterface еще не подключился к серверу, и, следовательно, могут быть созданы обобщенные структуры TFbCommonType только для базовой группы данных. В платформе для этой группы данных используется отдельный список FFbFldGroupList, хотя его наличие и не является обязательным. Именно этот список заполняется к описываемой стадии работы приложения платформы. Список обобщенных структур FFbCommonTypeList будет заполнен уже после загрузки информации из системной базы данных.

Вернемся, однако, к работе обработчика TConfiguratorFr.Button2Click.

Следующим шагом является подключение интерфейса FDbInterface к серверу базы данных, что выполняется программным кодом: // Загрузить информацию из системной БД FDbInterface.DatabaseName := Database.DatabaseName При этом срабатывает внутренняя процедура компоненты TDbInterface



Procedure TDbInterface.Set_DatabaseName(Value : String), где через параметр Value передается имя псевдонима базы данных приложения. В этой процедуре сначала производится загрузка в память информации из системной базы данных процедурой LoadSystemDatabaseInfo, а затем завершается процесс инициализации всех типов системы последовательным выполнением процедур Get_PickTypes_From_Database, Init_FbRefGroupList, Init_FbLUpGroupList.

Обратите внимание, что во всех этих процедурах используется обращение к процедуре Update_FbCommonTypeList, реализующей обновление списка FFbCommonTypeList комбинированных типов. Надо признать, что процедуру Update_FbCommonTypeList следовало бы использовать только один раз, после завершения формирования всех частных списков для отдельных групп данных. Но так сделано для того, чтобы обеспечить целостность списков комбинированных типов при манипуляции со структурой пользовательской базы данных в конфигураторе. Вероятно, есть более изящное решение этой задачи, которое могут использовать те читатели. Описание работы процедуры LoadSystemDatabaseInfo мы пока отложим, а работа остальных процедур (Get_PickTypes_From_Database, Init_FbRefGroupList, Init_FbLUpGroupList) очень проста.

В процедуре Get_PickTypes_From_Database производится чтение информации из системной таблицы T_PickTypes и формирование списка FFbPicGroupList, содержащего ссылки на структуры списочного типа. В процедуре Init_FbRefGroupList создается список ссылок на структуры ссылочных типов FFbRefGroupList просматривая список структур таблиц FTablesList. В процедуре Init_FbLUpGroupList создается список ссылок на структуры следящих типов FFbLUpGroupList, просматривая список структур полей для всех элементов списка структур таблиц FTablesList. Как уже было замечено, процедура Update_FbCommonTypeList обеспечивает формирование списка обобщенных структур. Как может заметить внимательный читатель, тут налицо избыточность списков для частных групп данных и списка FFbCommonTypeList, хотя затраты ресурсов памяти для этого несущественны. Таких неоптимальных решений в описываемой платформе будет встречаться довольно много, за что просил бы не ругать аммирования платформы протекал при крайне жестких сроках, что называется «с листа», и не было времени заранее обдумать решения. Продолжим рассмотрение обработчика TConfiguratorFr.Button2Click.



Так как на главной форме нашего конфигуратора предусмотрено отображение информации из выбранных структур таблицы и поля, то производится заполнение следующих списков: выпадающего списка категорий информации TbDbTypeComboBox, заполняется на основании списка FDbInterface.FbDbTypeList, выпадающего списка групп данных TypeGroupCmBox, заполняется на основании списка apTypeGroupNames, имеющего в приложении как массив-константа.

Затем производится создание страниц объекта FPageControl. Их количество определяется количеством категорий информации платформы. В данном случае плафторма создает 6 страниц, согласно списку TFbDbType, причем для категорий icVirtual, icAll и icNoCateg страницы не создаются. На каждой странице размещается объект TListBox, в который заносится список названий таблиц соответствующей категории информации, причем в TListBox запоминаются также ссылки на соответствующие структуры TTableInfo, созданные при загрузке приложения.

Итак, наш конфигуратор готов к работе.

Рассмотрим, как он выполняет типовые операции, для которого создавался.


Первый проект.


После того как вы установили MapX сделаем свой первый простой проект, вот что у меня вышло для начала :



Согласитесь - для начала не плохо.
Итак приступим:

Положим компонент Tmap на форму. Тут я сделаю маленькое отступление - обычно MapX поставляется в составе приложения MapXTreme, которое в свою очередь является сервером для хранения карт, что-то вроде централизованного хранилища картографической информации, и если у вас выйдет такая ошибка :

то не пугайтесь - она не смертельная, а говорит лишь о там, что - у вас не установлен MapXTremе, либо установлен, но не найден набор (вроде алиаса в BDE - хотя сравнение не совсем удачное) GeoDict.ddt, т.е. MapX пытается уже открыть карту прописанную GeoDict.ddt в MapXTreme. Так как я не ставил MapXTreme то данная ошибка лечится обнулением (установкой пустой строки) свойства GeoDictionary объекта MapX;

Итак пришла пора загрузить карту - для этого в MapX служит объект Layers который представляет собой коллекцию слоев на карте : Вот как можно добавить слои (в примере они загружаются в FormCreate):

FileMapper := ExtractFilePath(ParamStr(0)) + 'Map\Республика.TAB'; MapX.Layers.Add(FileMapper,2); FileMapper := ExtractFilePath(ParamStr(0)) + 'Map\Реки_полигоны.TAB'; MapX.Layers.Add(FileMapper,1);

У объекта Layers есть метод Add в котором указывается таблица MapInfo и положение слоя на карте, причем чем меньше положение слоя тем слой выше на карте. Ну а органы управления картой (приближение,уменьшение,сдвиг и т.д) управляются свойствами MousePointer - вид курсора и CurrentTool - текущий инструмент;
В своем примере я применил следующие инстурменты Стрелочка (стандартный инструмент по умолчанию) MapX.MousePointer := miDefaultCursor; MapX.CurrentTool := miArrowTool; Рука (инструмент для перемещения карты) MapX.MousePointer := miPanCursor; MapX.CurrentTool := miPanTool; Лупы + и - (инструмент для маштабирования карты) MapX.MousePointer := miZoomOutCursor; MapX.CurrentTool := miZoomOutTool; //--- MapX.MousePointer := miZoomInCursor; MapX.CurrentTool := miZoomInTool; Итак, для начала мы разобрались как загружать карту в Tmap и как производить простейшие манипуляции на карте. В следующей части мы начнем более глубоко изучать MapX, научимся создовать собственные инструменты, манипулировать с единицами измерений и проекциями и т.д. До встречи !

Скачать (demo-проект + карты) (1M)

С уважением к коллегам, .





PGPSDK - Легкий путь к шифрованию


Раздел Подземелье Магов ний Дадыков,
дата публикации 12 апреля 2002г.

Иногда бывает нужно прикрутить к своей программе какое-нибудь шифрование. Для этих целей разработаны кучи алгоритмов шифрования, дешифрования, электронной подписи и т.п., основанных на различных математических аппаратах. Мало того – необходимо реализовать этот алгоритм. Но мы как кульные программеры не будем этого делать – а возьмем готовую библиотеку PGPsdk. Я не буду повторять классиков [2], что для реальных приложений использовать самодельные шифры не рекомендуется, если вы не являетесь экспертом и не уверены на 100 процентов в том, что делаете. Отговаривать же Вас от разработки собственных шифров или реализации какого-либо стандарта тоже не суть этой статьи, здесь пойдет речь о том, как быстро и правильно реализовать в своих приложениях защиту от посторонних глаз и, самое главное - не обмануться.

В моем приложении уже использовалось шифрование от PGP, ДОСовская, работало через командные файлы (*.bat), что явилось весомым аргументом для выбора средства шифрования, все работало, но меня это не устраивало – ДОСовская версия PGP (5.0) затрудняло инсталляцию программы, поддержку и не имеет некоторых полезных вещей, нужных для расширения системы в будущем. Еще чем привлекала PGP – бесплатная для некоммерческих программ, генерация произвольного количества ключей и то что пакет PGP очень популярен и им пользуются большое количество людей, и Вам легко будет решить проблему защиты информации от посторонних глаз в своих приложениях и по моему защита с помощью PGP дает большое преимущество.



Пишем инспектор объектов


Раздел Подземелье Магов рь ,
дата публикации 17 апреля 2002г.

Начну со слов благодарности в адрес Романенко Владимира, который поделился своими исходными текстами и мыслями по поводу написания Инспектора.

Все необходимые структуры и функции для работы со свойствами объекта содержатся в файле поставки Delphi TypInfo.pas он и будет первоисходником для написания собственного Инспектора.

Для удобства работы со свойствами распишем два класса: класс свойств Tprop

TProp = class PropertyInfo: TPropInfo; - структура информации о свойстве PropertyType: TTypeInfo; - структура типа свойства PropertyKind: TTypeKind; - тип свойства PropertyName: ShortString; - название свойства sEnumName: string; iEnumValue: integer; vValue: Variant; - значение свойства iIndex: integer; ……………… ………………. end; и класс самого объекта TpropObject (исходн. FObjIspector.pas). TPropObject = class(TObject) oObject: TObject; - собственно объект нашего мониторинга arProp: array of TProp; - массив свойств данного объекта arMetod: array of TProp; - массив методов данного объекта ………….. …………. end; Класс Tprop - хранилище данных одного конкретного свойства (метода), а TpropObject - полное описание нашего объекта.

Получение свойств и методов объекта происходит при добавлении объекта в инспектор: procedure TPropObject.SetObject(const Value: TObject); var pProps: PPropList; nProps, i, iProp, iMetod: Integer; objTemp: TObject; begin oObject := Value; // Получаем количество Properte nProps := GetTypeData(oObject.ClassInfo).PropCount; GetMem(pProps, sizeof (PPropInfo) * nProps); try // Получаем список Property nProps := GetPropList (oObject.ClassInfo, [tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString, tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray],pProps); iProp := 0; iMetod := 0; // Заполняем данные по Property for i := 0 to nProps - 1 do if IsPublishedProp(oObject,pProps[i]^.Name) then if pProps[i]^.PropType^^.Kind = tkMethod then begin // Обрабатываем методы SetLength(arMetod,iMetod + 1); arMetod[iMetod] := TProp.Create; arMetod[iMetod].PropInfo := pProps[i]; Inc(iMetod); end else begin // Обрабатываем свойства SetLength(arProp,iProp + 1); arProp[iProp] := TProp.Create; arProp[iProp].PropInfo := pProps[i]; case arProp[iProp].PropertyKind of tkClass: begin objTemp := GetObjectProp(oObject,arProp[iProp].NameProperty); if objTemp<>nil then arProp[iProp].vValue := '(' + objTemp.ClassName + ')'; end; tkInterface: ; else arProp[iProp].vValue := GetPropValue(oObject,arProp[iProp].NameProperty); end; Inc(iProp); end; finally FreeMem(pProps); end; end;


Еще одним важным моментом при инспектировании свойств какого либо объекта является отслеживание изменений данного объекта на форме моделирования (редактирования). Наш инспектор должен быть оповещен о происходящих изменениях на форме. Для мониторинга изменений перекроем оконную процедуру у формы моделированияю Для этого в нашем инспекторе служит процедура SetWnd:

procedure TfmObjIspector.SetWnd(const Value: THandle); begin WndHandle := Value; // Устанавливаем новую процедуру окна для формы моделирования WndProcPtr := MakeObjectInstance(WndMetod); OldWndProc := Pointer(SetWindowLong(WndHandle,GWL_WNDPROC,integer(WndProcPtr))); end; Собственно новая оконная процедура выглядит так: procedure TfmObjIspector.WndMetod(var Msg: TMessage); // Обработчик сообщений для формы моделирования begin // Перечитаем наши проперти ReReadProperty; // и выполним старую оконную процедуру with Msg do Result := CallWindowProc(OldWndProc,WndHandle, Msg, wParam, lParam); end;

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

procedure TfmObjIspector.FormDestroy(Sender: TObject); begin // Если была подмена оконной процедуры - вернем все в зад // иначе бед не оберешься if OldWndProc<>nil then begin SetWindowLong(WndHandle,GWL_WNDPROC,integer(OldWndProc)); FreeObjectInstance(WndProcPtr); end; inherited; end; Отрисовка свойств и методов на форме инспектора малоинтересный процесс позиционирования линий и текства на компонентах TpaintBox поэтому все это вы найдете в прилагаемых исходный текстах. Исходные тексты содержат набросок инспектора объектов, компонент Timage иммитирующий designtime отрисовку компонента и тестовую форму.
В представленном листинге не реализовано редактирование свойств и методов.

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

Разинкин И.В.

Скачать проект (13 K)

Смотрите по этой теме:

Изначально цель методик обнаружения ошибок


Раздел Подземелье Магов
Изначально цель методик обнаружения ошибок была в том, чтобы дать возможность получателю сообщения, передаваемому по зашумленному каналу, определить, не было ли оно испорчено. Для этого отправитель формировал значение, именуемое контрольной суммой ("checksum" - КС), как функцию от сообщения и добавлял его к сообщению, получатель, используя ту же самую функцию, мог посчитать КС полученного сообщения и в случае равенства, считать сообщение безошибочно принятым. Самый первый алгоритм подсчета КС был очень прост: все байты сообщения суммировались (отсюда и пошло название ) по модулю степени двойки. Главное достоинство этого метода - простота, главный недостаток - ненадежность. Например, он не перестановки байт местами.

Высокую степень безопасности данных обеспечивают алгоритмы контроля за достоверностью информации, использующие циклические избыточные коды (Cyclic Redundancy Code - CRC).

Использование CRC представляет собой сверхмощный метод обнаружения ошибок.
кода, метод деления на образующий полином над полем GF(2) и способ образования CRC с помощью регистра сдвига с обратными связями. Именно последний способ удобен с вычислительной точки зрения - особенно если разрядность компьютера равна (или кратна) длине сдвигового регистра.

Для простоты считайте CRC остатком от деления БОЛЬШОГО бинарного числа (передаваемых данных) на число, в зависимости от разряда старшего бита этого числа выделяют CRC16 и CRC32.

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

Алгоритм получения CRC32 такой:

1. CRC-32 инициализируется значением $FFFFFFFF 2. Для каждого байта "B" входной последовательности CRC-32 сдвигается вправо на 1 байт. Если байты CRC-32 были [C1,C2,C3,C4] (C1 - старший, C4 - младший), сдвиг дает [0,C1,C2,C3]. Младший байт C4 побитно складывается с B по модулю 2 (C4 xor B). Новым значением CRC-32 будет его сдвинутое значение, сложенное побитно по модулю 2 (xor) с 4-байтовой величиной из "магической" таблицы с использованием [B xor C4] в качестве индекса. Было: CRC-32 = [C1,C2,C3,C4] и получили очередной байт B. Стало: CRC-32 = [0,C1,C2,C3] xor Magic[B xor C4]. PAS: { CRC - LongWord, Magic - array[byte] of LongWord} CRC := (CRC shr 8) xor Magic[B xor byte(CRC and $FF)]; 3. Инвертировать все биты: CRC:= NOT CRC; Код на паскале:-) Const Crc32Init = $FFFFFFFF; Crc32Polynomial = $EDB88320; Var CRC32Table: array [Byte] of Cardinal; function Crc32Next (Crc32Current: LongWord; const Data; Count: LongWord): LongWord; register; Asm file://EAX - CRC32Current; EDX - Data; ECX - Count test ecx, ecx jz @@EXIT PUSH ESI MOV ESI, EDX file://Data @@Loop: MOV EDX, EAX // copy CRC into EDX LODSB // load next byte into AL XOR EDX, EAX // put array index into DL SHR EAX, 8 // shift CRC one byte right SHL EDX, 2 // correct EDX (*4 - index in array) XOR EAX, DWORD PTR CRC32Table[EDX] // calculate next CRC value dec ECX JNZ @@Loop // LOOP @@Loop POP ESI @@EXIT: End;//Crc32Next function Crc32Done (Crc32: LongWord): LongWord; register; Asm NOT EAX End;//Crc32Done <Магическую> таблицу можно хранить в исполняемом файле, но мы, как настоящие программисты, будем формировать её в run-time: function Crc32Initialization: Pointer; Asm push EDI STD mov edi, OFFSET CRC32Table+ ($400-4) // Last DWORD of the array mov edx, $FF // array size @im0: mov eax, edx // array index mov ecx, 8 @im1: shr eax, 1 jnc @Bit0 xor eax, Crc32Polynomial // число - тоже что у ZIP,ARJ,RAR,: @Bit0: dec ECX jnz @im1 stosd dec edx jns @im0 CLD pop EDI mov eax, OFFSET CRC32Table End;//Crc32Initialization Для удобной работы добавим функцию подсчета Crc32 для Stream'a: function Crc32Stream (Source: TStream; Count: Longint): LongWord; var BufSize, N: Integer; Buffer: PChar; Begin Result:=Crc32Init; if Count = 0 then begin Source.Position:= 0; Count:= Source.Size; end; if Count > IcsPlusIoPageSize then BufSize:= IcsPlusIoPageSize else BufSize:= Count; GetMem(Buffer, BufSize); try while Count <> 0 do begin if Count > BufSize then N := BufSize else N := Count; Source.ReadBuffer(Buffer^, N); Result:=Crc32Next(Result,Buffer^,N); Dec(Count, N); end; finally Result:=Crc32Done(Result); FreeMem(Buffer); end; End;//Crc32Stream Получаемый на выходе CRC32 совпадает с генерируемым такими программами как PkZip, ARJ, RAR и многими другими.

И, конечно, тестовая программка:

program Crc32; {$APPTYPE CONSOLE} uses SysUtils,Classes,IcsPlus; var FS: TFileStream; Crc: LongWord; Begin if ParamCount<>1 then begin WriteLn('Crc32 v1.0 Copyright (c) 2001 by Andrew P.Rybin [magicode@mail.ru]'); WriteLn(' Usage: crc32 filename'); EXIT; end; Crc32Initialization; FS:= TFileStream.Create(ParamStr(1),fmOpenRead); try Crc:=Crc32Stream(FS,0); WriteLn('Crc: ',IntToHex(Crc,8),' = ',Crc); finally FS.FREE; end; End.

В файле содержится используемый мною в работе модуль IcsPlus.pas, который включает вышеописанные функции, и тестовая программка. Автор будет признателен за возможные советы, пожелания и bugfix'ы.

Andrew P.Rybin
Специально для


Подготовка.


Итак, начнём с того, что нам необходимо сделать перед тем, как непосредственно начать использовать мощь технологии WMI в своих программах: установить систему Windows 2000 или NT 4.0 SP4 и выше; установить Microsoft Internet Explorer (IE) 5.0 и выше; установить WMI SDK; После того, как вы установили WMI SDK, импортируйте следующие библиотеки типов: Active DS Type Library (Version 1.0) Microsoft WMI Scripting v1.1 Library (Version 1.1) Отлично, теперь в палитре компонентов у вас появились новые элементы, которые мы и будем в дальнейшем использовать.



Подготовка проекта Delphi для отладки с Windows Shell


Как и для отладки любой другой DLL вы должны указать Host Application для вашего Shell extension. В адресное пространство этого приложения ваш Shell extension будет загружен. В нашем случае таким приложением является Windows Explorer. Зайдите в меню Run | Parameters..., нажмите кнопку Browse и выберите файл Explorer.exe из директории Windows. Не спешите запускать отладку, впереди есть еще много значительных нюансов.

Вы должны включить всю необходимую отладочную информацию в ваш проект. Для этого перед компиляцией откройте окно «Project Options» (пункт меню Project | Options...), перейдите на закладку «Linker» и в группе «Exe and Dll Options» пометьте флажек «Include remote debug symbols». Он включает генерацию специальных данных для удаленной отладки, которые так же необходимы для отладки COM-приложений. После окончания работ над отладкой вашего Shell extension не забудьте отключить эту возможность, так как она значительно увеличивает размер модуля и создает еще больший по размерам файл с расширением *.rsm, в котором и хранятся символы удаленной отладки. Так же для удобства отладки включите флажек «Use debug DCUs» на закладке «Compiler» диалога «Project Options». Это позволит вам следить за внутренней работой модулей, которые небыли включены в список модулей вашего проекта.

Так же вы не должны забывать о доступности исходных текстов вашего Shell extension для отладчика Delphi. Они должны находиться в текущей для Delphi директории или к ним должен быть прописан путь в диалоге Project | Options | Directories/Conditionals, пункт – «Debug Source Path».

После выполнения всех действий по настройке свойств проекта вы должны полностью перекомпилировать ваш проект (через пункт меню Project | Build...).



Подготовка Windows Explorer к работе под отладчиком


Носителем функциональности Shell является приложение Windows Explorer. Вы можете увидеть на экране своего компьютера такие объекты, как Desktop, Taskbar, окна папок файловой системы. Все это реализовано приложением Windows Explorer, и Вы можете увидеть это приложение в Task Manager.

Сопоставленный ему процесс называется Explorer.exe. Там же вы можете увидеть, что у вас иногда запущено несколько экземпляров этого процесса. Не удивляйтесь - все дело в настройках Windows, что и будет показано далее.

Windows Shell автоматически выгружает динамическую библиотеку, когда внутренний счетчик её использования равен нулю, но это происходит только по истечении определенного периода времени. Это сделано для ускорения работы оболочки, но не всегда удобно при написании и отладке Shell extensions в пределах одной операционной системы - при компиляции уже зарегистрированного Shell extension его файл может оказаться заблокированным для записи. Для операционных систем версий ниже Windows 2000 вы можете уменьшить этот период с помощью добавления нижеследующей (following) информации в реестр: HKLM Software Microsoft Windows CurrentVersion Explorer AlwaysUnloadDll Не забывайте отключать эту возможность после завершения отладочных работ над вашим Shell extension, так как она плохо сказывается на производительности Windows.

В любой операционной системе можно применить следующий метод для запуска Windows Shell под отладкой:

Загрузите в Delphi проект для отладки. Из меню кнопки "Пуск" выберите пункт "Завершение работы". Нажмите одновременно кнопки CTRL+ALT+DEL и щелкните по кнопке "No" в диалоге "Завершение работы с Windows". В операционной системе Windows 2000 щелкните на кнопке "Cancel". В результате Shell должна выгрузиться из памяти компьютера (исчезнут Task Bar, иконки с рабочего стола и открытые окна с содержимым папок и дисков), но все остальные приложения останутся работать, влючая Delphi с вашим проектом. Выполните все настройки, необходимые для отладки Shell extensions и запустите отладчик. Shell должна стартовать как обычно, но сейчас она будет работать под управлением отладчика.

При отладке Shell extensions под управлением Windows NT/2000/XP вы можете настроить запуск нескольких экземпляров Windows Explorer (отдельный экземпляр под Task Bar, под каждое окно с содержимым папок или дисков). В результате вы сможете отлаживать ваши Shell extensions не выгружая при этом Task Bar и Desktop, что намного удобнее. Чтобы включить эту возможность вы должны добавить нижеследующую информацию в реестр:

HKEY_CURRENT_USER\ Software\ Microsoft\ Windows\ CurrentVersion\ Explorer\ DesktopProcess(REG_DWORD) = 1 Чтобы это значение начало действовать вы должны выполнить Log off и затем Log on. Не забывайте отключать эту возможность после завершения отладочных работ над вашим Shell extension, так как она плохо сказывается на производительности Windows.



Подгружаемые модули (plugins) в Delphi


Раздел Подземелье Магов Трофимов Игорь , дата публикации 01 августа 2000г.

Введение

Когда я впервые столкнулся с задачей организации подгружаемых в RunTime модулей (plugins) для Delphi-программ, ответ нашелся достаточно быстро. Как это иногда бывает в подобных ситуациях, я не особо задумался о том, как подобную задачу решают другие разрабточики.

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

Однако описанный подход имеет ряд недостатков, зачастую довольно существенных. Я опишу их в следующем разделе.

В то же время меня часто спрашивали, каким образом можно создать удобный механизм plugin'ов и я описывал свой метод. Метод, предлагаемый мною, основан на использовании механизма, которым пользуется сама Delphi IDE - пакеты (packages).

Проблема (недостатки DLL-plugin'ов)

Все используемые модули компилируются в DLL

Представьте, что вам надо сделать подключаемый модуль, который выводит форму с настройками. Как только вы впишете в DLL выражение uses Forms,... модуль Forms, а также все модули, используемые модулем Forms будут прилинкованы к вашей DLL, что катастрофически увеличит ее размер. Представьте теперь, что вам нужно подключать несколько plugin'ов, каждый из которых будет предоставлять форму или вкладку для редактирования параметров. Как писал классик, душераздирающее зрелище...

Модули дублируются

Предыдущий недостаток является количественным, т.е. просто увеличивающим размер проекта. Но из него вытекает качественный недостаток. Рассмотрим его на примере. Пусть вам надо создать подгружаемые разборщики пакетов. Вы определяете абстрактный класс TParser в модуле UParser и хотите, чтобы все разборщики наследовали от него. Но для того, чтобы вы могли описать в DLL потомок от TParser, вы должны включить модуль UParser в список uses для DLL. А для того, чтобы основная программа могла обращаться с TParser и его потомками, в нее также должен быть включен uses UParses,.... Неприятность заключается в том, что эти модули будут находиться в памяти дважды и тот TParser, о котором знает основная программа не совпадает с тем, который знает plugin.


Задача (чего бы нам хотелось)
Все просто. Нам бы хотелось, чтобы основная программа могла без особых ухищрений работать с внешними модулями как с потомками некоторого абстрактного класса и при этом бы не было избыточности кода. При этом желательно, чтобы изменения в основную программу вносить приходилось как можно реже, даже при очень развитой функциональности plugin'а.

Средство (пакеты и функции для работы с ними)
Пакеты появились в третьей версии Delphi. Что такое пакет? Пакет - это набор компилированных модулей, объединенных в один файл. Исходный текст пакета, хранящий я в файлах .dpk содержит только указания на то, какие модули содержит (contains) этот пакет (здесь "содержит" означает также "предоставляет") и на какие другие пакеты он ссылается (requires). При компиляции пакета получается два файла - *.dcp и *.dpl. Первый используется просто как библиотека модулей. Нам же больше интересен второй.

Основной особенностью пакетов является то, что не включают в себя код, которым пользуются. Т.е. если некоторые модули используют большую библиотеку функций и классов, то можно потребовать их наличия, но не включать в пакет. Вы спросите, что же тут нового, ведь обычные модули тоже не включают в .dcu-файл весь используемый код? А нового здесь то, что dpl-пакет является полноправной DLL специального формата (т.е. с оговоренными разработчиками Delphi именами экспортируемых процедур). При загрузке пакета в память автоматически устанавливаются связи с уже загруженными пакетами, а если загружаемый пакет требует наличия еще каких-то пакетов, то загружаются и они. Кроме того, в отличие от обычных модулей, программа, использующая модули из внешнего пакета тоже не обязана включать его код. Таким образом, можно писать EXE-программы размеров в несколько десятков килобайт (естественно, будет требоваться наличие на диске соответствующего пакета, который затем подгрузится).

Функции для работы с пакетами сосредоточены в модуле SysUtils. Нас будут интересовать следующие из них: function LoadPackage(const Name: string): HMODULE; Загружает пакет с заданным именем файла в память, полностью подготавливая его для работы. procedure UnloadPackage(Module: HMODULE); Выгружает заданный пакет из памяти.



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

Минусы
Бесплатный сыр, как известно, бывает только в мышеловках... Поэтому после рассмотрения плюсов стоит рассмотреть и минусы данного подхода. Мы рассмотрим их в порядке возрастания их важности. В отличие от dll-plugin'ов, вы привязываетесь к Delphi и C++ Builder'у (или это плюс ? :) ). Конечно, существуют некоторые накладные расходы на обеспечение интерфейса пакета - самый маленький пакет имеет не нулевую длину. Кроме того, умный линкер Delphi не сможет выкинуть лишние процедуры из совместно используемых пакетов - ведь любой метод может быть затребован позже, каким-то другим внешним пакетом. Поэтому возможно увеличение размера суммарного кода программы. Это увеличение практически не заметно, если разделяемый пакет содержит только интерфейс для plugin'а и существенно больше, если необходимо разделить стандартные пакеты VCL. Впрочем, это легко окупается, если plugin'ов много. Кроме того, стандартные пакеты могут использоваться разными программами. Возможно самый существенный недостаток, вытекающий из предыдущего. Пакет неделим, потому что неизвестно, какие его процедуры понадобятся, поэтому он грузится в память целиком. Даже если вы используете одну единственную функцию из пакета, не вызывающую другие и не ссылающуюся на другие ресурсы пакета, пакет грузится в память целиком. Это, опять таки, не очень заметно, если в пакете только голый интерфейс с небольшим количеством процедур. Но если это несколько стандартных пакетов VCL, то занимаемая программой память может увеличиться очень существенно (на несколько мегабайт). Впрочем, это снова окупается, если вы используете большое количество plugin'ов - если бы они были оформлены в виде dll, то каждая из них содержала бы приличную часть стандартных модулей и они держались бы в памяти одновременно. Фактически, предлагаемый метод является более масштабируемым, т.е. издержки начинают снижаться при увеличении количества plugin'ов.



Метод (что делаем, и что получим)
Предлагемая структура построения пиложения выглядит следующим образом: выполяемый код = Основная программа + Интерфейс plugin'ов + plugin. Все три перечисленные компоненты должны находиться в разных файлах (программа - в EXE, остальное - в пакетах BPL). Программа умеет загружать пакеты в память и обращаться к подгруженным потомкам абстрактного plugin'а. Plugin представляет собой потомок абстрактного класса, объявленного в интерфейсном модуле. Программа и plugin используют модуль интерфейса, но он находится в отдельном пакете и в памяти будет присутствовать в единственном екземпляре.

Остался единственный вопрос - как основная программа получит ссылки на объекты или на классы (class references) нужного типа? Для этого в интерфейсном модуле хранится диспетчер plugin'ов или, в простейшем случае, просто TList, в который каждый модуль заносит ставшие доступными классы. В более развитом случае диспетчер классов может обеспечивать поиск подгруженных классов, являющихся потомками заданного, приоритеты при загрузке, и.т.д.

Ясно, что мы достигли поставленой цели - избыточности кода нет (при условии, что все библиотеки, в том числе и стандартные библиотеки VCL, используются в виде пакетов), написание plugin'а упрощено до предела. Чего можно добиться еще?

А можно добиться еще более интересной вещи. Если мы всю основную програму поместим в пакет, а EXE-файл будет включать в себя только процедуру создания и открытия основной формы, то внешний plugin может получить полный доступ ко всем модулям программы, в том числе и к главной форме. Таким образом мы можем написать plugin, который самостоятельно, без каких-либо усилий со стороны головной программы, поместит свой пункт в главное меню и кнопку на панель инструментов, по команде которых будет вызываться внешний код. Это то, ради чего стоит задуматься над использованием предложенного метода - положив в определенный каталог маленький (в нем только ваш код) plugin, вы добавляете к программе очередную возможность, не перекомпилируя основной программы.



Подгружаемые модули (plugins) в Delphi: Пример 1
Постановка задачи

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

Мы создадим один предопределенный класс, экспортирующий строки в текствый файл и один внешний plugin, содержащий класс, который умеет экспортировать строки....ну, скажем, в HTML. Экспорт в Excel или в БД выведет нас за тонкую границу примера.

Абстрактный класс

Итак, рассмотрим определение абстрактного класса:
unit UExporter; { ============================================= } interface { ============================================= } type TExporter = class public class function ExporterName: string; virtual; abstract; procedure BeginExport; virtual; abstract; procedure ExportNextString(const s:string); virtual; abstract; procedure EndExport; virtual; abstract; end; { ============================================= } implementation { ============================================= } end
Я надеюсь, никто не упрекнет меня за чрезмерное усложнение примера :) . А тех, кто, прочитав этот кусочек кода, закричит громким голосом "Это можно было сделать и в dll !" я отсылаю к размышлениям о размерах dll. Ведь потомки TExporter в методе BeginExport запросто могут выводить форму настройки экспорта.

Менеджер классов

Следующим номером нашей программы будет менеджер загруженных классов. Как я и говорил, это может быть просто TList:
unit UClassManager; { ============================================= } interface { ============================================= } uses Classes; type TClassManager = class(TList); function ClassManager: TClassManager; { ============================================= } implementation { ============================================= } var Manager: TClassManager; function ClassManager: TClassManager; begin Result := Manager; end; { ============================================= } initialization { ============================================= } Manager := TClassManager.Create; { ============================================= } finalization { ============================================= } Manager.Free; end


В этом коде, по моему, пояснять нечего.

Экспорт в простой текстовый файл

Теперь напишем стандартный потомок от TExporter, обеспечивающий вывод строк в обычный текстовый файл.
unit UPlainFileExporter; { ============================================= } interface { ============================================= } uses Classes, UExporter; type TPlainFileExporter = class(TExporter) private F: TextFile; public class function ExporterName: string; override; procedure BeginExport; override; procedure ExportNextString(const s:string); override; procedure EndExport; override; end; { ============================================= } implementation { ============================================= } uses Dialogs, SysUtils, UClassManager;{ TPlainFileExporter } procedure TPlainFileExporter.BeginExport; var OpenDialog : TOpenDialog; begin OpenDialog := TOpenDialog.Create(nil); try if OpenDialog.Execute then begin AssignFile(F,OpenDialog.FileName); Rewrite(F); end else Abort; finally OpenDialog.Free; end; end; procedure TPlainFileExporter.EndExport; begin CloseFile(F); end; class function TPlainFileExporter.ExporterName: string; begin Result := 'Экспорт в текстовый файл'; end; procedure TPlainFileExporter.ExportNextString(const s: string); begin WriteLn(F, s); end; { ============================================= } initialization { ============================================= } ClassManager.Add(TPlainFileExporter); { ============================================= } finalization { ============================================= } ClassManager.Remove(TPlainFileExporter); end
Мы считаем, что коррестность вызова методов BeginExport и EndExport обеспечит головная программа и не задумываемся о возможных неприятностях с открытым файлом. Кроме того, следует отметить, что используется модуль Dialogs, который использует Forms и т.п. И наконец, обратите внимание на разделы initialization и finalization модуля - мы используем возможность Delphi ссылаться на класс, как на объект.

Основная программа

Из основной программы я приведу только несколько методов, иллюстрирующих использование внешних пакетов, а полный текст вы найдете в архиве, прилагаемом к статье.
procedure TMainForm.RefreshPluginList; var i : Integer; begin PluginsBox.Items.Clear; for i := 0 to ClassManager.Count - 1 do PluginsBox.Items.Add(TExporterClass(ClassManager[i]).ExporterName); end;


Эта процедура просматривает список зарегистрированных классов (предполагается, что там только потомки TExporter) и выводит их "читабельные" имена в ListBox.

procedure TMainForm.LoadBtnClick(Sender: TObject); begin PluginModule := LoadPackage(ExtractFilePath(ParamStr(0)) + 'HTMLPluginProject.bpl'); RefreshPluginList; end;
Эта процедура загружает пакет с "зашитым" именем (ну это же просто пример :) ) и запоминает его handle. После чего происходит обновление списка, чтобы вы могли убедиться, что новый класс зарегистрировался.

procedure TMainForm.UnloadBtnClick(Sender: TObject);begin UnloadPackage(PluginModule); RefreshPluginList;end;
Ну тут, я думаю, все ясно.

procedure TMainForm.ExportBtnClick(Sender: TObject); var ExporterClass: TClass; Exporter: TExporter; i: Integer; begin if PluginsBox.ItemIndex < 0 then Exit; ExporterClass := ClassManager[PluginsBox.ItemIndex]; Exporter := TExporter(ExporterClass.Create); try Exporter.BeginExport; try for i := 0 to StringsBox.Lines.Count - 1 do Exporter.ExportNextString(StringsBox.Lines[i]); finally Exporter.EndExport end; finally Exporter.Free; end; end;
Эта процедура производит экспорт строк с помощью зарегистрированного класса plugin'а. Мы пользуемся тем, что нам известен абстрактный класс, так что мы спокойно можем вызывать соответствующие методы. Здесь следует обратить внимание на процесс создания экземпляра класса plugin'а.

Компиляция

Разверните архив в какой-то каталог ( например c:\bebebe :) ) и откройте группу проектов Demo1ProjectGroup.bpg. Использование группы полезно, так как вам часто придется переключаться между основной программой и двумя пакетами - это разные проекты. Я надеюсь, что если вы нажмете "Build All Projects" то все успешно скомпилится.

Поглядев на опции головного проекта, вы увидите, что на страничке Packages указано, какие из используемых пакетов не прилинковывать к exe-файлу. Следует отметить, что даже если вы включите туда только PluginInterfaceProject, то автоматом будут считаться внешними и все, используемые им пакеты - в нашем случае Vcl5.dpl. Зато если вы положите на основную форму какой-то компонент работы с BDE, то пакет VclDB5.bpl может быть прикомпилирован (с оптимизацией, естественно) к EXE-файлу.

Что еще можно сказать? Пожалуй, стоит отметить, что "возня" с пакетами нередко бывает утомительна и чревата "непонятными ошибками" вплоть до зависания Delphi. Однако все они в итоге оказываются следствием неаккуратности разработчика - ведь связывание на этапе выполнения это не простая штука. Поэтому следите, куда вы компилируете пакеты, следите за своевременной перекомпиляцией plugin'ов, если изменился абстрактный класс, следите, чтобы у вас на машине не валялось 10 копий dpl-пакета, потому как вы можете думать, что программа загрузит лежащий там-то и ошибетесь.

Еще. По умолчанию файлы .dcu кладутся вместе с исходниками, а пакеты - в каталог ($DELPHI)\Projects\Bpl. В примере настроки правильные - пакеты создадутся в каталоге исходников. Пожелания, вопросы, благодарности и ругань приму по адресу iamhere@ipc.ru. На все, кроме ругани постараюсь ответить.


Что еще можно сказать? Пожалуй, стоит отметить, что "возня" с пакетами нередко бывает утомительна и чревата "непонятными ошибками" вплоть до зависания Delphi. Однако все они в итоге оказываются следствием неаккуратности разработчика - ведь связывание на этапе выполнения это не простая штука. Поэтому следите, куда вы компилируете пакеты, следите за своевременной перекомпиляцией plugin'ов, если изменился абстрактный класс, следите, чтобы у вас на машине не валялось 10 копий dpl-пакета, потому как вы можете думать, что программа загрузит лежащий там-то и ошибетесь.

Еще. По умолчанию файлы .dcu кладутся вместе с исходниками, а пакеты - в каталог ($DELPHI)\Projects\Bpl. В примере настроки правильные - пакеты создадутся в каталоге исходников. Пожелания, вопросы, благодарности и ругань приму по адресу iamhere@ipc.ru. На все, кроме ругани постараюсь ответить.

Подведение итогов.


Таким образом, в настоящей статье и приведённых исходниках продемонстрирован "ручной" подход к реализации Инспектора объектов, а так же полная его (Инспектора) "русификация". Можно проанализировать все достоинства и недостатки данного подхода.

Достоинства

Особенности в обрабатываемых объектах не являются реальными свойствами или методами объекта. Можно обрабатывать любые свойства, события и методы объекта, а не только из области видимости published (строго говоря, методы GetParticuls и SetParticul как раз и реализуют эту область). Можно присваивать свои названия особенностям, не имеющие никакого отношения к реальным. Названия могут быть на любом языке. Имеется как public-, так и private-наследование. Имеется возможность из RunTime скрывать/показывать особенности. Возможность запрещать/разрешать особенности. Реализована обработка методов. Возможность создания собственного "DesignTime", совершенно не похожего на Delphi'йский.

Недостатки:

При создании новых объектов многое приходится делать "ручками": каждое свойство, метод или объект подлежит описанию "вручную". Нет обработки сложных свойств (хотя в принципе можно у это реализовать). При разработки собственной среды разработки приходится для каждого объекта писать специальный объект-оболочку (это напоминает COM-технологию и интерфейсы).

Но главное достоинство этого подхода - неплохое упражнение в алгоритмизации!



Получение и установка свойств источника


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

Свойства источника данных можно получить или установить через функции PEGetNthTableLogOnInfo и PESetNthTableLogOnInfo. Здесь надо отметить довольно тонкий момент, связанный с обработкой данных в CR. Источником данных может выступать любая СУБД как файловая, так и серверная, текстовый файл и т.п. В свою очередь к примеру из серверной СУБД данные можно получить через хранимую процедуру (stored procedure), представление (view), таблицу (table) или через набор таблиц которые обрабатываются уже внутри отчета. Поэтому используются различные API функции зависящие от возможностей источника.

Обратите внимание на название в именах функций - сокращение Nth обозначает, что функция вызывается для определенной таблицы.

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

Синтаксис функции: function PEGetNthTableLogOnInfo (printJob: Word; tableN: Integer; var logOnInfo: PELogOnInfo): Bool; где, printJob - дескриптор задачи. tableN - номер таблицы. location - струкура со свойствами источника. Пример: PEGetNthTableLogOnInfo(FHandleJob, 0, lt);
Структура PELogOnInfo содержит свойства источника. Перед ее передачей в функцию обязательно заполните поле StructSize. Например:
// Чистим структуру. FillChar(lt, SizeOf(PELogOnInfo), 0); // Заполняем поле размера. lt.StructSize := SizeOf(PELogOnInfo); // Вызываем функцию для таблицы с порядковым номером 0 (ноль) PEGetNthTableLogOnInfo(FHandleJob, 0, lt);
Описание структуры:
type PELogonServerType = array[0..PE_SERVERNAME_LEN-1] of Сhar; PELogonDBType = array[0..PE_DATABASENAME_LEN-1] of Сhar; PELogonUserType = array[0..PE_USERID_LEN-1] of Сhar; PELogonPassType = array[0..PE_PASSWORD_LEN-1] of Сhar; PELogOnInfo = record StructSize: Word; ServerName: PELogonServerType; DatabaseName: PELogonDbType; UserId: PELogonUserType; Password: PELogonPassType; end; где, StructSize - размер структуры. Заполняется обязательно. ServerName - имя сервера или путь к файлу БД. DatabaseName - имя БД. UserId - пользователь. Password - пароль пользователя.
Функция установки параметров PESetNthTableLogOnInfo аналогично предыдущей (в смысле параметров, а действует наоборот - устанавливает новые свойства источника). У данной функции есть один дополнительный логический параметр propagateAcrossTables, который указывает как обработать информацию из структуры PELogOnInfo. Если значение параметра TRUE, тогда свойства из структуры применяются для всех таблиц в отчете, иначе только для таблицы с с номером tableN. Например:
// Скопировать в поле ServerName путь к БД отчета. StrPCopy(@lt.ServerName, ExtractFilePath(edtPathReport.Text) + 'source_db.mdb'); // Установить параметры для таблицы 0 и только для нее. PESetNthTableLogOnInfo(FHandleJob, 0, lt, False);



Получение координат точек прямой


Для рисования прямых линий в Windows используется алгоритм GIQ (Grid Intersection Quantization). Каждый пиксель окружается воображаемым ромбом из четырёх пикселей. Если прямая имеет общие точки с этим ромбом, пиксель рисуется.

Для нахождения координат всех пикселей, составляющих заданную прямую, используется функция LineDDA. Эта функция в качестве параметра принимает координаты начала и конца линии, а также указатель на функцию, которой будут передаваться координаты пикселей. Данная функция должна быть реализована в программе. За время выполнения LineDDA эта функция будет вызвана столько раз, сколько пикселей содержит линия (как обычно в Windows, последний пиксель не считается принадлежащим прямой). Каждый раз при вызове ей будут передаваться координаты очередного пикселя, причём пиксели будут упорядочены от начала к концу прямой. Используя эту функцию, можно получить координаты всех пикселей прямой и нарисовать их каким-либо оригинальным способом, получая нестандартные стили прямых.

Так как любую кривую Безье можно разбить на отрезки прямых, её также можно нарисовать нестандартным стилем. Достаточно для каждого из этих отрезков вызвать LineDDA.