Валерий Васильевич Фаронов
дата публикации 23-12-2003 17:19

---

Версия для печати

Отрывок из, готовящейся к изданию,
книги В.В.Фаронова "Искусство создания компонентов для Delphi"
Материал предоставлен автором
специально для публикации на Королевстве Дельфи.

Компонент FarRgnButton используется графический инструмент Regions (области) Windows для создания кнопок или декоративных элементов самой причудливой формы (см. рис.14.5).

рис. 14-5. Примеры форм компонента FarRgnButton

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

Для работы с областями требуется так называемый контекст графического устройства (device context — DC). В рамках VCL этот контекст предоставляет свойство Handle класса TCanvas. Для работы с областями используются функции API, перечисленные в табл.14.2.

Функция Назначение function CreateEllepticRgn(X1, Y1, X2, Y2): hRgn; Создает область в виде эллипса, вписанного в прямоугольник X1...Y2 function CreatePolygonRgn(var Points; Count, PolyFillMode: Integer): hRgn; Создает область в виде многоугольника (полигона). Points — массив координат всех вершин многоугольника; Count — количество вершин; PolyFillMode — режим заливки области (см. пояснения ниже) function CreateRectRgn(X1, Y1, X2, Y2): hRgn; Создает прямоугольную область function CreateRoundRectRgn(X1, Y1, X2, Y2, X3, Y3): hRgn; Создает прямоугольную область со скругленными углами: X1...Y2 — координаты углов прямоугольника; X3, Y3 — протяженность по горизонтали и вертикали сторон описывающего прямоугольника для эллиптического скругления углов function EqualRgn(Rgn1, Rgn2: hRgn): Bool; Проверяет эквивалентность двух областей function FillRgn(DC: hDc; Rgn: hRgn; Brush: hBrush): Bool; Заполняет (но не очерчивает) область Rgn кистью Brush function InvertRgn(DC: hDc; Rgn: hRgn): Bool; Инвертирует цвет пикселей внутри области function offsetRgn(DC: hDc; Rgn: hRgn; dX, dY: Integer): Integer; Смещает видимое изображений области на dX пикселей по горизонтали и dY — по вертикали. Положительные значения смещают вправо и вниз function PaintRgn(DC: hDc; Rgn: hRgn): Bool; Заполняет область текущей кистью function PtInRegion(Rgn: hRgn; X, Y: Integer) Bool; Проверяет принадлежность точки с координатами X, Y области Rgn function RectInRegion(Rgn: hRgn; X1, Y1, X2, Y2: Integer): Bool; Проверяет принадлежность прямоугольника X1...Y2 области Rgn procedure SetRectRgn(Rgn: hRgn; X1, Y1, X2, Y2: Integer); Заменяет форму области Rgn на прямоугольную

Наибольшее разнообразие форм реализует полигон — область в виде замкнутого многоугольника. Полигон создается функцией CreatePolygonRgn, которой передается контекст устройства, адрес массива точек TPoint с пиксельными координатами узлов полигона (вершин многоугольника), количество узлов и параметр PolyFillMode, определяющей режим заливки. Этот параметр может принимать одно из двух возможных значений: Alternate и Winding. В первом случае заполнение идет последовательно между двумя близлежащими сторонами многоугольника: сначала между 1-й и 2-й, затем между 3-й и 4-й и т. д. Во втором сначала подсчитывается количество N отрезков прямой, поворачивающих фигуру по часовой стрелке, затем из него вычитается количество поворотов против часовой стрелки. Заполнение идет только в том случае, если это количество не равно нулю, причем заполняется область справа от каждого отрезка, если N > 0, или слева, если N < 0. Рис.14.6 показывает влияние этого параметра на заполнение.

Рис.14.6. Режим заливки полигона: Alternate — слева; Winding — справа

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

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

В отличие от стандартной кнопки, наш компонент не будет получать фокус ввода, то есть нестандартная кнопка не может быть умалчиваемой. Таким образом, компоненту не нужно окно как таковое, а лишь дескриптор канвы ^[1]. В связи с этим он может наследовать от класса TGraphicControl или какого-либо его потомка. Наш компонент будет наследником от класса TPaintBox, который является прямым наследником TGraphicControl и отличается от него лишь методом Paint, который у родителя не делает ничего. Хотя наш компонент не вызывает унаследованный метод Paint (у родителя он просто очерчивает клиентскую область пунктиром, делая ее видимой на этапе конструирования формы), нам выгоднее наследовать от него, так как он публикует свойство OnMouseMove, в обработчике которого компонент будет менять форму указателя мыши, если этот указатель находится над компонентом, и в нем (компоненте) определен обработчик события OnClick.

