Еше о регионах

Источник: delphikingdom
Юрий Спектор

Автор: Юрий Спектор, Королевство Delphi

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

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

Несколько простых функций

Для начала создадим новый модуль, назовем его ExRegions.pas 

unit ExRegions;

interface

uses Windows, Classes, SysUtils, Graphics;

function CopyRgn(Reg: HRGN): HRGN;
procedure ClipRgn(Reg: HRGN);

implementation

end.

Теперь напишем реализации этих функций:
CopyRgn - Создание копии региона
Эта функция действительно очень проста - всего две строчки кода. Сначала создаем пустой регион, потом объединяем его с копируемым функцией CombineRgn. Но мы все же оформим ее в качестве отдельной функции, отчасти для разогрева, а отчасти оттого, что будем еще неоднократно пользоваться ей. 

// Копия региона Reg
function CopyRgn(Reg: HRGN): HRGN;

begin
  Result:=CreateRectRgn(0,0,0,0);      // Создаем пустой регион
  CombineRgn(Result,Reg,Reg,RGN_COPY); // Комбинируем с исходным с параметром

                                       // RGN_COPY
end;

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

// Обрезание региона по осям координат
procedure ClipRgn(Reg: HRGN);

var
  R: TRect;
  BoxReg: HRGN;
begin
  // Получаем прямоугольник, ограничивающий регион
  GetRgnBox(Reg,R);
  // Создаем регион, в который входит только положительная
  // часть этого прямоугольника
  BoxReg:=CreateRectRgn(0,0,R.Right,R.Bottom);
  // Объединяем его с исходным, используя операцию AND

  CombineRgn(Reg,BoxReg,Reg,RGN_AND);
  // Удаляем ненужный регион BoxReg
  DeleteObject(BoxReg);
end;



Преобразование регионов

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

Function ExtCreateRegion(XForm: PXForm; Count: DWORD;
                         const RgnData: TRgnData): HRGN;
XForm - XForm: указатель на структуру TXForm, задающую преобразование
TXForm = record
    eM11: Single;
    eM12: Single;
    eM21: Single;
    eM22: Single;
    eDx: Single;
    eDy: Single;
end;

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

/ eM11 eM12 0 /  
/ eM21 eM22 0 / 
/ eDx  eDy  1 /
Таким образом, новые координаты точки: 
x' = x * eM11 + y * eM21 + eDx  
y' = x * eM12 + y * eM22 + eDy

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

  • Count: размер в байтах, структуры передаваемой в параметре RgnData.
  • RgnData: указывает на структуру типа TRgnData , которая содержит данные области. Получить их можно с помощью функции GetRegionData
    function GetRegionData(RGN: HRGN; Count: DWORD; PData: PRgnData): DWORD;
    • RGN: идентифицирует регион.
    • Count: размер в байтах, структуры передаваемой в параметре PData.
    • PData: указатель на структуру TRgnData, которая принимает информацию. Если значение этого параметра равно nil, то возвращаемое значение содержит число байт, необходимых для данных области.

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

TransformRgn - произвольная трансформация региона 

interface
. . .
type
  TMatrix = TXForm;
  PMatrix = PXForm;
. . .
procedure TransformRgn(Reg: HRGN; Matrix: PMatrix);
. . .
implementation

. . .
// Произвольная трансформация региона
procedure TransformRgn(Reg: HRGN; Matrix: PMatrix);
var
  Data: Pointer;
  Size: Integer;
  TransReg: HRGN;
begin
  // Получаем размер данных о регионе Reg
  Size:=GetRegionData(Reg,0,nil);
  if Size>0 then begin

    GetMem(Data,Size); // Выделяем память для данных
    // Получаем данные и, если не произошло ошибки, создаем
    // трансформированный регион
    if GetRegionData(Reg,Size,Data)<>0 then begin

      TransReg:=ExtCreateRegion(Matrix,Size,PRgnData(Data)^);
      CombineRgn(Reg,TransReg,TransReg,RGN_COPY);
      DeleteObject(TransReg);
    end;
    FreeMem(Data,Size); // Освобождаем память
  end;
end;
. . .
end.

ScaleRgn - масштабирование региона

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

/ sx   0    0 /  
/ 0    sy   0 / 
/ 0    0    1 /
  • sx - показывает, во сколько регион будет растянут по горизонтали. Если 1, то регион не будет растягиваться, если меньше 1 - то регион сожмется.
  • sy - аналогично, но по вертикали.

