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

[hexor_boo]

А если так?

procedure TfrmMain.btnGetRgnClick(Sender: TObject);
var
 X                   : Integer;
 Y                   : Integer;
 X1                  : Integer;
 Y1                  : Integer;
 X2                  : Integer;
 Y2                  : Integer;
 RgnDest             : HRGN;
 Rgn2                : HRGN;
 XCount              : Integer;
 XStart              : Integer;
 XIsNotWhiteBegin    : Boolean;
 XIsNotWhiteContinue : Boolean;
begin
 RgnDest:=CreateRectRgn(0, 0, 0, 0);

 X:=0;
 Y:=0;
 X1:=0;
 X2:=0;
 Y1:=0;
 Y2:=0;
 
  For Y:=0 To imgStar.Height-1 Do
   Begin

    XCount:=0;

     For X:=0 To imgStar.Width-1 Do
      Begin

        If (imgStar.Canvas.Pixels[X, Y]<>clWhite) Then
         Begin
          XIsNotWhiteBegin:=True;
         End
        Else
         Begin
          XIsNotWhiteBegin:=False;
          XIsNotWhiteContinue:=False;
          XCount:=0;
         End;

        If XIsNotWhiteBegin Then
         Begin
          XIsNotWhiteBegin:=False;
          XIsNotWhiteContinue:=True;
          XStart:=X;
         End;

        If XIsNotWhiteContinue Then
         Begin
          Inc(XCount);
         End;

        If ((imgStar.Canvas.Pixels[X+1, Y]=clWhite) And
         (imgStar.Canvas.Pixels[X, Y]<>clWhite)) Then
         Begin
          X1:=XStart;
          Y1:=Y;
          X2:=XStart+XCount+1;
          Y2:=Y+1;

          Rgn2:=CreateRectRgn(X1, Y1, X2, Y2);
          CombineRgn(RgnDest, RgnDest, Rgn2, rgn_Or);
          DeleteObject(Rgn2);
         End;

      End; //For X

   End; //For Y

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

end;

Результат довольно причудливый. И совсем не похож на звезду. Что я в этом коде делаю неверно? Думаю ход мысли понятен. Специально дал разъясняющие названия переменным.

[DIONISKA]

Признавайтесь, прогуливали векторную алгебру/геометрию? У вас картинка 9-ти конечной звезды, причем со сглаживанием, делать из неё регион вашим способом - полное извращение.
У вас 9-конечная звезда, это считай три одинаковых равносторонних треугольника, повернутых относительно центральной точки (G). Углы равноудаленны друг от друга и условного центра, угол между вершинами всех треугольников 360/9=40. Длинна стороны треугольника судя по картинке 700 пикселей. Достаточно рассчитать медиану/высоту, найти среднюю точку любого треугольника (ось вращения) см изображение:
Собственно этих данных с лихвой хватит чтобы обойтись без вашей картинки:

const
  side = 250; //700px  ширина стороны треугольника AB=AC=BC

procedure TfrmMain.FormCreate(Sender: TObject);
var
  AH,GH:Double;
  Points:array [1..12] of TPoint;
  PolyCounts:array [1..3] of Integer;
  A,A1,A2,B,B1,B2,C,C1,C2,G:TPoint; // разбил по точкам чтобы было понятнее, лучше сразу писать в массив "Points"
  wr: HRGN;
  R:Integer;

   function rotatepoint(center:TPoint;angle,radius:Integer):TPoint;
    begin
      Result.X:= round(center.x-R*Cos((Angle+90)/180*pi)); //90 градусов угол - стартовая точка A
      Result.Y:= round(center.x-R*Sin((Angle+90)/180*pi));
    end;