unit FarRgnButton; {==================================================================== Этот модуль содержит компонент, с помощью которого можно создавать кнопки и декоративные панели неквадратной формы. Его свойство Button- Shape задает 5 основных форм: bsRect — прямоугольник; bsRoundRect - прямоугольник со скругленными углами; bsCircle — окружность; bsEllipce — эллипс; bsPolygon — полигон. Для полигона используется свойство Polygon типа TList. Оно предназначено для хранения относительных координат узлов полигона. Относительные координаты представляют собой пары вещественных чисел в диапазоне от 0 до 1. В реальные пиксельные координаты, хранящиеся в поле FPolyPointsI, они пересчитываются путем умножения на текущие размеры компонента (свойства Height и Width). Свойства Contour, ContourColor и ContourWidth управляют контуром, очерчивающим компонент. Свойство Depth3D устанавливает глубину трехмерности компонента как расстояние в пикселях от основной фигуры до обеих ее кромок. Свойства RoundX и RoundY определяют протяженность по горизонтали и вертикали описывающего прямоугольника для эллиптического скругления углов компонента в форме bsRoundRect. ====================================================================} interface uses SysUtils, Classes, Controls, Windows, Graphics, ExtCtrls; type TButtonShape = (bsRect, bsRoundRect, bsCircle, bsEllipse, bsPolygon); // Тип TPolyPoint определяет относительные координаты узла // полигона. Объекты этого типа хранит свойство Polygon PPolyPoint = ^TPolyPoint; TPolyPoint = record X, Y: Real; end; // Класс TPolygon представляет собой специализированного потомка // списка TList, предназначенного для хранения объектов типа // PPolyPoint TPolygon = class(TList) public function Add(X, Y: Real): Integer; procedure Delete(Index: Integer); procedure Clear; override; function GetX(Index: Integer): Real; function GetY(Index: Integer): Real; end; const MaxPoly = 1024; // Максимальное количество узлов полигона type TPolyPointsI = array [1..MaxPoly] of TPoint; TFarRgnButton = class(TPaintBox) private Rgn1, // Область для светлой кромки Rgn2, // Область для темной кромки Rgn: HRGN; // Основная область FButtonShape: TButtonShape; FRoundX: Integer; FRoundY: Integer; FCaption: String; // Надпись на кнопке FPolygon: TPolygon; // Вещественные относительные координаты PolyPointsI: TPolyPointsI; // Пиксельные координаты FOnMouseMove: TMouseMoveEvent; FDepth3D: Byte; // Глубина трехмерности FContour: Boolean; // Признак наличия контура FContourColor: TColor; // Цвет контура FContourWidth: Integer; // Ширина контурной линии BtnHighLight: TColor; // Цвет верхней кромки BtnShadow: TColor; // Цвет нижней кромки InRgn: Boolean; // Признак нажатия кнопки // внутри области FPolyPoints: Real; // Поле для фиктивного свойства procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure SetButtonShape(Value: TButtonShape); procedure SetRoundX(Value: Integer); procedure SetCaption(const Value: String); procedure SetRoundY(Value: Integer); procedure SetDepth3d(Value: Byte); procedure SetPolygon(const Value: TPolygon); procedure SetContour(Value: Boolean); procedure SetContourColor(Value: TColor); procedure SetContourWidth(Value: Integer); // Следующее фиктивное свойство вводится для сохранения значений // свойства Polygon в файле формы (см. п.14.3.4) property PolyPoints:Real read FPolyPoints write FPolyPoints; protected procedure RectPaint; procedure RoundRectPaint; procedure EllipsePaint; procedure PolygonPaint; procedure readReals(Reader: TReader); procedure WriteReals(Writer: TWriter); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Paint; override; procedure DefineProperties(Filer: TFiler); override; published property ButtonShape: TButtonShape read FButtonShape write SetButtonShape default bsPolygon; property RoundX: Integer read FRoundX write SetRoundX default 20; property RoundY: Integer read FRoundY write SetRoundY default 20; property Caption: String read FCaption write SetCaption; property Depth3D: Byte read FDepth3D write SetDepth3D default 1; property Polygon: TPolygon read FPolygon write SetPolygon; property Contour: Boolean read FContour write SetContour default False; property ContourColor: TColor read FContourColor write SetContourColor default clBlack; property ContourWidth: Integer read FContourWidth write SetContourWidth default 1; end; procedure Register; implementation procedure Register; begin RegisterComponents('Far', [TFarRgnButton]); end; { TFarRgnButton } constructor TFarRgnButton.Create(AOwner: TComponent); begin inherited; Width := 90; Height := 25; // Перехватываем событие OnMouseMove для смены указателя мыши inherited OnMouseMove := MouseMove; OnMouseUp := MouseUp; OnMouseDown := MouseDown; FRoundX := 20; FRoundY := 20; Depth3D := 1; FContour := False; FContourColor := clBlack; BtnHighLight := clBtnHighLight; BtnShadow := clBtnShadow; FContourWidth := 1; FButtonShape := bsPolygon; FPolygon := TPolygon.Create; // Начальный полигон — треугольник: Polygon.Add(0.5, 0); Polygon.Add(1, 1); Polygon.Add(0, 1); end; destructor TFarRgnButton.Destroy; begin FPolygon.Clear; FPolygon.Free; inherited end; procedure TFarRgnButton.EllipsePaint; // Отрисовка фигуры в виде эллипса begin with Canvas do begin if Depth3D > 0 then // Трехмерный компонент? begin // -Да // Светлая кромка: Rgn1 := CreateEllipticRgn(0, 0, Width — 2 * Depth3D, Height — 2 * Depth3D); Brush.Color := BtnHighLight; FillRgn(Handle, Rgn1, Brush.Handle); // Темная кромка: Rgn2 := CreateEllipticRgn(2 * Depth3D, 2 * Depth3D, Width, Height); Brush.Color := BtnShadow; FillRgn(Handle, Rgn2, Brush.Handle); // Основной эллипс: Rgn := CreateEllipticRgn(Depth3D, Depth3D, Width — Depth3D, Height — Depth3D); Brush.Color := Self.Color; FillRgn(Handle, Rgn, Brush.Handle); if Contour then // Есть контур? begin // -Да Brush.Style := bsClear; Ellipse(Depth3D, Depth3D, Width — Depth3D, Height — Depth3D) end end else // Нет трехмерности begin Rgn := CreateEllipticRgn(0, 0, Width, Height); Brush.Color := Self.Color; FillRgn(Handle, Rgn, Brush.Handle); if Contour then begin Pen.Color := FContourColor; Pen.Width := FContourWidth; Brush.Style := bsClear; Ellipse(0, 0, Width, Height) end end end end; procedure TFarRgnButton.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); // Меняет форму указателя мыши, если определен обработчик OnClick, и // вызывает пользовательский обработчик OnMouseMove begin if PtInRegion(Rgn, X, Y) and Assigned(OnClick) then Cursor := crHandPoint else Cursor := crDefault; if Assigned(FOnMouseMove) then FOnMouseMove(Sender, Shift, X, Y); end; procedure TFarRgnButton.Paint; // Основная процедура отрисовки var X, Y: Integer; begin Canvas.Font := Font; Canvas.Brush.Color := Color; // Проверяем старые области и удаляем их if Rgn1 <> 0 then DeleteObject(Rgn1); if Rgn2 <> 0 then DeleteObject(Rgn2); if Rgn <> 0 then DeleteObject(Rgn); Rgn1 := 0; Rgn2 := 0; Rgn := 0; // Отрисовка зависит от фигуры: case FButtonShape of bsRect: RectPaint; bsRoundRect: RoundRectPaint; bsCircle: begin // Рисуем эллипс, вписанный в квадрат if Width > Height then Width := Height else Height := Width; EllipsePaint end; bsEllipse: EllipsePaint; bsPolygon: PolygonPaint; end; // Фигура отрисована. Выводим надпись if FCaption <> '' thenwith Canvas do begin // Центрируем по горизонтали и вертикали: X := (Width — TextWidth(Caption)) div 2; Y := (Height — TextHeight('1')) div 2; // Не перекрашиваем фон: SetBkMode(Handle, Transparent); TextOut(X, Y, Caption) end end; procedure TFarRgnButton.PolygonPaint; // Отрисовка полигона var k: Integer; procedure offsetPolyPoints(dX, dY: Integer); // Смещает узлы полигона для трехмерности var k: Integer; begin for k := 1 to FPolygon.Count do begin PolyPointsI[k].X := PolyPointsI[k].X + dX; PolyPointsI[k].Y := PolyPointsI[k].Y + dY; end end; begin // Начало PolygonPaint with Canvas do begin if Depth3D > 0 then // Есть трехмерность? begin // -Да for k := 1 to FPolygon.Count do begin // Преобразуем относительные координаты узлов в реальные // с уменьшением высоты и ширины на глубину трехмерности PolyPointsI[k].X := Trunc((Width — 2 * Depth3D) * FPolygon.GetX(k — 1)); PolyPointsI[k].Y := Trunc((Height — 2 * Depth3D) * FPolygon.GetY(k — 1)); end; // Светлая кромка Rgn1 := CreatePolygonRgn(PolyPointsI, FPolygon.Count, Winding); Brush.Color := BtnHighLight; FillRgn(Handle, Rgn1, Brush.Handle); // Темная кромка offsetPolyPoints(2 * Depth3D, 2 * Depth3D); Rgn2 := CreatePolygonRgn(PolyPointsI, FPolygon.Count, Winding); Brush.Color := BtnShadow; FillRgn(Handle, Rgn2, Brush.Handle); // Готовим основной полигон offSetPolyPoints(-Depth3D, -Depth3D); end else begin // Нет трехмерности for k := 1 to FPolygon.Count do begin PolyPointsI[k].X := Trunc((Width) * FPolygon.GetX(k — 1)); if PolyPointsI[k].X = Width then dec(PolyPointsI[k].X); PolyPointsI[k].Y := Trunc((Height) * FPolygon.GetY(k — 1)); if PolyPointsI[k].Y = Height then dec(PolyPointsI[k].Y); end end; // Основной полигон Rgn := CreatePolygonRgn(PolyPointsI, FPolygon.Count, Winding); Brush.Color := Self.Color; FillRgn(Handle, Rgn, Brush.Handle); if Contour then // Есть контур? begin // -Да Pen.Color := FContourColor; Pen.Width := FContourWidth; MoveTo(PolyPointsI[1].X, PolyPointsI[1].Y); for k := 2 to FPolygon.Count do LineTo(PolyPointsI[k].X, PolyPointsI[k].Y); LineTo(PolyPointsI[1].X, PolyPointsI[1].Y) end end end; procedure TFarRgnButton.RectPaint; // Отрисовка прямоугольника begin with Canvas do begin if Depth3D > 0 then begin // Есть трехмерность // Светлая кромка Rgn1 := CreateRectRgn(0, 0, Width — 2 * Depth3D, Height — 2 * Depth3D); Brush.Color := BtnHighLight; FillRgn(Handle, Rgn1, Brush.Handle); // Темная кромка Rgn2 := CreateRectRgn(2 * Depth3D, 2 * Depth3D, Width, Height); Brush.Color := BtnShadow; FillRgn(Handle, Rgn2, Brush.Handle); // Основная фигура Rgn := CreateRectRgn(Depth3D, Depth3D, Width — Depth3D, Height — Depth3D); Brush.Color := Self.Color; FillRgn(Handle, Rgn, Brush.Handle); if Contour then begin Pen.Color := FContourColor; Pen.Width := FContourWidth; Brush.Style := bsClear; Rectangle(Depth3D, Depth3D, Width — Depth3D, Height — Depth3D); end end else begin // Нет трехмерности Rgn := CreateRectRgn(0, 0, Width, Height); Brush.Color := Self.Color; FillRgn(Handle, Rgn, Brush.Handle); if Contour then begin Pen.Color := FContourColor; Pen.Width := FContourWidth; Brush.Style := bsClear; Rectangle(0, 0, Width, Height) end end end end; procedure TFarRgnButton.RoundRectPaint; // Отрисовка скругленного прямоугольника begin with Canvas do begin if Depth3D > 0 then begin // Есть трехмерность // Светлая кромка Rgn1 := CreateRoundRectRgn(0, 0, Width — 2 * Depth3D, Height — 2 * Depth3D, FRoundX, FRoundY); Brush.Color := BtnHighLight; FillRgn(Handle, Rgn1, Brush.Handle); // Темная кромка Rgn2 := CreateRoundRectRgn(2 * Depth3D, 2 * Depth3D, Width, Height, FRoundX, FRoundY); Brush.Color := BtnShadow; FillRgn(Handle, Rgn2, Brush.Handle); // Основная фигура Rgn := CreateRoundRectRgn(Depth3D, Depth3D, Width — Depth3D, Height — Depth3D, FRoundX, FRoundY); Brush.Color := Self.Color; FillRgn(Handle, Rgn, Brush.Handle); if Contour then begin Pen.Color := FContourColor; Pen.Width := FContourWidth; Brush.Style := bsClear; RoundRect(Depth3D, Depth3D, Width — Depth3D, Height — Depth3D, FRoundX, FRoundY) end end else begin // Нет трхмерности Brush.Color := Self.Color; FillRgn(Handle, Rgn, Brush.Handle); Rgn := CreateRoundRectRgn(0, 0, Width, Height, FRoundX, FRoundY); end; if Contour then begin Pen.Color := FContourColor; Pen.Width := FContourWidth; Brush.Style := bsClear; RoundRect(0, 0, Width, Height, FRoundX, FRoundY) end end end; procedure TFarRgnButton.SetButtonShape(Value: TButtonShape); // Изменение формы компонента begin if FButtonShape <> Value then begin FButtonShape := Value; Invalidate end end; procedure TFarRgnButton.SetCaption(const Value: String); // Изменение надписи begin if FCaption <> Value then begin FCaption := Value; Invalidate end end; procedure TFarRgnButton.SetRoundX(Value: Integer); // Изменение скругления begin if FRoundX <> Value then begin FRoundX := Value; Invalidate end end; procedure TFarRgnButton.SetRoundY(Value: Integer); begin if FRoundY <> Value then begin FRoundY := Value; Invalidate end end; procedure TFarRgnButton.SetDepth3d(Value: Byte); // Изменение глубины трехмерности begin if Value <> FDepth3D then begin FDepth3D := Value; Invalidate end end; procedure TFarRgnButton.SetPolygon(const Value: TPolygon); // Изменение свойства Polygon begin FPolygon := Value; if FButtonShape = bsPolygon then Invalidate end; procedure TFarRgnButton.SetContour(Value: Boolean); // Изменение свойства Contour begin if Value <> FContour then begin FContour := Value; Invalidate end end; procedure TFarRgnButton.SetContourColor(Value: TColor); // Изменение цвета контура begin if Value <> FContourColor then begin FContourColor := Value; if FContour then Invalidate end end; procedure TFarRgnButton.SetContourWidth(Value: Integer); // Изменение ширины контура begin if Value <> FContourWidth then begin FContourWidth := Value; if FContour then Invalidate end end; procedure TFarRgnButton.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // Реализация "вдавленной" кнопки begin InRgn := PtInRegion(Rgn, X, Y); if InRgn then begin // Меняем цвета кромок BtnHighLight := clBtnShadow; BtnShadow := clBtnHighLight; Invalidate end end; procedure TFarRgnButton.MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // При отпускании кнопки восстанавливает выпуклость и вызывает // обработчик OnClick begin if InRgn then begin BtnHighLight := clBtnHighLight; BtnShadow := clBtnShadow; Invalidate; if Assigned(OnClick) then OnClick(Self) end end; procedure TFarRgnButton.DefineProperties(Filer: TFiler); // Определяет сохранение фиктивного свойства PoluPoints, но на самом // деле сохраняет полигон в файле формы begin inherited; Filer.DefineProperty('PolyPoints', ReadReals, WriteReals, True); end; procedure TFarRgnButton.ReadReals(Reader: TReader); // Читает полигон из файла формы var X, Y: Real; begin reader.ReadListBegin; // Читаем маркер начала списка FPolygon.Clear; // Удаляем старый полигон while not reader.EndofList. do // Читаем относительные координаты begin X := reader.ReadFloat; Y := reader.ReadFloat; FPolygon.Add(X, Y); // Добавляем новый узел end; reader.ReadListend // Читаем маркер конца списка end; procedure TFarRgnButton.WriteReals(Writer: TWriter); // Записывает полигон в файл формы var k: Integer; begin Writer.WriteListBegin; // Маркер начала списка for K := 0 to FPolygon.Count — 1 do begin // Записываем очередной узел Writer.WriteFloat(FPolygon.GetX(k)); Writer.WriteFloat(FPolygon.GetY(k)); end; Writer.WriteListend // Маркер конца списка end; { TPolygon } var P: PPolyPoint;// Глобальная переменная для доступа к элементам списка function TPolygon.Add(X, Y: Real): Integer; // Добавляет новый узел к списку begin New(P); // Резервируем память P.X := X; // Размещаем в ней координаты P.Y := Y; Result := inherited Add(P) // Добавляем к списку end; procedure TPolygon.Delete(Index: Integer); // Удаляет узел с индексом Index begin P := Items[Index]; // Адрес узла Dispose(P) // Освобождаем память end; procedure TPolygon.Clear; // Очищает список var k: Integer; begin for k := 0 to Count — 1 do Delete(k); inherited end; function TPolygon.GetX(Index: Integer): Real; // Возвращает координату Х узла Index begin P := Items[Index]; Result := P.X end; function TPolygon.GetY(Index: Integer): Real; // Возвращает координату Y узла Index begin P := Items[Index]; Result := P.Y end; end.

