Delphi 7 : Использование hRgn

[hexor_boo]

Есть изображение 9-конечной звезды на белом фоне (изображение прикрепляю). Нужно сделать из неё регион и обрезать по ней форму.

Такой код не работает:

procedure TfrmMain.btnGetRgnClick(Sender: TObject);
var
 X          : Integer;
 Y          : Integer;
 X1         : Integer;
 Y1         : Integer;
 X2         : Integer;
 Y2         : Integer;
 RgnDest    : HRGN;
 Rgn1       : HRGN;
 Rgn2       : HRGN;
begin
 Rgn1:=0;

  For Y:=0 To imgStar.Height-1 Do
   Begin
     For X:=0 To imgStar.Width-1 Do
      Begin
        If (imgStar.Canvas.Pixels[X, Y]<>clWhite) Then
         Begin
          X1:=X;
          Y1:=Y;
          X2:=X;
          Y2:=Y;
          Rgn2:=CreateRectRgn(X1, Y1, X2, Y2);
          CombineRgn(RgnDest, Rgn1, Rgn2, rgn_Or);
          Rgn1:=RgnDest;
         End;
      End;
   End;

  Try
   SetWindowRgn(Handle, RgnDest, True);
  Finally
   DeleteObject(RgnDest);
  End;

end;

А обрезка под эллипс работает прекрасно:

procedure TfrmMain.btnCircleClick(Sender: TObject);
var
  r: hRGN;
begin
  r := CreateEllipticRgn (0, 0, Width, Height);
  try
    SetWindowRgn (Handle, r, TRUE);
  finally
    DeleteObject (r);
  end;
end;

Где ошибка в первой части кода?

[macomics]

Ошибка в том, что вы перебираете пиксели. Но если посмотрите на значения переменных (X1, Y1) => (X2, Y2) в отладчике, тогда поймёте, что они каждый раз выбирают пустую область (X1 = X2 и Y1 = Y2). В этой области нет ни одного пикселя.

Вам нужно задавать область хотя бы X1 = X, Y1 = Y, X2 = X + 1, Y2 = Y + 1

Но если вы хотите сделать форму произвольной по картинке, тогда лучше сделать не регион, а выставить цвет прозрачности (TransparentColorKey) и включить обработку LayeredWindow (AlphaBlend)

[hexor_boo]

procedure TfrmMain.btnGetRgnClick(Sender: TObject);
var
 X          : Integer;
 Y          : Integer;
 X1         : Integer;
 Y1         : Integer;
 X2         : Integer;
 Y2         : Integer;
 RgnDest    : HRGN;
 Rgn1       : HRGN;
 Rgn2       : HRGN;
begin
 Rgn1:=0;

  For Y:=0 To imgStar.Height-2 Do
   Begin
     For X:=0 To imgStar.Width-2 Do
      Begin
        If (imgStar.Canvas.Pixels[X, Y]<>clWhite) Then
         Begin
          X1:=X;
          Y1:=Y;
          X2:=X+1;
          Y2:=Y+1;
          Rgn2:=CreateRectRgn(X1, Y1, X2, Y2);
          CombineRgn(RgnDest, Rgn1, Rgn2, rgn_Or);
          Rgn1:=RgnDest;
         End;
      End;
   End;

  Try
   SetWindowRgn(Handle, RgnDest, True);
  Finally
   DeleteObject(RgnDest);
  End;

end;

Так тоже не работает

[hexor_boo]

Может быть связано с тем, что где-то по координатам я вылетаю за пределы рисунка?
* Я уже готов получить результат с грубой погрешностью, лишь отдалённо напоминающий решение. Чтобы понять общий смысл.

[macomics]

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

Вот вам работающий пример

[macomics]

Ещё лучше создавать сразу CreatePolygonRgn по точкам 9-ти конечной звезды, а не соединять эти прямоугольные области. Ещё вы не удаляете объединённые регионы. А ещё в описании функции CombineRgn сказано, что RgnDest должен существовать до объединения.

https://learn.microsoft.com/en-us/wi...gdi-combinergn

[in] hrgnDst

A handle to a new region with dimensions defined by combining two other regions. (This region must exist before CombineRgn is called.)

[hexor_boo]

Сообщение от macomics

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

А как их у звезды-то вычислять? Я понимаю что звезду можно представить с большим количеством вписанных в неё прямоугольников, вот только как это описать кодом и с какого места начинать вычисления непонятно. Самое разумное. что приходило в голову - разбивка звезды на строки выcотой в 1px - вы это имели ввиду?

Вот вам работающий пример

Супер! До такого варианта сам не додумался бы. Респект! А то упёрся в то, что обязательно регионом нужно сделать.

[macomics]

Сообщение от hexor_boo

разбивка звезды на строки выcотой в 1px - вы это имели ввиду?

да

Сообщение от hexor_boo

Супер! До такого варианта сам не додумался бы. Респект! А то упёрся в то, что обязательно регионом нужно сделать.

Вообще регионы это довольно медленная штука пришедшая ещё из 9х пока не появились Layered окна. Теперь все проще сделать через них. Только цвет для прозрачности выберите другой. Белый - не самый лучший выбор. Дочерние окна того же цвета тоже будут становиться прозрачными.

[hexor_boo]

Ура! Задача с помощью регионов решена!

procedure TfrmMain.btnGetRgnClick(Sender: TObject);
var
 X          : Integer;
 Y          : Integer;
 X1         : Integer;
 Y1         : Integer;
 X2         : Integer;
 Y2         : Integer;
 RgnDest    : HRGN;
 Rgn2       : HRGN;
begin
 RgnDest:=0;

  For Y:=0 To imgStar.Height-1 Do
   Begin
     For X:=0 To imgStar.Width-1 Do
      Begin
        If (imgStar.Canvas.Pixels[X, Y]<>clWhite) Then
         Begin
          X1:=X;
          Y1:=Y;
          X2:=X1+1;
          Y2:=Y1+1;
           If (RgnDest=0) Then
            Begin
             RgnDest:=CreateRectRgn(X1, Y1, X2, Y2);
            End
           Else
            Begin
             Rgn2:=CreateRectRgn(X1, Y1, X2, Y2);
             CombineRgn(RgnDest, RgnDest, Rgn2, rgn_Or);
             DeleteObject(Rgn2);
            End;
         End;
      End;
   End;

  Try
   SetWindowRgn(Handle, RgnDest, True);
  Finally
   DeleteObject(RgnDest);
  End;

end;

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

[macomics]

Вот вам ещё одна подсказка. Если сначала создадите

with ClientRect do CreateRectRgn(Left, Top, Right, Bottom);

А потом будете удалять из него пиксели совмещая регионы функцией RGN_XOR, тогда не понадобится проверок на существование в региона в циклах.

procedure TfrmMain.btnGetRgnClick(Sender: TObject);
var
 X          : Integer;
 Y          : Integer;
 RgnDest    : HRGN;
 Rgn2       : HRGN;
begin
   with imgStar.ClientRect do CreateRectRgn(Left, Top, Right, Bottom);
   For Y:=0 To imgStar.Height-1 Do
     For X:=0 To imgStar.Width-1 Do
      Begin
        If (imgStar.Canvas.Pixels[X, Y]<>clBlack) Then
        Begin
          Rgn2:=CreateRectRgn(X, Y, X + 1, Y + 1);
          CombineRgn(RgnDest, RgnDest, Rgn2, RGN_XOR);
          DeleteObject(Rgn2);
       End;
   End;
  Try
   SetWindowRgn(Handle, RgnDest, True);
  Finally
   DeleteObject(RgnDest);
  End;
end;

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