begin
   AH := SQRT(sqr(side)-sqr(side/2)); //  или Sin(60)*side
   GH:=AH/3;
   R:=round(AH-GH);// радиус описанной окружности
   G.X:=R;
   G.Y:=R;
   Self.Width:=r*2;  // форма должна быть достаточного размера
   Self.Height:=r*2; // должна помещать в себя описанную окружность => w=h=диаметр окр.

   A:=Point(R,0); // тут сократить, нужно писать в массив Points, разбито на точки для примера
   B:=rotatepoint(G,120,R);   // 120 - угол BGA=BGC=CGA=120
   C:=rotatepoint(G,240,R);  // 120 +120

   A1:=rotatepoint(G,40,R);  //смещение 40 градусов+угол 0
   B1:=rotatepoint(G,160,R); //смещение 40 градусов+угол 120
   C1:=rotatepoint(G,280,R); //смещение 40 градусов+угол 120*2

   A2:=rotatepoint(G,80,R); // И тп
   B2:=rotatepoint(G,200,R);
   C2:=rotatepoint(G,320,R);

    PolyCounts[1]:=4; // количество точек в каждом полигоне
    PolyCounts[2]:=4;
    PolyCounts[3]:=4;
    Points[1]:=A; //точки
    Points[2]:=B;
    Points[3]:=C;
    Points[4]:=A;
    Points[5]:=A1;
    Points[6]:=B1;
    Points[7]:=C1;
    Points[8]:=A1;
    Points[9]:=A2;
    Points[10]:=B2;
    Points[11]:=C2;
    Points[12]:=A2;
 wr:=CreatePolyPolygonRgn(Points,PolyCounts,3,WINDING);
 SetWindowRgn (Handle, wr, TRUE);
 try
   SetWindowRgn (Handle, wr, TRUE);
 finally
    DeleteObject (wr);
 end;

end;

[macomics]

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

P.S. Кажется вы тоже один урок прогуляли

      Result.X:= round(center.x-R*Sin(Angle*pi/180)); //90 градусов угол - стартовая точка A
      Result.Y:= round(center.x-R*Cos(Angle*pi/180));

[DIONISKA]

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

P.S. Кажется вы тоже один урок прогуляли

офтоп: Это были лихие студенческие годы, ну а если серьезно, то при идентичном результате не имеет значения как выглядит формула, тем-более там можно допиливать бесконечно, н-р там где должно быть "radius" используется "R", но это уже не так интересно
Что до картинок и обрезания формы под неё, то с незапамятных времен существуют Layered-окна, которые тут уже упоминались, они даже умеют работать с альфаканалом, у того-же 32-х битного TBitmap, а это считай окна с 255 степенями прозрачности, отсутствием характерной "лесенки", мерцания и пр. Стоит ли городить при наличии такого инструмента трассировщик изображения чтобы получить худший результат?

[macomics]

Layered окна появились только на XP. И то до SP1 они были не лучше регионов и генерировали белый шум при перетаскивании.

[DIONISKA]

ХР без SP1 была ужасной, кроме проблем с gdi/gdi+, отвала драйверов, множества дыр в безопасности, жора ресурсов у неё было множество других проблем, но то дела давно минувших дней, на дворе 2023-й и я давно не видел хр ниже SP2, не говоря уже о 95-й, 98-й и тп, так что сомневаюсь что ТС пишет под какую-то старую платформу. Тем-более если мне не изменяет память, то D7 вышла примерно в том-же году, что и SP1 для XP.
Всё-же на мой взгляд Layered окна предпочтительнее для украшательств подобного рода, другой вопрос захочет ли ТС с ними иметь дело или продолжит возиться с регионами.

[macomics]

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

другой вопрос захочет ли ТС с ними иметь дело или продолжит возиться с регионами.

Судя по этому ответу ему подошло.

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

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

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

ХР без SP1 была ужасной, кроме проблем с gdi/gdi+, отвала драйверов, множества дыр в безопасности, жора ресурсов у неё было множество других проблем, но то дела давно минувших дней, на дворе 2023-й и я давно не видел хр ниже SP2, не говоря уже о 95-й, 98-й и тп, так что сомневаюсь что ТС пишет под какую-то старую платформу. Тем-более если мне не изменяет память, то D7 вышла примерно в том-же году, что и SP1 для XP.

Просто механизм с регионами это дела ещё более давних дней минувших. Эта фишка была ещё в 9x.

Но я думаю он скажет спасибо за код.

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

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

Он его спрашивал, но мне было не до тригонометрии.

[hexor_boo]

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

Признавайтесь, прогуливали векторную алгебру/геометрию?