Свойство Depth3D определяет глубину трехмерности как расстояние в пикселях от основной фигуры до обеих ее кромок — светлой (верхней) и темной (нижней). Введение этого свойства вместо привычного логического свойства Ctl3D, которым обладают многие визуальные компоненты, вызвано тем, что размеры нашего компонента могут быть больше обычных размеров кнопки, так что стандартное смещение на 1 пиксель в этом случае может оказаться недостаточным.

Для создания эффекта трехмерности используются три области. Область Rgn1 смещается на Depth3D пикселей влево и вверх относительно основной области Rgn и закрашивается светлой кистью. Область Rgn2 смещается на столько же пикселей вправо и вниз и закрашивается темной кистью. После отрисовки кромок рисуется основная область. В начале метода Paint проверяется действительность дескрипторов всех трех областей и при необходимости "старые" области разрушаются обращением к функции DeleteObject.

Компонент перехватывает событие OnMouseMove и проверяет, находится ли точка чувствительности указателя мыши над областью:

if PtInRegion(Rgn, X, Y) and Assigned(OnClick) then Cursor := crHandPoint else Cursor := crDefault;

Эта проверка кажется излишней — ведь событие OnMouseMove возбуждается только в момент перемещения указателя над компонентом. Однако в нашем случае форма области — непрямоугольная, так что некоторая часть размеров компонента может остаться пустой. Проверка гарантирует, что изменение формы указателя будет происходить только при попадании точки чувствительности в видимые размеры основной области.