interface

. . .
procedure ScaleRgn(Reg: HRGN; sx,sy: Single);
. . .
implementation
. . .
procedure ScaleRgn(Reg: HRGN; sx,sy: Single);
var
  Matrix: TMatrix;
begin
  Matrix.eM11:=sx;
  Matrix.eM12:=0;
  Matrix.eM21:=0;
  Matrix.eM22:=sy;
  Matrix.eDx:=0;
  Matrix.eDy:=0;
  TransformRgn(Reg,@Matrix);

end;
. . .
end.

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

StretchRgn - масштабирование региона таким образом, чтобы он ограничивался прямоугольником Rect, передаваемым в качестве параметра.

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

interface

. . .
procedure StretchRgn(Reg: HRGN; Rect: TRect; Clip: boolean);
. . .
implementation
. . .
procedure StretchRgn(Reg: HRGN; Rect: TRect; Clip: boolean);
var
  RWidth, RHeight, Width, Height: integer;
  R: TRect;
  sx,sy: Single;
begin
  // Если нужно, обрезаем

  if Clip then ClipRgn(Reg);
  // Получаем ширину и высоту региона и прямоугольника Rect
  GetRgnBox(Reg,R);
  RWidth:=R.Right-R.Left; RHeight:=R.Bottom-R.Top;
  Width:=Rect.Right-Rect.Left;
  Height:=Rect.Bottom-Rect.Top;
  // Учитывая полученные размеры, масштабируем регион
  sx:=1; sy:=1;
  if (RWidth<>0) and (RHeight<>0) then begin // На 0 делить нельзя!

    sx:=Width/RWidth;
    sy:=Height/RHeight;
  end;
  ScaleRgn(Reg,sx,sy);
  // И смещаем так, чтобы его левый верхний угол совпал с
  // левым верхним углом прямоугольника Rect
  GetRgnBox(Reg,R);
  OffsetRgn(Reg,Rect.Left-R.Left,Rect.Top-R.Top);
end;
. . .
end.

В файле, прилагаемом к статье вы найдете процедуры 
procedure StretchFillRgn(DC: HDC; Reg: HRGN; Brush: HBrush; Rect: TRect;
  Clip: boolean);
procedure StretchFrameRgn(DC: HDC; Reg: HRGN; Brush: HBrush; Rect: TRect;
  Width: integer; Clip: boolean);

Эти процедуры понадобятся нам далее. Мы не будем рассматривать их реализацию, она очень проста. Сначала вызываем StretchRgn, а потом рисуем регион функциями FillRgn и FrameRgn соответственно.

Создание региона, опираясь на точечный рисунок

Допустим, нам нужно создать какой-то сложный регион. Для этой цели было бы удобно использовать точечный рисунок, цвет левого верхнего пикселя в котором считался бы прозрачным, а точки другого цвета вошли бы в регион. Вообще эта задача типичная, и количество возможных реализаций очень много. Самый очевидный, но не самый лучший способ - это перебор всех точек рисунка и, если их цвет отличен от прозрачного - присоединение к региону с помощью CombineRgn. Еще вариант - записать Path и преобразовать его в регион функцией PathToRegion. Но самый оптимальный (но не самый простой) на мой взгляд вариант - это заполнение TRgnData и создание региона с помощью функции ExtCreateRgn (мы использовали ее для преобразований регионов). Реализация этой идеи была частично позаимствована мной из статьи Антона Григорьева Библиотека компонент FormRgn (создание окон непрямоугольной формы).

Сначала разберемся со структурой TRgnData: 
TRgnData = record

    rdh: TRgnDataHeader;
    Buffer: array[0..0] of CHAR;
    Reserved: array[0..2] of CHAR;

end;
Структура содержит заголовок и массив прямоугольников, которые формируют регион.
  • rdh - Заголовок, имеющий тип TRgnDataHeader
  • Buffer - Собственно, массив прямоугольников
  • Reserved - Не используется
Теперь структура TRgnDataHeader: 
TRgnDataHeader =  record
    dwSize: DWORD;
    iType: DWORD;
    nCount: DWORD;
    nRgnSize: DWORD;
    rcBound: TRect;
end;
  • dwSize: Определяет размер заголовка, в байтах. При заполнении необходимо присвоить значение SizeOf(TRgnDataHeader)
  • iType: Определяет тип области. Эта величина должна быть RDH_RECTANGLES.
  • nCount: Определяет количество прямоугольников, которые создают область.
  • nRgnSize: Определяет размер буфера. Если размер неизвестен, этот элемент может быть нулевым.
  • rcBound: Определяет ограничение размеров области. Также может быть нулевым.
