Создание непрямоугольных форм в Delphi

Источник: delphi

Немного о непрямоугольных формах... Кажется, весь мир сошёл с ума по таким формам; все форумы пестрят вопросами на эту тему Есть ли сложности при создании непрямоугольной формы? Нет... Почти... Дело в том, что задать внешний вид формы можно, вызвав всего лишь одну функцию SetWindowsRgn.

SetWindowsRgn(Form1.Handle, True);

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

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

Для создания регионов существуют такие функции (с очевидным назначением), как CreateRectRgn, CreateEllipticRgn, CreatePolygonRgn и несколько других. Объединять регионы между собой можно при помощи функции CombineRgn.

На этом теоретическая часть могла бы быть закончена, если бы не одно "но"... Это "но" я процитирую отдельно...

Но ведь чаще всего непрямоугольную форму требуется построить на базе растровой картинки, задав для неё прозрачный цвет! Как быть?

Это правда. Насколько мне известно, Windows не умеет этого делать, то есть в ней нет функции CreateBitmapRgn. Тем не менее, можно создавать и такие регионы. Для этого необходимо пробежаться по всей картинке сверху вниз, в каждой строчке найти непрозрачные области и сделать из них прямоугольные регионы (эти прямоугольники будут высотой в 1 пиксель). Затем мы объединяем эти регионы - и, вуаля - вот он, искомый регион!

Готов поспорить, вы думаете, что это слишком сложно... Проверяем...

function BitmapToRegion(Bitmap: TBitmap; TransColor: TColor): HRGN;
var
X, Y: Integer;
XStart: Integer;
begin
Result := 0;
with Bitmap do
for Y := 0 to Height - 1 do
begin
X := 0;
while X < Width do
begin
// Пропускаем прозрачные точки
while (X < Width) and (Canvas.Pixels[X, Y] = TransColor) do
Inc(X);
if X >= Width then
Break;
XStart := X;
// Пропускаем непрозрачные точки
while (X < Width) and (Canvas.Pixels[X, Y] <> TransColor) do
Inc(X);
// Создаём новый прямоугольный регион и добавляем его к
// региону всей картинки
if Result = 0 then
Result := CreateRectRgn(XStart, Y, X, Y + 1)
else
CombineRgn(Result, Result,
CreateRectRgn(XStart, Y, X, Y + 1), RGN_OR);
end;
end;
end;

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

type
TFormMain = class(TForm)
private
{ Private declarations }
procedure WMLButtonDown(var Msg: TMessage); message WM_LBUTTONDOWN;
public
{ Public declarations }
end;

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

procedure TFormMain.WMLButtonDown(var Msg: TMessage);
begin
Perform(WM_NCLBUTTONDOWN, HTCAPTION, Msg.LParam);
end;

Форма посылает самой себе сообщение WM_NCLBUTTONDOWN с wParam равным HTCAPTION, то есть эмулирует ситуацию, когда пользователь нажимает левую кнопку мыши на заголовке формы. После этого форму можно спокойно перемещать за всю её область.

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

Ссылки по теме