2.11. Поддержка Сом

Модель компонентных объектов СОМ (Component Object Model) представляет собой технологию обмена объектами между разными приложениями и даже между разными сетевыми машинами. Эта технология усиленно развивается Microsoft и в перспективе может привести к тому, что ваша программа сможет использовать объект (объект - это фрагмент исполняемого кода), установленный на машине, находящейся в другой части света, и не относящейся к тому же классу, что и ваша машина, т. е. написанный на другом языке программирования и реализованный другим набором машинных инструкций.

В основе СОМ лежат те же идеи, что и в OLE, с той разницей, что СОМ-сервер может выполнять обработку СОМ-клиента на машине сервера.

Разумеется, и сервер, и клиент в технологии СОМ могут быть установлены на одной и той же машине, однако в OLE это фактически является обязательным требованием. Если клиент и сервер выполняются на разных машинах, реализуется распределенный вариант СОМ - DCOM (Distributed Component Object Model).

В Delphi включены средства поддержки СОМ как в виде готовых компонентов (например, DCOMConnection), так и на уровне класса TComponent, т. е. относящиеся ко всем компонентам Delphi. Свойство этого класса

property ComObject:IUnknown;

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

property VCLComObject: Pointer;

предназначено для внешнего использования (т. е. для экспорта СОМ-объекта) и поставляет ссылку на СОМ-объект Delphi.

2.12. Свойства разного назначения

Узнать текущее состояние любого управляющего элемента на этапе прогона программы можно с помощью свойства

type TControlState = set of (csLButtonDown, csClicked, csPalette, csReadingState, csAlignmentNeeded, csFocusing, csCreating, csCustomPaint, csDestroyingHandle);

property ControlState: TControlState;

класса TControl.

Элементы множества TControlState имеют следующий смысл:

Элемент	Описание
csLButtonDow	Над элементом была нажата и еще не отпущена левая кнопка мыши
n csClicked	То же, что csLButtonDown, но устанавливается, если стиль компонента содержит флаг csClickEvents и означает, что нажатие кнопки интерпретируется как щелчок
csPalette	Элемент или его родитель получил сообщение WMPALETTCHANGED
csReadingState	Элемент читает данные из потока
csAlignmentNeeded	Элемент нуждается в перерисовке, т. к. изменилось его свойство Alignment
csFocusing	Программа пытается передать элементу фокус ввода
csCreating	Элемент и/или его родительские и дочерние элементы находятся в стадии создания. Флаг очищается после завершения процесса
csCustomPaint	Элемент перерисовывается
csDestroyingHandle	Разрушается Windows-дескриптор элемента

Свойство

type TControlStyle = set of (csAcceptsControls, csCaptureMouse, csDesignInteractive, csFramed, csClickEvents, csSetCaption, csOpaque, csDoubleClicks, csFixedWidth, csFixedHeight, csNoDesignVisible, csReplicatable, csNoStdEvents, csDisplayDraglmage, csReflector, csActionClient, csMenuEvents) ;

property ControlStyle: TControlStyle;

содержит стилевые флаги элемента, имеющие такой смысл:

Стилевые флаги	Описание
csAcceptsControls	Элемент может стать владельцем дочернего элемента в технологии Drag&Dock
csActionClient	Элемент может участвовать в централизованном действии
csCaptureMouse	Элемент будет получать все сообщения от мыши, даже если ее указатель выйдет из его границ
csClickEvents	Элемент может воспринимать щелчок мыши
csDesignInteractive	Элемент воспринимает щелчок правой кнопкой мыши на этапе конструирования формы
csDisplayDragImage	Элемент способен менять свое изображение при протаскивании над ним “груза” в технологии Drags Drop
csDoubleClicks	Элемент может воспринимать двойной щелчок мыши
csPixedHeight	Элемент имеет фиксированную высоту
csFixedWidth	Элемент имеет фиксированную ширину
csFramed	Элемент имеет трехмерную рамку
csNoDesignVisible	Элемент не виден на этапе конструирования формы
csNoStdEvents	Элемент не реагирует на стандартные события от мыши или клавиатуры
csOpaque	Элемент закрашивает всю свою клиентскую область
csReflector	Элемент способен получать диалоговые сообщения Windows, сообщения, связанные с получением/потерей фокуса ввода и изменением размеров.
csReplicatable	Используется для компонентов АсtiveX
csSetCaption	Элемент способен отобразить свой образ с помощь метода PaintTo Элемент будет изменять свой заголовок при изменении своего свойства Name

Контрольные вопросы

1. Какой класс служит базой для создания как видимых, так и невидимых компонентов.

2. Какие компоненты способны получать и обрабатывать сообщения Windows?

3. По каким правилам строится имя компонента в программе?

4. Какие методы предназначены для управления списком Components?

5. Какие компоненты называются родительскими, дочерними?

6. С помощью каких методов можно работать со списком Controls?