Итак, что нам нужно сделать:
  1. Заполнить заголовок структуры TRgnData
  2. Заполнить буфер структуры TRgnData
  3. С помощью функции ExtCreateRegion создать регион.

И еще немного теории. У класса TBitmap есть свойство ScanLine, которое позволяет получить указатель на произвольную строку в точечном рисунке. Точнее говоря не на строку, а на первую точку в строке. Изменив значение этого указателя, мы можем получить доступ к произвольной точке, чтобы определить ее цвет. Это гораздо эффективнее, чем каждый раз вызывать Canvas.Pixels или GetPixel.

interface
. . .
function CreateRgnFromBitmap(Bitmap: TBitmap): HRGN;
. . .
implementation

. . .
// Создать регион, опираясь на точечный рисунок Bitmap
// Цвет левого верхнего пиксела считается прозрачным.
function CreateRgnFromBitmap(Bitmap: TBitmap): HRGN;
const
// Начальное резервируемое количество прямоугольников в регионе.
// Можно присвоить и другое число.
  dCount = 500;

var
  PLine: Pointer;       // Указатель на строку в рисунке
  PPixel: PLongint;     // Указатель на пиксел в рисунке
  DataMem: PRgnData;    // Здесь будут храниться данные о регионе
  H: THandle;           // Дескриптор области памяти

  MaxRects: DWORD;      // Резервируемое количество прямоугольников в регионе
  X,StartX,FinishX,Y: integer; // Понадобятся при добавлении прямоугольников
  TransColor: TColor;          // Прозрачный цвет
  TransR,TransG,TransB: Byte;  // Значения R, G и B прозрачного цвета
  TempBitmap: TBitmap;         // Временный Bitmap

  // Функция возвращает true, если цвет Pixel совпадает с прозрачным
  function IsTrans(Pixel: Longint): boolean;
  var
    R,G,B: Byte;
  begin
    R:=GetBValue(Pixel);
    G:=GetGValue(Pixel);
    B:=GetRValue(Pixel);
    Result:=(TransR = R) and (TransG = G) and (TransB = B);
  end;
  // Процедура добавляет прямоугольник (StartX, Y, FinishX, Y+1) к региону

  procedure AddRect;
  var
    Rect: PRect;
  begin
    Rect:=@DataMem^.Buffer[DataMem^.rdh.nCount*SizeOf(TRect)];
    SetRect(Rect^,StartX,Y,FinishX,Y+1);
    Inc(DataMem^.rdh.nCount);
  end;
