Как создавать не квадратные формы и контролы

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Всё, что нам нужно, это HRGN и дескриптор (handle) элемента управления. SetWindowRgn имеет три параметра: дескриптор окна, которое будем менять, дескритор региона и булевый (boolean) параметр, который указывает — перерисовывать или нет после изменения. Как только у нас есть дескриптор и регион, то можно вызвать SetWindowRgn(Handle, Region, True) и вуаля!

Заметьте, что Вы не должны освобождать регион при помощи DeleteObject, так как после вызова SetWindowRgn владельцем региона становится операционная система.

function BitmapToRgn(Image: TBitmap): HRGN;

var

TmpRgn: HRGN;

x, y: integer;

ConsecutivePixels: integer;

CurrentPixel: TColor;

CreatedRgns: integer;

CurrentColor: TColor;

begin

CreatedRgns := 0;

Result := CreateRectRgn(0, 0, Image.Width, Image.Height);

inc(CreatedRgns);

if (Image.Width = 0) or (Image.Height = 0) then

exit;

for y := 0 to Image.Height — 1 do

begin

CurrentColor := Image.Canvas.Pixels[0,y];

ConsecutivePixels := 1;

for x := 0 to Image.Width — 1 do

begin

CurrentPixel := Image.Canvas.Pixels[x, y];

if CurrentColor = CurrentPixel then

inc(ConsecutivePixels)

else

begin

// Входим в новую зону

if CurrentColor = clWhite then

begin

TmpRgn := CreateRectRgn(x — ConsecutivePixels, y, x, y 1);

CombineRgn(Result, Result, TmpRgn, RGN_DIFF);

inc(CreatedRgns);

DeleteObject(TmpRgn);

end;

CurrentColor := CurrentPixel;

ConsecutivePixels := 1;

end;

end;

if (CurrentColor = clWhite) and (ConsecutivePixels > 0) then

begin

TmpRgn := CreateRectRgn(x-ConsecutivePixels, y, x, y 1);

CombineRgn(Result, Result, TmpRgn, RGN_DIFF);

inc(CreatedRgns);

DeleteObject(TmpRgn);

end;

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

MaskBmp: TBitmap;

begin

MaskBmp := TBitmap.Create;

try

MaskBmp.LoadFromFile(‘c:\Мои документы\DW.bmp’);

Height := MaskBmp.Height;

Width := MaskBmp.Width;

// ОС владеет регионом, после вызова SetWindowRgn

SetWindowRgn(Self.Handle, BitmapToRgn(MaskBmp), True);

finally

MaskBmp.Free;

end;

end;

{/codecitation}

Добавить комментарий