7. С помощью каких методов можно расположить компонент над всеми компонентами и убрать обратно, если он частично или полностью перекрывается другими компонентами?

8. Какое свойство у глобального объекта Screen используется для изменения формы указателя для всех окон программы одновременно?

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

10. Каким способом достигается выделение элемента, которому в данный момент передается клавиатурный ввод?

11. Какой интерфейс в Delphi позволяет компонентам обмениваться данными путем “перетаскивания” их мышью?

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

1. Иллюстрация технологии Drag&Drop

unit Unit1;

interface

uses

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

StdCtrls, Buttons, ExtCtrls;

type

TfmExample = class(TForm)

Panel1: TPanel;

bbRun: TBitBtn;

bbClose: TBitBtn;

edInput: TEdit;

lbOutput: TLabel;

mmOutput: TMemo;

procedure lbOutputDragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

private

{ Private declarations }

public

{ Public declarations }

end;

var

fmExample: TfmExample;

implementation

{$R *.DFM}

procedure TfmExample.lbOutputDragOver(Sender, Source: TObject; X,

Y: Integer; State: TDragState; var Accept: Boolean);

begin

Accept := True;

lbOutput.Caption := (Source as TComponent).Name

end;

end.

2. Выбор несстандартных цветов

unit Unit1;

interface

uses

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

StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

Panel1: TPanel;

Panel2: TPanel;

ColorDialog1: TColorDialog;

Button1: TButton;

Button2: TButton;

Edit1: TEdit;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

{ Вызываем диалог ColorDialog1 и контролируем его результат:

если его метод Execute возвращает True, пользователь

выбрал нужный цвет: }

if ColorDialog1.Execute then

begin

// Закрашиваем левую панель выбранным цветом:

Panel1.Color := ColorDialog1.Color;

{ Помещаем в Edit1 и в заголовок левой панели шестнадцатеричное

представление цвета: }

Edit1.Text := IntToHex(ColorDialog1.Color,8);

Panel1.Caption := Edit1.Text

end

end;

function HexStrToInt(S: String): Integer;

{Функция преобразует шестнадцатеричное представление S целого числа в тип Integer}

function HDigital(C: Char): Byte;

//Преобразует шестнадцатеричную цифру С в число

begin

case C of

'0'..'9': Result := ord(C)-ord('0');

'A'..'F': Result := ord(C)-ord('A')+10;

else

{Если очередной символ не относится к допустимым для представления шестнадцатеричной цифры, возбуждаем исключительную ситуацию, которая блокирует преобразование и сообщает пользователю об ошибке:}

raise EConvertError.Create

('Недопустимое представление шестнадцатеричного числа');

end;

end; //HDigital

var

k: Integer;

begin //HexStrToInt

Result := 0;

//Удаляем возможный символ-указатель шестнадцатеричного числа:

if S[1]='$' then delete(S,1,1);

//Цикл преобразования строки:

for k := 1 to Length(S) do

Result := Result*16+HDigital(S[k]);

end; //HexStrToInt

procedure TForm1.Button2Click(Sender: TObject);

begin

Panel2.Color := HexStrToInt(Edit1.Text);

Panel2.Caption := Edit1.Text

end;

end.

3. Демонстрация свойств AlphaBlendValue и TransparentColor

unit Unit1;

interface

uses

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

Dialogs, ExtCtrls, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Timer1: TTimer;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

Left: Boolean;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin

Left := True;

AlphaBlend := True;

AlphaBlendValue := 255;

Timer1.Enabled := True;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

if Left and (AlphaBlendValue>0) then

AlphaBlendValue := AlphaBlendValue-15;

if AlphaBlendValue=0 then

Left := False;

if not Left then

if AlphaBlendValue<255 then

AlphaBlendValue := AlphaBlendValue+15

else

begin

Timer1.Enabled := False;

AlphaBlend := False

end;

Caption := IntToStr(AlphaBlendValue);

Repaint

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if TransparentColor then

Button2.Caption := 'Включить TransparentColor'

else

Button2.Caption := 'Выключить TransparentColor';

TransparentColor := not TransparentColor

end;

end.

4. Проверка мультимедийного таймера

unit Unit1;

interface

uses

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

StdCtrls, Buttons, ExtCtrls;

type

TfmExample = class(TForm)

Panel1: TPanel;

bbRun: TBitBtn;

bbClose: TBitBtn;

edInput: TEdit;

lbOutput: TLabel;

mmOutput: TMemo;

procedure bbRunClick(Sender: TObject);

procedure FormActivate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

fmExample: TfmExample;

implementation

{$R *.DFM}

// Объявление экспортируемых функций:

function timeSetEvent(uDelay, uReolution: UINT; lpTimeProc: Pointer;

dwUser: DWORD; fuEvent: UINT): Integer; stdcall; external 'winmm.dll';

function timeKillEvent(uID: UINT): Integer; stdcall; external 'winmm.dll';

// Обьявление глобальных переменных