begin

  MaxRects:=dCount;          // Начальное значение MaxRects
  // Определяем прозрачный цвет
  TransColor:=GetPixel(Bitmap.Canvas.Handle,0,0);
  TransR:=GetRValue(TransColor);
  TransG:=GetGValue(TransColor);
  TransB:=GetBValue(TransColor);
  // Формируем временный Bitmap, с которым будем работать
  TempBitmap:=TBitmap.Create;
  TempBitmap.Assign(Bitmap);
  TempBitmap.PixelFormat:=pf24bit;   // 24 бита на пиксель

  // Выделяем память на данные для региона и получаем указатель на нее
  H:=GlobalAlloc(GMEM_MOVEABLE,SizeOf(TRgnDataHeader)+
    SizeOf(TRect)*MaxRects);
  DataMem:=GlobalLock(H);
  // Заполняем заголовок
  // Обнуляем все поля в заголовке
  ZeroMemory(@DataMem^.rdh,SizeOf(TRgnDataHeader));
  DataMem^.rdh.dwSize:=SizeOf(TRgnDataHeader);       // Заполняем поле dwSize
  DataMem^.rdh.iType:=RDH_RECTANGLES;                // Заполняем поле iType

  // Начинаем цикл обхода рисунка по точкам. Будем двигаться слева-направо,
  // сверху-вниз. В переменных X и Y будем хранить текущее значение
  // координат.
  // В переменной StartX - начало нового прямоугольника, FinishX -
  // соответственно конец прямоугольника.
  for Y:=0 to TempBitmap.Height-1 do begin     // Цикл по строкам

    PLine:=TempBitmap.ScanLine[Y];// Получаем указатель на строку
    PPixel:=PLongint(PLine);   // Получаем указатель на первую точку в строке
    X:=0; StartX:=0; FinishX:=0;  // Обнуляем X, StartX, FinishX

    while X<TempBitmap.Width do begin      // Цикл по столбцам
      Inc(X);                    // Увеличиваем текущее значение координаты X
      // Если цвет точки отличен от прозрачного,

      // то надо включить ее в новый прямоугольник
      if not IsTrans(PPixel^) then FinishX:=X
      else begin
    // Цвет точки равен прозрачному. Значит нужно завершить формирование

    // прямоугольника, если он не пустой, то добавить его к региону и начать
    // формирование нового прямоугольника. Если количество прямоугольников
    // в регионе достигло MaxRects, то увеличиваем MaxRects на dCount, и
    // выделяем память под данные о регионе заново
        if DataMem^.rdh.nCount>=MaxRects then

        begin
          Inc(MaxRects,dCount);
          GlobalUnlock(H);
          H:=GlobalReAlloc(H,SizeOf(TRgnDataHeader)+SizeOf(TRect)*MaxRects,
            GMEM_MOVEABLE);
          DataMem:=GlobalLock(H);
        end;
        // Если прямоугольник не пустой, добавляем его к региону
        if FinishX>StartX then AddRect;
        // Устанавливаем значения StartX, FinishX для формирования нового

        // прямоугольника
        StartX:=X;
        FinishX:=X;
      end;
      Inc(PByte(PPixel),3); // Получаем указатель не следующую точку рисунка
    end;
  // Возможен следующий случай: если цвет последней точки в строке не равен
  // прозрачному, то FinishX будет больше, чем StartX, однако прямоугольник

  // не будет добавлен к региону, так так добавление нового прямоугольника
  // происходит только если встретился прозрачный пиксель. Это нужно учесть.
    if FinishX>StartX then AddRect;
  end;
  // Временный Bitmap больше не нужен

  TempBitmap.Free;
  try
    // Формируем регион по данным из DataMem^
    Result:=ExtCreateRegion(nil,SizeOf(TRgnDataHeader)+
      SizeOf(TRect)*DataMem^.rdh.nCount,DataMem^);
  finally
    GlobalFree(H); // Освобождаем выделенную память

  end;
end;
. . .
end.

Класс TRegion

Ну вот мы и подошли к самому главному. Теперь мы создадим класс-оболочку над регионом. Он будет потомком абстрактного класса TGraphic, как и битмап, иконка и метафайл. Это даст нам возможность связать TRegion с классом TPicture, а это, в свою очередь, позволит нам рисовать изображение региона на элементе Image, загружать регион с помощью стандартного диалога TOpenPictureDialog. Кроме того, если свойство какого-либо Вашего компонента будет иметь тип TRegion, оно правильно сохранится и загрузится из dfm-файла.

Реализация нашего класса будет во многом схожа с реализацией класса TIcon из модуля Graphics.pas.

Свойства Empty, Modified, Transparent, Width, Height

Класс TGraphic, как уже было сказано, является абстрактным. Чтобы создать полноправного потомка этого класса, необходимо перекрыть все его абстрактные методы.

TGraphic = class(TInterfacedPersistent, IStreamPersist)
private
  FOnChange: TNotifyEvent;
  FOnProgress: TProgressEvent;
  FModified: Boolean;
  FTransparent: Boolean;
  FPaletteModified: Boolean;
  procedure SetModified(Value: Boolean);
protected
  procedure Changed(Sender: TObject); virtual;
  procedure DefineProperties(Filer: TFiler); override;
  procedure Draw(ACanvas: TCanvas; const Rect: TRect); virtual; abstract;
  function Equals(Graphic: TGraphic): Boolean; virtual;
  function GetEmpty: Boolean; virtual; abstract;
  function GetHeight: Integer; virtual; abstract;
  function GetPalette: HPALETTE; virtual;
  function GetTransparent: Boolean; virtual;
  function GetWidth: Integer; virtual; abstract;
  procedure Progress(Sender: TObject; Stage: TProgressStage;
    PercentDone: Byte;  RedrawNow: Boolean; const R: TRect;
    const Msg: string); dynamic;
  procedure ReadData(Stream: TStream); virtual;
  procedure SetHeight(Value: Integer); virtual; abstract;
  procedure SetPalette(Value: HPALETTE); virtual;
  procedure SetTransparent(Value: Boolean); virtual;
  procedure SetWidth(Value: Integer); virtual; abstract;
  procedure WriteData(Stream: TStream); virtual;