Свойство Polygon хранит записи типа TPolyPoint. Поля X и Y этих записей содержат относительные координаты одного узла полигона в виде пары вещественных чисел в диапазоне значений от 0 до 1. Перед отрисовкой относительные координаты пересчитываются в реальные пиксельные путем их умножения на размеры компонента и помещаются в поле PolyPointsI:

// Преобразуем относительные координаты узлов в реальные // с уменьшением высоты и ширины на удвоенную глубину трехмерности PolyPointsI[k].X := Trunc((Width — 2 * Depth3D) * TPolyPoint(FList.Items[k — 1]).X); PolyPointsI[k].Y := Trunc((Height — 2 * Depth3D) * TPolyPoint(FList.Items[k — 1]).Y);

Использование относительных координат легко решает проблему изменения размеров полигона при изменении размеров компонента. Введение специального наследника TList для хранения узлов полигона существенно упрощает работу с динамической памятью. Замечу, что максимальное количество узлов, сохраняющихся с списке свойства Polygon, может быть очень большим. Однако при пересчете относительных координат в пиксельные используется поле FPolyPointsI, способное хранить не более 1024 узла. Такое ограничение возникло из-за формата обращения к функции CreatePolygonRgn, которая требует ссылку на непрерывный массив пискельных координат. При использовании механизма TList для хранения пиксельных координат гарантии непрерывности массива дать невозможно, поэтому они хранятся в обычном массиве.