Благодарю за развернутый ответ. Если честно - в сторону тригономертии не смотрел. Наизусть без справочника такими формулами не владею. А о картинке - я её делал посредством манипуляций с линией 700px (вращение по 40 градусов + сдвиг до воссоединения с другими линиями). Тут фишка в следующем. Почему я упёрся в регионы: по замыслу предстоит работа с фигурами посложнее звезды, а именно с её фрагментами (от пересечений треугольников внутри). Решение позволяющее создать звезду по картинке путём набора её из прямоугольных пиксельных строк цвета

Not clWhite

подойдёт для любой другой фигуры произвольной сложности.

Итоговый вопрос. Что неверно в коде?

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

 If (RgnDest=0) Then
  Begin
   RgnDest:=CreateRectRgn(391, 0, 392, 1);
  End;
  
 XBeadCollect:=False;
 XBeadsCount:=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
           If (Not XBeadCollect) Then
            Begin
             XBeadCollect:=True;
             XBeadsCount:=1;
            End
           Else
            Inc(XBeadsCount, 1);
         End
        Else
          If XBeadCollect Then
           Begin
            XBeadCollect:=False;
            //Use beads code begin
            X1:=X;
            Y1:=Y;
            X2:=X1+XBeadsCount+1;
            Y2:=Y1+1;
            Rgn2:=CreateRectRgn(X1, Y1, X2, Y2);
            CombineRgn(RgnDest, RgnDest, Rgn2, rgn_Or);
            DeleteObject(Rgn2);
            //Use beads code end
            XBeadsCount:=0;
           End; //If XBeadCollect

      End; //For X
   End; //For Y

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

end;

Такое ощущение, что я здесь туплю в чём-то очень простом.

[macomics]

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

If (RgnDest=0) Then
  Begin
   RgnDest:=CreateRectRgn(391, 0, 392, 1);
  End;

1) Зачем проверять очевидное. Строчкой выше написано

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

RgnDest:=0;

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

If (Not XBeadCollect) Then
            Begin
             XBeadCollect:=True;
             XBeadsCount:=1;
            End
           Else
            Inc(XBeadsCount, 1);
         End

2) Можно обойтись одной переменной Count. Если её значение = 0, тогда Collect false иначе true. Значения в прямой зависимости. Достаточно оставить только Count

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

X1:=X;
            Y1:=Y;
            X2:=X1+XBeadsCount+1;
            Y2:=Y1+1;
            Rgn2:=CreateRectRgn(X1, Y1, X2, Y2);
            CombineRgn(RgnDest, RgnDest, Rgn2, rgn_Or);
            DeleteObject(Rgn2);
            //Use beads code end
            XBeadsCount:=0;

3) Вы уже прошли по X Count пикселей, но вычислив X2 = X1 + Count + 1 вы отложите по X пиксели в другую сторону (в сторону тех, что ещё не просматривали). Надо исправить на X1 - Count

4) 4 переменных X1, Y1, X2 и Y2 ни к чему. Их значения вполне можно подставить сразу в аргументы функции CreateRectRgn тем более, что значения X1 и Y2 и так всегда равны X и Y. Лучше сразу вот так

Rgn2:=CreateRectRgn(X - Count, Y, X, Y + 1);

[hexor_boo]

2 macomics,

1) Зачем проверять очевидное. Строчкой выше написано

RgnDest:=0;

А вот зачем:
RgnDest:=0 - это инициализация переменной и если она равна 0, то в неё нужно записать первый регион, а все последующие можно писать в Rgn2. Почему?

     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;

- это работает.

    
  RgnDest:=CreateRectRgn(X1, Y1, X2, Y2);
  Rgn2:=CreateRectRgn(X1, Y1, X2, Y2);
  CombineRgn(RgnDest, RgnDest, Rgn2, rgn_Or);
  DeleteObject(Rgn2);

- а это не работает, потому что hRgn присвоенный RgnDest удаляется строкой DeleteObject(Rgn2);

Другими словами проверка If (RgnDest=0) Then символически обозначает проверку условия был ли записан первый регион, к которому потом будет плюсоваться последующие.