public
  constructor Create; virtual;
  procedure LoadFromFile(const Filename: string); virtual;
  procedure SaveToFile(const Filename: string); virtual;
  procedure LoadFromStream(Stream: TStream); virtual; abstract;
  procedure SaveToStream(Stream: TStream); virtual; abstract;
  procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
    APalette: HPALETTE); virtual; abstract;
  procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
    var APalette: HPALETTE); virtual; abstract;
  property Empty: Boolean read GetEmpty;
  property Height: Integer read GetHeight write SetHeight;
  property Modified: Boolean read FModified write SetModified;
  property Palette: HPALETTE read GetPalette write SetPalette;
  property PaletteModified: Boolean read FPaletteModified write FPaletteModified;
  property Transparent: Boolean read GetTransparent write SetTransparent;
  property Width: Integer read GetWidth write SetWidth;
  property OnChange: TNotifyEvent read FOnChange write FOnChange;
  property OnProgress: TProgressEvent read FOnProgress write FOnProgress;

end;

Посмотрите внимательно на свойства Empty (пустой), Width (ширина), Height (высота). Методы для установки и получения этих свойств - абстрактные. Кроме того методы GetTransparent и SetTransparent, с учетом того, что регион всегда прозрачен, мы также перекроем. Кроме того, вы еще обратили внимание на свойства Palette и Modified. Свойство Palette (палитра) нам не понадобится, а всю работу со свойством Modified (изменен), класс TGraphic организует сам.

Обратите еще внимание на метод Changed. 

procedure TGraphic.Changed(Sender: TObject);
begin
  FModified := True;
  if Assigned(FOnChange) then FOnChange(Self);

end;

Этот метод мы будем вызывать в том случае, если после создания, объект класса TRegion был изменен.

interface
. . .
const
  // Сообщения об ошибках
  SChangeRegionSize = 'Cannot change the size of a region';
. . .

type
. . .
TRegion = class(TGraphic)
protected
  function GetEmpty: Boolean; override;
  function GetHeight: Integer; override;
  function GetWidth: Integer; override;
  function GetTransparent: Boolean; override;
  procedure SetHeight(Value: Integer); override;
  procedure SetTransparent(Value: Boolean); override;
  procedure SetWidth(Value: Integer); override;

end.
. . .
implementation
. . .
function TRegion.GetEmpty: Boolean;
begin
  // Свойство Handle рассмотрим ниже
  Result:=Handle = 0; // Пустой, если ни на что не ссылается

end;

function TRegion.GetHeight: Integer;
var
  R: TRect;
begin
  Result:=0;
  if Handle<>0 then begin

    // Получаем прямоугольник, ограничивающий регион
    GetRgnBox(Handle,R);
    // Его нижний край + 1 и есть высота.
    Result:=R.Bottom+1;
  end;
end;

function TRegion.GetWidth: Integer;

var
  R: TRect;
Begin
  // Все аналогично
  Result:=0;
  if Handle<>0 then begin

    GetRgnBox(Handle,R);
    Result:=R.Right+1;
  end;
end;

function TRegion.GetTransparent: Boolean;
begin
  Result:=true; // Регион всегда прозрачен

end;

procedure TRegion.SetHeight(Value: Integer);
begin
  // Нельзя изменить размеры региона!
  raise EInvalidGraphicOperation.Create(SChangeRegionSize);
end;

procedure TRegion.SetTransparent(Value: Boolean);

begin
  // Свойство Transparent нельзя изменить
  // Регион всегда прозрачен
end;

procedure TRegion.SetWidth(Value: Integer);
begin
  // Нельзя изменить размеры региона!

  raise EInvalidGraphicOperation.Create(SChangeRegionSize);
end;
. . .
end.

Кэширование

Этот механизм позволяет нескольким объектам ссылаться на один и тот же, реально существующий в системе. Свойство Handle у таких объектов будет идентично. Реализуется такое связывание через метод Assign:

Bitmap1.Assign(Bitmap2); // Bitmap1 и Bitmap2 разделяют один и тот же растр.

Стандартные потомки TGraphic, такие как TIcon, TBitmap и TMetafile имеют свои системы кэширования. В нашем случае, это не имеет большого практического смысла, так как регион, обычно, в памяти занимает гораздо меньше места, чем битмап или метафайл, да и использоваться будет реже. Но мы все равно рассмотрим этот механизм, так как идея подсчета ссылок, на которой он основывается, используется повсеместно (DLL, технология COM, длинные строки и т.д.)

