Юрий Спектор
дата публикации 18-11-2005 05:34

---

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

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

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

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 мы разберемся чуть позже, пока она нам не потребуется. Главное это то, что в ней содержится вся необходимая информация о регионе.

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.

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

| 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.

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

А теперь усложним задачу. Следующая процедура будет не просто масштабировать регион, а подгонять его размер таким образом, чтобы он ограничивался указанным в качестве параметра прямоугольником. Кроме того, в случае необходимости, перед преобразованием будем обрезать его процедурой 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 = record
    rdh: TRgnDataHeader;
    Buffer: array[0..0] of CHAR;
    Reserved: array[0..2] of CHAR;
end;

• rdh - Заголовок, имеющий тип TRgnDataHeader
• Buffer - Собственно, массив прямоугольников
• Reserved - Не используется

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.

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

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

Класс 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 организует сам.

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 (и только в этом случае!!!) - уничтожаем объект и освобождаем выделенную под него память.

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.

Для этого в классе 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 - абстрактные.

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.

• Исходный код ExRegions.pas (7 K) обновление от 11/18/2005 5:34:00 AM
• Демонстрационный пример (186 K) обновление от 11/18/2005 5:34:00 AM