Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.04.2023, 17:29   #1
hexor_boo
Разъяснятор
Форумчанин
 
Аватар для hexor_boo
 
Регистрация: 21.04.2022
Сообщений: 106
Вопрос Delphi 7 : Использование hRgn

Есть изображение 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;
Где ошибка в первой части кода?
Вложения
Тип файла: 7z Star.7z (16.5 Кб, 6 просмотров)
hexor_boo вне форума Ответить с цитированием
Старый 25.04.2023, 17:46   #2
macomics
Участник клуба
 
Регистрация: 17.04.2022
Сообщений: 1,833
По умолчанию

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

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

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

Последний раз редактировалось macomics; 25.04.2023 в 17:49.
macomics вне форума Ответить с цитированием
Старый 25.04.2023, 17:50   #3
hexor_boo
Разъяснятор
Форумчанин
 
Аватар для hexor_boo
 
Регистрация: 21.04.2022
Сообщений: 106
По умолчанию

Код:
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 вне форума Ответить с цитированием
Старый 25.04.2023, 17:51   #4
hexor_boo
Разъяснятор
Форумчанин
 
Аватар для hexor_boo
 
Регистрация: 21.04.2022
Сообщений: 106
По умолчанию

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

Последний раз редактировалось hexor_boo; 25.04.2023 в 17:53. Причина: Дополнение
hexor_boo вне форума Ответить с цитированием
Старый 25.04.2023, 18:02   #5
macomics
Участник клуба
 
Регистрация: 17.04.2022
Сообщений: 1,833
По умолчанию

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

Вот вам работающий пример
Вложения
Тип файла: zip Example.zip (29.2 Кб, 7 просмотров)
macomics вне форума Ответить с цитированием
Старый 25.04.2023, 18:16   #6
macomics
Участник клуба
 
Регистрация: 17.04.2022
Сообщений: 1,833
По умолчанию

Ещё лучше создавать сразу 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.)
macomics вне форума Ответить с цитированием
Старый 25.04.2023, 18:27   #7
hexor_boo
Разъяснятор
Форумчанин
 
Аватар для hexor_boo
 
Регистрация: 21.04.2022
Сообщений: 106
По умолчанию

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

Цитата:
Вот вам работающий пример
Супер! До такого варианта сам не додумался бы. Респект! А то упёрся в то, что обязательно регионом нужно сделать.
hexor_boo вне форума Ответить с цитированием
Старый 25.04.2023, 18:31   #8
macomics
Участник клуба
 
Регистрация: 17.04.2022
Сообщений: 1,833
По умолчанию

Цитата:
Сообщение от hexor_boo Посмотреть сообщение
разбивка звезды на строки выcотой в 1px - вы это имели ввиду?
да

Цитата:
Сообщение от hexor_boo Посмотреть сообщение
Супер! До такого варианта сам не додумался бы. Респект! А то упёрся в то, что обязательно регионом нужно сделать.
Вообще регионы это довольно медленная штука пришедшая ещё из 9х пока не появились Layered окна. Теперь все проще сделать через них. Только цвет для прозрачности выберите другой. Белый - не самый лучший выбор. Дочерние окна того же цвета тоже будут становиться прозрачными.
macomics вне форума Ответить с цитированием
Старый 25.04.2023, 19:43   #9
hexor_boo
Разъяснятор
Форумчанин
 
Аватар для hexor_boo
 
Регистрация: 21.04.2022
Сообщений: 106
По умолчанию

Ура! Задача с помощью регионов решена!
Код:
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;
Единственный нюанс - учитывая что перебор идёт по пикселам - срабатывает со значительной задержкой. Как решение в первом грубом приближении подходит. Теперь нужно оптимизировать. Есть над чем подумать.
hexor_boo вне форума Ответить с цитированием
Старый 25.04.2023, 20:01   #10
macomics
Участник клуба
 
Регистрация: 17.04.2022
Сообщений: 1,833
По умолчанию

Вот вам ещё одна подсказка. Если сначала создадите
Код:
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 и читать данные пикселей из линейного массива вычисляя позицию.
macomics вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Использование SDK (C++) в Delphi dalx Фриланс 2 28.04.2022 00:04
Использование Delphi DLL в PHP коде Adult_Master Общие вопросы Delphi 5 27.10.2015 18:17
Использование ЭЦП в Delphi tarakan1983 Общие вопросы Delphi 3 30.03.2015 21:39
Использование библиотек в Delphi Konstantin_V Софт 31 22.02.2010 21:59
HRGN сохранение-загрузка? Comer_Jus Общие вопросы Delphi 5 21.05.2008 20:12