Упрощенно идея заключается в следующем: Если объекта еще нет в памяти, то создаем его, а счетчик ссылок на него устанавливаем в 1. При копировании объекта методом Assign, увеличиваем счетчик ссылок на 1, а при уничтожении экземпляра класса, который на него ссылается - уменьшаем на 1. Если число ссылок стало равным 0 (и только в этом случае!!!) - уничтожаем объект и освобождаем выделенную под него память.

Для реализации этого механизма, в модуле Graphics.pas объявлен класс: 

TSharedImage = class
private

  FRefCount: Integer;
protected
  procedure Reference; // Увеличивает счетчик ссылок на 1
  // Уменьшает счетчик ссылок на 1 и вызывает FreeHandle, если их стало 0.
  procedure Release;
  // Удаляет объект из памяти, нужно перекрыть в потомках.

  procedure FreeHandle; virtual; abstract;
  property RefCount: Integer read FRefCount; // Счетчик ссылок
end;

Создадим потомка, в котором введем поле FHandle, для хранения дескриптора региона, и перекроем метод FreeHandle. Методы Reference и Release перекрывать не нужно:

interface
. . .
TRegionImage = class(TSharedImage)
private
  FHandle: HRGN;
protected

  procedure FreeHandle; override;
end;
. . .
implementation
. . .
procedure TRegionImage.FreeHandle;
begin
  // Удаляем регион FHandle.

  if FHandle<>0 then begin
    DeleteObject(FHandle);
    FHandle:=0;
  end;
end;
. . .

end.

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

interface
. . .
TRegion = class(TGraphic)
private
  FImage: TRegionImage; // Ссылается на реальный объект в памяти

  FBrush: TBrush;
  FFrame: boolean;
  function GetHandle: HRGN;
  procedure SetHandle(const Value: HRGN);
  // После выполнения метода NewRegion, наш класс будет ссылаться на реальный
  // объект Reg. Метод объявлен в разделе private, т.е. только для
  // внутреннего использования.

  procedure NewRegion(Reg: HRGN);
protected
  . . .
public
  constructor Create; override;
  destructor Destroy; override;
  procedure Assign(Source: TPersistent); override;
  property Handle: HRGN read GetHandle write SetHandle;
  // Следующие свойства будут использоваться для рисования региона

  property Brush: TBrush read FBrush write FBrush;
  property Frame: boolean read FFrame write FFrame;

end;
. . .
implementation
. . .
constructor TRegion.Create;
begin
  inherited Create;
  // Создаем объект типа TRegionImage, увеличиваем число ссылок на него,
  // устанавливаем FHandle в 0.

  FImage:=TRegionImage.Create;
  FImage.Reference;
  FImage.FHandle:=0;
  // Создаем кисть и задаем параметры по умолчанию
  FBrush:=TBrush.Create;
  FBrush.Color:=clBlack;
  FBrush.Style:=bsDiagCross;
  FFrame:=true;
end;

destructor TRegion.Destroy;
begin
  FBrush.Free;
  // Именно FImage.Release, а не FImage.Free, так как на него могут ссылаться

  // другие экземпляры класса TRegion
  FImage.Release;
  inherited Destroy;
end;

procedure NewRegion(Reg: HRGN);
var
  Region: TRegionImage;

begin
  // Создаем новый объект типа TRegionImage, увеличиваем число ссылок и
  // устанавливаем FHandle
  Region:=TRegionImage.Create;
  Region.FHandle:=Reg;
  Region.Reference;
  // Уменьшаем число ссылок на предыдущий объект
  FImage.Release;
  // Теперь экземпляр класса ссылается на новый регион с дескриптором Reg
  FImage:=Region;

end;

procedure TRegion.SetHandle(const Value: HRGN);
begin
  // Заставляем наш объект ссылаться на новый TRegionImage
  NewRegion(Value);
  Changed(Self);
end;


function TRegion.GetHandle: HRGN;
begin
  Result:=FImage.FHandle; // Тут все понятно
end;