Как и в стандартной кнопке TButton событие OnClick возникает при отпускании нажатой кнопки. Для этого в момент нажатия кнопки мыши в поле InRgn заносится значение True, если указатель располагается над областью, и область отрисовывается вдавленной (это легко сделать, изменив цвета кромок). При отпускании кнопки мыши проверяется признак InRgn (напомню, область может быть непрямоугольной, так что часть ее площади может остаться пустой) и восстанавливается выпуклость кнопки, после чего возбуждается событие OnClick.

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

Листинг 14.4. Модуль редактора свойства Polygon

unit PolyPropEdit; {====================================================================== Этот модуль содержит редактор свойства Polygon компонента FarRgnButton. Внимание! Этот модуль нельзя отлаживать автономно, без регистрации в среде Delphi! ======================================================================} interface uses DesignIntf, DesignEditors, FarRgnButton; type TPolygonproperty = class(TPropertyEditor) procedure Edit; override; function GetAttributes: TPropertyAttributes; override; function GetValue: String; override; end; procedure Register; implementation uses EditPolyPoints, SysUtils, Controls; procedure Register; begin RegisterPropertyEditor(typeInfo(TPolygon), TFarRgnButton, 'Polygon', TPolygonProperty); end; { TPolyListproperty } procedure TPolygonProperty.Edit; { Основная процедура. Создает и показывает диалоговое окно для выбора (создания) полигона. Получает с помощью функции GetOrdValue ccылку на экземпляр свойства Polygon и помещает эту ссылку в поле Polygon окна. Если пользователь завершил диалог с результатом mrOK, копирует отредактированный полигон из свойства PolyPoints окна. } var Dlg: TEdPolyDlg; k: Integer; begin Dlg := TEdPolyDlg.Create(Nil); try with Dlg do begin // Копируем ссылку на свойство Polygon в одноименную переменную // диалогового окна и показываем диалог: Polygon := TPolygon(GetOrdValue); if ShowModal = mrOK thenwith TPolygon(GetOrdValue) do begin Clear; // Уничтожаем старый полигон for k := 0 to PolyPoints.Count — 1 do // Создаем новый Add(PolyPoints.GetX(k), PolyPoints.GetY(k)); end end; finally FreeAndNil(Dlg); end end; function TPolygonProperty.GetAttributes: TPropertyAttributes; // Указываем среде на необходимость вставки кнопки вызова диалога begin Result := [paDialog] end; function TPolygonProperty.GetValue: String; // Свойство Polygon в окне Инспектора объектов содержит надпись в // виде имени типа свойства begin Result := 'TPolygon' end; end.

В нашем случае представить значения свойства в строковом виде достаточно сложно, поэтому не перекрывается (и не используется) метод SetValue. Для доступа к редактируемому свойству используется ссылка на него, получаемая методом GetOrdValue. Чтобы строка значения свойства в окне Инспектора объектов не оставалась пустой, методом GetValue помещаем в нее имя типа свойства.

Вся работа по созданию/изменению полигона возлагается на диалог EdPolyDlg, окно которого показано на рис.14.7.

Рис. 14.7. Окно редактирования свойства Polygon

Окно разделено на две неравные части. Слева располагается поле для редактирования полигона, справа — инструментальная панель. Редактирование полигона заключается в выборе количества узлов (изломов полилинии) и их положения относительно друг друга. Для выбора нужного количества узлов измените значение в поле ввода Количество изломов и щелкните на кнопке справа от него. Первоначально узлы располагаются в виде вписанного в окружность правильного многоугольника и обозначаются маркерами — небольшими черными квадратиками. Для изменения положения того или иного узла подведите к его маркеру указатель мыши. В момент, когда указатель сменит свой вид ("захватит" узел) нажмите кнопку мыши и отбуксируйте маркер на нужное место, после чего отпустите кнопку.

Опыт показывает, что этих скромных средств вполне достаточно для создания самых разных полигонов — все зависит от вашей фантазии и терпения. Для создания сложного полигона вначале полезно изобразить его на клетчатой бумаге, подсчитать количество узлов и разместить их в соответствии с этим планом. Раз созданный полигон можно сохранить в двоичном файле или прочитать из него. Для этого служат две верхние инструментальные кнопки — для записи и для чтения. Расположенные под ними кнопки создают так называемые стандартные полигоны. В случае сложных полигонов вам, возможно, пригодится сетка, размечающая поверхность редактора рядами точек. Сетка включается/отключается флажком Сетка. Справа от флажка находится поле Шаг, которое устанавливает шаг сетки в пикселях экрана.

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

Листинг 14.5. Модуль диалогового окна создания/редактирования полигона