var

uEventID: UINT; // Идентификатор события таймера

BegTime: TDateTime; // Засечка времени

Counter: Integer; // Счетчик повторений

Delay: Word; // Период срабатывания

procedure ProcTime(uID, msg: UINT; dwUse, dw1, dw2: DWORD); stdcall;

// Реакция на срабатывание таймера

var

h, m, s, ms: Word; // Переменные для декодирования времени

const

MaxCount = 500; // Количество повторений

begin

timeKillEvent(uEventID); // Останавливаем таймер

Counter := Counter+1; // Наращиваем счетчик

if Counter=MaxCount then // Конец цикла?

begin // - Да: декодируем время

DecodeTime((Time-BegTime)/MaxCount, h, m, s, ms);

fmExample.mmOutput.Lines.Add( // Сообщаем результат

Format('Задано %s ms. Получено %d ms',[fmExample.edInput.Text,ms]));

fmExample.edInput.Text := ''; // Готовим повторение

fmExample.edInput.SetFocus

end else // - Нет: вновь пускаем таймер

uEventID := timeSetEvent(Delay,0,@ProcTime,0,1);

end;

procedure TfmExample.bbRunClick(Sender: TObject);

// Запускает таймер. edInput содержит требуемый период.

begin

// Проверяем задание периода

if edInput.Text='' then Exit;

try

Delay := StrToInt(edInput.Text)

except

ShowMessage('Ошибка ввода числа');

edInput.SelectAll;

edInput.SetFocus;

Exit

end;

Counter := 0; // Сбрасываем счетчик

BegTime := Time; // Засекаем время

// Запускаем таймер:

uEventID := timeSetEvent(Delay,0,@ProcTime,0,1);

if uEventID=0 then

ShowMessage('Ошибка запуска таймера')

end;

procedure TfmExample.FormActivate(Sender: TObject);

begin

edInput.SetFocus

end;

end.

5. Проверка стандартного таймера

unit Unit1;

interface

uses

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

StdCtrls, Buttons, ExtCtrls;

type

TfmExample = class(TForm)

Panel1: TPanel;

bbRun: TBitBtn;

bbClose: TBitBtn;

edInput: TEdit;

lbOutput: TLabel;

mmOutput: TMemo;

Timer1: TTimer;

procedure bbRunClick(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure FormActivate(Sender: TObject);

private

{ Private declarations }

BegTime: TDateTime;

Counter: Integer;

public

{ Public declarations }

end;

var

fmExample: TfmExample;

implementation

{$R *.DFM}

procedure TfmExample.bbRunClick(Sender: TObject);

var

Delay: Word;

begin

// Проверяем задание интервала

if edInput.Text='' then Exit;

try

Delay := StrToInt(edInput.Text);

except

ShowMessage('Ошибка в записи числа');

edInput.SelectAll;

edInput.SetFocus;

Exit

end;

Counter := 0; // Сбрасываем счетчик

Timer1.Interval := Delay; // Устанавливаем интервал

BegTime := Time; // Засекаем время

Timer1.Enabled := True; // Пускаем таймер

Screen.Cursor := crHourGlass

end;

procedure TfmExample.Timer1Timer(Sender: TObject);

var

h, m, s, ms: Word;

begin

Counter := Counter + 1;

if Counter=55 then // 55 - кратно срабатыванию таймера

begin

Timer1.Enabled := False;

DecodeTime((Time-BegTime)/55, h, m, s, ms);

mmOutput.Lines.Add(

Format('Задано %s ms. Получено %d ms.', [edInput.Text, ms]));

edInput.Text := '';

edInput.SetFocus;

Screen.Cursor := crDefault

end;

end;

procedure TfmExample.FormActivate(Sender: TObject);

begin

edInput.SetFocus

end;

end.

Задания для самостоятельного выполнения

1. Объявить одномерный массив (количество элементов 10). Заполнить его числами от 15 до 6. Вывести содержимое массива на экран в компонент Label свойство Caption c пояснениями.

2. Объявить двумерный массив (10х10). Верхнюю половину заполнить 3, нижнюю половину заполнить 5. Результат вывести на экран в компонент Label свойство Caption c пояснениями.

3. Объявить двумерный массив (10х10). По диагонали левую половину заполнить 2, правую половину заполнить 3. Результат вывести на экран в компонент StringGrid свойство Cells.

4. Объявить одномерный массив (количество элементов 15). Заполнить его числами от 1 до 15. Вывести содержимое массива на экран в компонент StringGrid свойство Cells.

5. Объявить двумерный массив (10х10). Верхнюю половину заполнить 3, нижнюю половину заполнить 4. Результат вывести на экран в компонент StringGrid свойство Cells. Задать фиксированные строку и столбец для пояснений индексов массива.

6. Вычислить длину окружности, площадь круга и объём шара одного и того же заданного радиуса. Отобразить на экране в компонент Label свойство Caption c пояснениями.