procedure TRegion.Assign(Source: TPersistent);
begin
  // Если копируется другой регион или nil

  if (Source is TRegion) or (Source = nil) then begin
    // Если копируется другой регион

    if (Source <> nil) then begin
      // Увеличиваем число ссылок у источника
      TRegion(Source).FImage.Reference;
      // Уменьшаем число ссылок у приемника и заставляем приемник ссылаться

      // на источник
      FImage.Release;
      FImage:=TRegion(Source).FImage;
      // Копируем остальные поля
      Brush.Assign((Source as TRegion).Brush);
      Frame:=(Source as TRegion).Frame;
    end

    else
      // Если копируется nil, то наш объект не будет ссылаться ни на что
      NewRegion(0);
    Changed(Self);
  end
  // Если копируется экземпляр другого класса, то вызываем метод предка
  else inherited Assign(Source);

end;
. . .
end.

Сохранение в поток и в файл, поток, dfm-файл

Для этого в классе TGraphic предусмотрены методы DefineProperties, ReadData, WriteData, LoadFromStream, SaveToStream, LoadFromFile, SaveToFile.

В нашем классе мы перекроем все методы, кроме SaveToFile, LoadToFile и DefineProperties, поэтому их реализацию в классе TGraphic мы сейчас рассмотрим.

procedure TGraphic.DefineProperties(Filer: TFiler);

  function DoWrite: Boolean;
  begin

    if Filer.Ancestor <> nil then
      Result := not (Filer.Ancestor is TGraphic) or

        not Equals(TGraphic(Filer.Ancestor))
    else
      Result := not Empty;
  end;

begin
  Filer.DefineBinaryProperty('Data', ReadData, WriteData, DoWrite);

end;

Этот метод нужен для сохранения данных об объекте в dfm-файл. Это позволит нам, при создании собственных компонент, задавать в design-time свойства типа TRegion. Не пугайтесь, если в вышеприведенном коде много незнакомого. Самое главное это то, что запись свойств производится методом WriteData, а чтение - ReadData. А сами методы мы еще напишем.

procedure TGraphic.LoadFromFile(const Filename: string);
var

  Stream: TStream;
begin
  Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;

end;

procedure TGraphic.SaveToFile(const Filename: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(Filename, fmCreate);
  try

    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

Тут все проще - запись в файл - это запись в поток, чтение из файла - чтение из потока. Вот только методы SaveToStream и LoadFromStream - абстрактные.

Подведем итоги: нам нужно перекрыть методы ReadData, WriteData, LoadFromStream и SaveToStream. 

interface
. . .
TRegion = class(TGraphic)
private
. . .
  // Именно эти два метода будут работать с потоками
  // Остальные - только вызывать их.
  procedure ReadStream(Stream: TStream; Size: Longint);
  procedure WriteStream(Stream: TStream; WriteSize: Boolean);

protected
. . .
  procedure ReadData(Stream: TStream); override;
  procedure WriteData(Stream: TStream); override;
public
. . .
  procedure LoadFromStream(Stream: TStream); override;
  procedure SaveToStream(Stream: TStream); override;

end.

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

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

interface
. . .
const
. . .
  CapSize = 6;
. . .

type
. . .
THeaderCaption = array[1..CapSize] of Char;
TRegionHeader = record
  Caption: THeaderCaption;
  Size: Integer;
end;
. . .
const

  HeaderCaption: THeaderCaption = 'Region';
. . .
implementation
. . .
procedure TRegion.ReadStream(Stream: TStream; Size: Integer);
var
  Header: TRegionHeader;
  Buf: Pointer;
  FSize: DWORD;
begin
  if Size>0 then begin

    // Читаем заголовок
    Stream.ReadBuffer(Header,SizeOf(Header));
    FSize:=Header.Size;
    // Если заголовок соответствует файлу региона и размер данных больше 0
    if (Header.Caption = HeaderCaption) and (FSize>0) then begin

      // Создаем регион, опираясь на эти данные.
      GetMem(Buf,FSize);
      Stream.ReadBuffer(Buf^,FSize);
      try
        Handle:=ExtCreateRegion(nil,FSize,PRgnData(Buf)^);
      finally
        FreeMem(Buf,FSize);
      end;
    end;
  end;

end;

procedure TRegion.WriteStream(Stream: TStream; WriteSize: Boolean);
var
  Header: TRegionHeader;
  WSize, Size: DWORD;
  Buf: Pointer;
begin
  if Handle<>0 then begin

    // Заполняем заголовок файла
    Header.Caption:=HeaderCaption;
    Size:=GetRegionData(Handle,0,nil);
    if Size>0 then begin

      Header.Size:=Size;
      // Получаем данные о регионе
      GetMem(Buf,Size);
      GetRegionData(Handle,Size,PRgnData(Buf));
      // Если нужно, сначала записываем длину заголовка+данных
      // Так мы будем записывать в dfm-файл, чтобы потом легко их прочитать
      if WriteSize then begin

        WSize:=DWORD(SizeOf(Header)+Size);
        Stream.WriteBuffer(WSize,SizeOf(DWORD));
      end;
      // Записываем заголовок и данные
      Stream.WriteBuffer(Header,SizeOf(Header));
      Stream.WriteBuffer(Buf^,Size);
      FreeMem(Buf,Size);
    end;
  end;
end;

procedure TRegion.ReadData(Stream: TStream);

var
  Size: DWORD;
Begin
  // Чтение данных из dfm-файла. Сначала размер, потом все остальное
  Stream.ReadBuffer(Size,SizeOf(DWORD));
  ReadStream(Stream,Size);
end;

procedure TRegion.WriteData(Stream: TStream);
begin

  // Запись в dfm-файл данных и размер данных + заголок
  WriteStream(Stream,true);
end;

procedure TRegion.LoadFromStream(Stream: TStream);
begin
  // Читаем данные с текущей позиции
  ReadStream(Stream, Stream.Size - Stream.Position);

end;

procedure TRegion.SaveToStream(Stream: TStream);
begin
  // Записываем данные с текущей позиции.
  // Размер заголовка + данных не записываем
  WriteStream(Stream, False);
end;
. . .

end.

Еще несколько методов

interface
. . .
const
. . .
  SRegionToClipboard = 'Clipboard does not support Regions';
. . .
type

. . .
  TRegion = class(TGraphic)
  . . .
  protected
  . . .
    procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  public

  . . .
    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
      APalette: HPALETTE); override;
    procedure SaveToClipboardFormat(var Format: Word; var Data: THandle;
      var APalette: HPALETTE); override;
    procedure ImportFromBitmap(Bitmap: TBitmap);
  end.