unit EditPolyPoints; interface uses Windows, Messages, SysUtils, var iants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, FarRgnButton, StdCtrls, Spin, Buttons, ImgList, ComCtrls, ToolWin; type TEdPolyDlg = class(TForm) Panel1: TPanel; BitBtn1: TBitBtn; BitBtn2: TBitBtn; seCount: TSpinEdit; SpeedButton1: TSpeedButton; Opendialog1: TOpendialog; SaveDialog1: TSaveDialog; Label1: TLabel; lbStep: TLabel; cbStep: TCheckBox; seStep: TSpinEdit; BitBtn3: TBitBtn; ToolBar1: TToolBar; ToolButton1: TToolButton; ToolButton2: TToolButton; ToolButton4: TToolButton; ToolButton5: TToolButton; ToolButton6: TToolButton; ToolButton7: TToolButton; ToolButton8: TToolButton; ToolBar2: TToolBar; il1: TImageList; ToolButton10: TToolButton; ToolButton11: TToolButton; il2: TImageList; ToolButton3: TToolButton; ToolButton9: TToolButton; Box: TPaintBox; ToolButton12: TToolButton; ToolButton13: TToolButton; procedure BoxPaint(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure cbStepClick(Sender: TObject); procedure seStepChange(Sender: TObject); procedure BitBtn3Click(Sender: TObject); procedure ToolButton1Click(Sender: TObject); procedure ToolButton2Click(Sender: TObject); procedure ToolButton4Click(Sender: TObject); procedure ToolButton5Click(Sender: TObject); procedure ToolButton6Click(Sender: TObject); procedure ToolButton7Click(Sender: TObject); procedure ToolButton8Click(Sender: TObject); procedure BoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure BoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure BoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormShow(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure ToolButton12Click(Sender: TObject); private { private declarations } PolyCount: Integer; IsMoved: Integer; function IsPoint(X, Y: Integer): Integer; public { public declarations } procedure PaintPoly; procedure DrawMarker(N: Integer; Color: TColor); procedure DrawMarkers(Color: TColor); procedure DrawLines(Color: TColor); procedure DrawGrid(Color: TColor); procedure doPoints(Count: Integer); procedure ClearBox; procedure PointsIToPoints; end; var EdPolyDlg: TEdPolyDlg; // Экземпляр окна Polygon: TPolygon; // Исходный полигон PolyPoints: TPolygon; // Редактируемый полигон PolyPointsI: TPolyPointsI; // Пиксельные координаты Step: Integer = 12; // Шаг сетки implementation {$R *.dfm} const Scale = 250; // Смещение рабочей зоны от границ Box procedure TEdPolyDlg.DrawLines(Color: TColor); // Вычерчивает линии полигона цветом Color var k: Integer; begin with Box.Canvas do begin Pen.Color := Color; MoveTo(PolyPointsI[1].X, PolyPointsI[1].Y); for k := 2 to PolyPoints.Count do LineTo(PolyPointsI[k].X, PolyPointsI[k].Y); LineTo(PolyPointsI[1].X, PolyPointsI[1].Y) end end; procedure TEdPolyDlg.PaintPoly; // Отрисовка маркеров. Разрушает старые маркеры и создает новые // в соответствии с относительными координатами поля PolyPoints. // При первом обращении это поле не содержит координат, в этом // случае копируем координаты исходного полигона из поля Polygon var k: Integer; begin if PolyPoints.Count = 0 // Координаты полигона уже были скопированы? then // -Нет. Копируем их for k := 0 to Polygon.Count — 1 do PolyPoints.Add(Polygon.GetX(k), Polygon.GetY(k)); ClearBox; // Стираем старое изображение полигона PolyCount := PolyPoints.Count; // Координаты маркеров помещаем в массив PolyPoinysI: for k := 1 to PolyCount do begin PolyPointsI[k].X := Trunc(PolyPoints.GetX(k — 1) * Scale) + Scale div 2; PolyPointsI[k].Y := Trunc(PolyPoints.GetY(k — 1) * Scale) + Scale div 2; end; DrawMarkers(clBlack); // Чертим маркеры DrawLines(clBlack) // и соединяющие линии end; procedure TEdPolyDlg.SpeedButton1Click(Sender: TObject); // Щелчок на кнопке выбора количества узлов begin ClearBox; // Удаляем старое изображение doPoints(seCount.Value) // Создаем новое end; procedure TEdPolyDlg.ClearBox; // Очищает рабочее поле begin Box.Hide; Box.Show end; procedure TEdPolyDlg.DoPoints(Count: Integer); // Создает новый полигон. Count — количество узлов var k: Integer; R, XR, YR, dA: Real; begin dA := 2 * Pi / Count; // Угол между соседними узами R := 0.5; // Относительный радиус описывающей окружности // Очищаем старый полигон PolyPoints.Clear; // Создаем узлы нового for k := 1 to Count do begin XR := R * cos(k * dA); YR := R * sin(k * dA); PolyPoints.Add(0.5 + XR, 0.5 — YR) end; PaintPoly // Чертим новый полигон end; procedure TEdPolyDlg.BoxPaint(Sender: TObject); // Отрисовка полигона по координатам массива PolyPointsI begin DrawMarkers(clBlack); DrawLines(clBlack) end; procedure TEdPolyDlg.SpeedButton2Click(Sender: TObject); // Читает полигон из файла var F: File of Real; k, i, PolyCount: Integer; X, Y: Real; OldPoly: TPolygon; begin if Opendialog1.Execute then begin AssignFile(F, Opendialog1.FileName); Reset(F); PolyCount := FileSize(F) div 2; // Количество узлов должно быть не меньше трех, количество чисел // должно быть четным и длина файла должна быть кратна длине Real if (PolyCount < 6) or (Odd(PolyCount) = True) or (FileSize(F) mod (2 * Sizeof(Real)) <> 0) then begin // Условия не соблюдены — ощибка ShowMessage('Ошибка в файле ' + Opendialog1.FileName); Exit end; // Создаем копию старого полигона на случай ошибки чтения: OldPoly := TPolygon.Create; for k := 0 to PolyPoints.Count — 1 do with PolyPoints do OldPoly.Add(GetX(k), GetY(k)); PolyPoints.Clear; // Очищаем старый полигон // Цикл чтения: for k := 1 to PolyCount do begin {$I-} // Отключаем автоконтроль чтения read(F, X, Y); // Читаем два числа {$I+} // Включаем автоконтроль if IOResult <> 0 then // Ошибка? begin // -Да ShowMessage('Ошибка в файле ' + Opendialog1.FileName); // Восстанавливаем сохраненный полигон: PolyPoints.Clear; for i := 0 to OldPoly.Count — 1 do with OldPoly do PolyPoints.Add(GetX(i), GetY(i)); OldPoly.Clear; OldPoly.Free; // Удаляем ненужную копию CloseFile(F); // Закрываем файл Exit // Выходим end; PolyPoints.Add(X, Y) // Создаем очередной узел end; OldPoly.Clear; OldPoly.Free; CloseFile(F) end; seCount.Value := PolyCount; ClearBox; PaintPoly end; procedure TEdPolyDlg.SpeedButton3Click(Sender: TObject); // Сохраняет полигон в файле var F: File of Real; k: Integer; X, Y: Real; begin if SaveDialog1.Execute then begin AssignFile(F, SaveDialog1.FileName); Rewrite(F); PointsIToPoints; // Получаем текущее состояние полигона for k := 0 to PolyPoints.Count — 1 do begin X := PolyPoints.GetX(k); Y := PolyPoints.GetY(k); Write(F, X, Y) end; CloseFile(F) end end; procedure TEdPolyDlg.PointsIToPoints; // Преобразует пиксельные координаты в относительные var k, L, T, R, B, DX, DY, PolyCount: Integer; begin // Определяем границы чертежа: L := PolyPointsI[1].X; T := PolyPointsI[1].Y; R := L; B := T; for k := 2 to PolyPoints.Count do begin if PolyPointsI[k].X < L then L := PolyPointsI[k].X; if PolyPointsI[k].X > R then R := PolyPointsI[k].X; if PolyPointsI[k].Y < T then T := PolyPointsI[k].Y; if PolyPointsI[k].Y > B then B := PolyPointsI[k].Y; end; // Находим размеры чертежа: DX := R — L; // Ширина DY := B — T; // Высота // Создаем полигон по чертежу PolyCount := PolyPoints.Count; PolyPoints.Clear; for k := 1 to PolyCount do PolyPoints.Add((PolyPointsI[k].X — L) / DX, (PolyPointsI[k].Y — T) / DY) end; procedure TEdPolyDlg.BitBtn1Click(Sender: TObject); // Щелчок на кнопке ОК begin PointsIToPoints; // Освежаем полигон ModalResult := mrOK // Закрываем диалог end; procedure TEdPolyDlg.cbStepClick(Sender: TObject); // Щелчок на флажке "Сетка" begin if cbStep.Checked then begin lbStep.Visible := True; seStep.Visible := True; DrawGrid(clBlack) end else begin lbStep.Visible := False; seStep.Visible := False; DrawGrid(EdPolyDlg.Color) end end; procedure TEdPolyDlg.DrawGrid(Color: TColor); // Отрисовка сетки var x, y: Integer; begin with Box.Canvas do for x := 1 to Box.Width div Step do for y := 1 to Box.Height div Step do Pixels[x * Step, y * Step] := Color end; procedure TEdPolyDlg.seStepChange(Sender: TObject); // Изменение шага сетки begin DrawGrid(Color); // Удаляем старую сетку Step := seStep.Value; DrawGrid(clBlack) // Рисуем новую end; procedure TEdPolyDlg.BitBtn3Click(Sender: TObject); // Щелчок на кнопке "Освежить" begin DrawMarkers(clBlack); DrawLines(clBlack); if cbStep.Checked then DrawGrid(clBlack) end; procedure TEdPolyDlg.ToolButton1Click(Sender: TObject); // Стандартный полигон — треугольник влево begin with PolyPoints do begin Clear; Add(0, 0.5); Add(1, 0); Add(1, 1); PaintPoly end end; procedure TEdPolyDlg.ToolButton2Click(Sender: TObject); // Стандартный полигон — треугольник вправо begin with PolyPoints do begin Clear; Add(0, 0); Add(1, 0.5); Add(0, 1); PaintPoly end end; procedure TEdPolyDlg.ToolButton4Click(Sender: TObject); // Стандартный полигон — треугольник вверх begin with PolyPoints do begin Clear; Add(0.5, 0); Add(1, 1); Add(0, 1); PaintPoly end end; procedure TEdPolyDlg.ToolButton5Click(Sender: TObject); // Стандартный полигон — треугольник вниз begin with PolyPoints do begin Clear; Add(0, 0); Add(1, 0); Add(0.5, 1); PaintPoly end end; procedure TEdPolyDlg.ToolButton6Click(Sender: TObject); // Стандартный полигон — ромб begin with PolyPoints do begin Clear; Add(0.5, 0); Add(1, 0.5); Add(0.5, 1); Add(0, 0.5); PaintPoly end end; procedure TEdPolyDlg.ToolButton7Click(Sender: TObject); // Стандартный полигон — звезда 4 begin with PolyPoints do begin Clear; Add(0, 0.5); Add(0.35, 0.35); Add(0.5, 0); Add(0.65, 0.35); Add(1, 0.5); Add(0.65, 0.65); Add(0.5, 1); Add(0.35, 0.65); PaintPoly end end; procedure TEdPolyDlg.ToolButton8Click(Sender: TObject); // Стандартный полигон — звезда 6 begin with PolyPoints do begin Clear; Add(0.5, 0); Add(0.36, 0.25); Add(0.07, 0.25); Add(0.22, 0.5); Add(0.07, 0.75); Add(0.36, 0.75); Add(0.5, 1); Add(0.64, 0.75); Add(0.93, 0.75); Add(0.78, 0.5); Add(0.93, 0.25); Add(0.64, 0.25); PaintPoly end end; procedure TEdPolyDlg.ToolButton12Click(Sender: TObject); // Стандартный полигон — квадрат begin with PolyPoints do begin Clear; Add(0, 0); Add(1, 0); Add(1, 1); Add(0, 1); PaintPoly end end; procedure TEdPolyDlg.DrawMarker(N: Integer; Color: TColor); // Отрисовка N-го маркера в виде квадрата 5х5 var k: Integer; begin with Box.Canvas do begin Pen.Color := Color; for k := 1 to 5 do begin // Центр квадрата определяется координатами PolyPointsI[N] MoveTo(PolyPointsI[N].X — 2, PolyPointsI[N].Y — 3 + k); LineTo(PolyPointsI[N].X + 2, PolyPointsI[N].Y — 3 + k); end end end; procedure TEdPolyDlg.DrawMarkers(Color: TColor); // Отрисовка всех маркеров var k: Integer; begin for k := 1 to PolyCount do DrawMarker(k, Color) end; procedure TEdPolyDlg.BoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); // Отслеживает попадание указателя мыши на маркер и его смещение begin if IsMoved <> 0 thenwith Box.Canvas do // Мышь нажата на маркере? begin // -Да (IsMoved — номер маркера) DrawMarker(IsMoved, Self.Color); // Стираем маркер Pen.Color := Self.Color; // Стираем связанные с ним линии: MoveTo(PolyPointsI[IsMoved].X, PolyPointsI[IsMoved].Y); if IsMoved = PolyCount then LineTo(PolyPointsI[1].X, PolyPointsI[1].Y) else LineTo(PolyPointsI[IsMoved + 1].X, PolyPointsI[IsMoved + 1].Y); MoveTo(PolyPointsI[IsMoved].X, PolyPointsI[IsMoved].Y); if IsMoved = 1 then LineTo(PolyPointsI[PolyCount].X, PolyPointsI[PolyCount].Y) else LineTo(PolyPointsI[IsMoved — 1].X, PolyPointsI[IsMoved — 1].Y); // Новые координаты маркера PolyPointsI[IsMoved].X := X; PolyPointsI[IsMoved].Y := Y; BitBtn3Click(Self) // Освежаем чертеж end else begin // Мышь еще не нажата if IsPoint(X, Y) <> 0 then // Мышь над маркером? Cursor := crHandPoint else // -Да Cursor := crDefault end end; function TEdPolyDlg.IsPoint(X, Y: Integer): Integer; // Проверяет попадание указателя в пределы маркера и // возвращает номер маркера или 0 var k: Integer; begin Result := 0; for k := 1 to PolyCount do if (X >= PolyPointsI[k].X — 2) and (X <= PolyPointsI[k].X + 2) and (Y >= PolyPointsI[k].Y — 2) and (Y <= PolyPointsI[k].Y + 2) then begin // Мышь над маркером Result := k; Break end end; procedure TEdPolyDlg.BoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // Нажатие кнопки мыши над рабочей зоной. Если над маркером, его номер // помещается в поле IsMoved begin IsMoved := IsPoint(X, Y) end; procedure TEdPolyDlg.BoxMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // Отпускание кнопки мыши begin IsMoved := 0 end; procedure TEdPolyDlg.FormShow(Sender: TObject); // Показывает полигон в момент появления окна begin PaintPoly end; procedure TEdPolyDlg.FormCreate(Sender: TObject); // Создает PolyPoints при создании окна begin PolyPoints := TPolygon.Create end; procedure TEdPolyDlg.FormDestroy(Sender: TObject); // Разрушает PolyPoints при разрушении окна begin PolyPoints.Clear; PolyPoints.Free end; end.

Прежде всего, обращу ваше внимание на то, что в форме используется два полигона: Polygon и PolyPoints. В момент создания окна редактор свойства помещает в поле Polygon ссылку на существующий полигон, а поле PolyPoints остается пустым. При первой же отрисовке чертежа это обстоятельство выясняется, и в PolyPoints копируются координаты из поля Polygon. Вся дальнейшая работа идет с полем PolyPoints, а полигон в Polygon сохраняется на случай, если программист откажется от редактирования. Если бы мы не позаботились о дублировании, любые изменения Polygon реализовывались бы фактическими изменениями в динамической памяти, так что отказаться от редактирования было бы невозможно. Если программист закрыл диалог кнопкой ОК, редактор свойства осуществляет соответствующее изменение исходного полигона и лишь затем уничтожает окно.

Потенциально опасное место программы — чтение полигона из файла, так как у программы нет надежных средств контроля типа выбранного файла. Чтобы уменьшить риск чтения данных из не предназначенного для этого файла, предпринят ряд мер. Во-первых, в диалоге Opendialog1 можно выбрать только файлы с расширением pol. Это достаточно редкое расширение, во всяком случае, в реестре моей машины оно не зарегистрировано. Поскольку при сохранении полигона умалчиваемое расширение тоже pol, это уже отсеивает многие неверные файлы. Во-вторых, проверяется размер выбранного файла. Правильный файл содержит только пары вещественных чисел типа Real, а полигон не может иметь менее трех вершин. Отсюда вытекает, что размер файла должен быть кратен Sizeof(Real), количество чисел в нем должно быть четным и не менее шести. Эта проверка реализуется так:

if (PolyCount < 6) or (Odd(PolyCount) = True) or
        (FileSize(F) mod (2 * Sizeof(Real)) <> 0)  then
    // Ошибка!

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

 if IOResult <> 0 then
 // Ошибка!

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

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

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

Свойство Polygon имеет тип TPolygon, который представляет собой модификацию класса TEdit. Этот класс не является потомком TPersistent и поэтому не может регистрироваться.

Выходом из положения является небольшой "обман" Delphi. Вот как он реализован (ниже показаны фрагменты листинга 14.3 с соответствующими комментариями).

Во-первых, в частной секции компонента объявляется фиктивное свойство PolyPoints (не путать с одноименным полем диалогового окна!):

type
  TFarRgnButton = class(TPaintBox)
  private
    FPolyPoints: Real;
    property PolyPoints: Real read FPolyPoints write FPolyPoints;
  .....

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

public
    DefineProperties(Filer: TFiler); override;

procedure  TFarRgnButton.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('PolyPoints', ReadReals, WriteReals, True);
end;

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

procedure TFarRgnButton.ReadReals(Reader: TReader); // Читает полигон из файла формы var X, Y: Real; begin reader.ReadListBegin; // Читаем маркер начала списка FPolygon.Clear; // Удаляем старый полигон while not reader.EndofList. do // Читаем относительные координаты begin X := reader.ReadFloat; Y := reader.ReadFloat; FPolygon.Add(X, Y); // Добавляем новый узел end; reader.ReadListend // Читаем маркер конца списка end; procedure TFarRgnButton.WriteReals(Writer: TWriter); // Записывает полигон в файл формы var k: Integer; begin Writer.WriteListBegin; // Маркер начала списка for K := 0 to FPolygon.Count — 1 do begin // Записываем очередной узел Writer.WriteFloat(FPolygon.GetX(k)); Writer.WriteFloat(FPolygon.GetY(k)); end; Writer.WriteListend // Маркер конца списка end;

object Form1: TForm1 Left = 192 Top = 107 Width = 696 Height = 480 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object FarRgnButton1: TFarRgnButton Left = 80 Top = 40 Width = 90 Height = 89 PolyPoints = ( 0.502325581395348900 0.000000000000000000 0.334883720930232600 0.248000000000000000 0.000000000000000000 0.248000000000000000 0.176744186046511600 0.500000000000000000 0.000000000000000000 0.748000000000000000 0.334883720930232600 0.748000000000000000 0.502325581395348900 1.000000000000000000 0.665116279069767400 0.748000000000000000 1.000000000000000000 0.748000000000000000 0.827906976744186000 0.500000000000000000 1.000000000000000000 0.248000000000000000 0.665116279069767400 0.248000000000000000) end end

Валерий Васильевич Фаронов,
декабрь 2003г.

Отрывок из книги В.В.Фаронова "Искусство создания компонентов для Delphi"
А именно, отрывок из главы 14: "Неоконные визуальные компоненты."

Материал предоставлен автором
специально для публикации на Королевстве Дельфи.

• Исходный код компонента FarRgnButton (278 K) обновление от 12/23/2003 5:20:00 PM