Метод Draw - масштабирует и рисует регион на канве. Метод ImportFromBitmap, как несложно догадаться, создает регион из точечного рисунка и заставляет наш объект ссылаться на него. Остальные методы дают возможность (а точнее, не дают, но Вы можете это исправить) работать нашему объекту с буфером обмена. 

implementation
. . .
procedure TRegion.Draw(ACanvas: TCanvas; const Rect: TRect);
var

  BlackBrush: HBrush;
Begin
  // Масштабируем и рисуем регион кистью Brush
  StretchFillRgn(ACanvas.Handle,Handle,Brush.Handle,Rect,true);
  // Если нужно, рисуем контур региона черной кистью
  if Frame then begin

    BlackBrush:=GetStockObject(Black_Brush);
    StretchFrameRgn(ACanvas.Handle,Handle,BlackBrush,Rect,1,true);
  end;
end;

procedure TRegion.ImportFromBitmap(Bitmap: TBitmap);
begin
  Handle:=CreateRgnFromBitmap(Bitmap);
end;


procedure TRegion.LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  APalette: HPALETTE);
begin
  raise EInvalidGraphicOperation.Create(SRegionToClipboard);
end;

procedure TRegion.SaveToClipboardFormat(var Format: Word;
  var Data: THandle; var APalette: HPALETTE);

begin
  raise EInvalidGraphicOperation.Create(SRegionToClipboard);
end;
. . .
end.

Регистрация нового формата

Теперь осталось только сделать так, чтобы в объект класса TPicture можно было поместить нашу картинку-регион.

interface
. . .
const
. . .
  SVRegions = 'Regions';
. . .
initialization
  TPicture.RegisterFileFormat('rgn',SVRegions,TRegion);

finalization

  TPicture.UnregisterGraphicClass(TRegion);
end.

Вот и все! Теперь Вы можете:
  1. Импортировать регионы из точечных рисунков
  2. Хранить регионы в файлах, ресурсах
  3. Создавать свои компоненты со свойствами типа TRegion
  4. Открывать файл регионов с помощью диалога TOpenPictureDialog
  5. Рисовать регион на канве методом Draw
  6. Загружать картинку-регион в TImage.

В прилагаемом к статье архиве, Вы сможете найти модуль ExRegions.pas, программу, демонстрирующую его работу и несколько файлов *.rgn.


Страница сайта http://185.71.96.61
Оригинал находится по адресу http://185.71.96.61/home.asp?artId=21746