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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 25.04.2023, 22:48   #11
hexor_boo
Разъяснятор
Форумчанин
 
Аватар для hexor_boo
 
Регистрация: 21.04.2022
Сообщений: 101
По умолчанию

А если так?
Код:
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;
Результат довольно причудливый. И совсем не похож на звезду. Что я в этом коде делаю неверно? Думаю ход мысли понятен. Специально дал разъясняющие названия переменным.
hexor_boo вне форума Ответить с цитированием
Старый 28.04.2023, 22:02   #12
DIONISKA
Форумчанин
 
Регистрация: 07.11.2011
Сообщений: 149
По умолчанию

Признавайтесь, прогуливали векторную алгебру/геометрию? У вас картинка 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;

Последний раз редактировалось DIONISKA; 28.04.2023 в 22:12.
DIONISKA вне форума Ответить с цитированием
Старый 28.04.2023, 22:27   #13
macomics
Участник клуба
 
Регистрация: 17.04.2022
Сообщений: 1,833
По умолчанию

Проблема в том, что есть не 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));
macomics вне форума Ответить с цитированием
Старый 28.04.2023, 23:48   #14
DIONISKA
Форумчанин
 
Регистрация: 07.11.2011
Сообщений: 149
По умолчанию

Цитата:
Сообщение от macomics Посмотреть сообщение
P.S. Кажется вы тоже один урок прогуляли
офтоп: Это были лихие студенческие годы, ну а если серьезно, то при идентичном результате не имеет значения как выглядит формула, тем-более там можно допиливать бесконечно, н-р там где должно быть "radius" используется "R", но это уже не так интересно
Что до картинок и обрезания формы под неё, то с незапамятных времен существуют Layered-окна, которые тут уже упоминались, они даже умеют работать с альфаканалом, у того-же 32-х битного TBitmap, а это считай окна с 255 степенями прозрачности, отсутствием характерной "лесенки", мерцания и пр. Стоит ли городить при наличии такого инструмента трассировщик изображения чтобы получить худший результат?
DIONISKA вне форума Ответить с цитированием
Старый 29.04.2023, 00:07   #15
macomics
Участник клуба
 
Регистрация: 17.04.2022
Сообщений: 1,833
По умолчанию

Layered окна появились только на XP. И то до SP1 они были не лучше регионов и генерировали белый шум при перетаскивании.
macomics вне форума Ответить с цитированием
Старый 29.04.2023, 00:35   #16
DIONISKA
Форумчанин
 
Регистрация: 07.11.2011
Сообщений: 149
По умолчанию

ХР без SP1 была ужасной, кроме проблем с gdi/gdi+, отвала драйверов, множества дыр в безопасности, жора ресурсов у неё было множество других проблем, но то дела давно минувших дней, на дворе 2023-й и я давно не видел хр ниже SP2, не говоря уже о 95-й, 98-й и тп, так что сомневаюсь что ТС пишет под какую-то старую платформу. Тем-более если мне не изменяет память, то D7 вышла примерно в том-же году, что и SP1 для XP.
Всё-же на мой взгляд Layered окна предпочтительнее для украшательств подобного рода, другой вопрос захочет ли ТС с ними иметь дело или продолжит возиться с регионами.
DIONISKA вне форума Ответить с цитированием
Старый 29.04.2023, 00:57   #17
macomics
Участник клуба
 
Регистрация: 17.04.2022
Сообщений: 1,833
По умолчанию

Цитата:
Сообщение от DIONISKA Посмотреть сообщение
другой вопрос захочет ли ТС с ними иметь дело или продолжит возиться с регионами.
Судя по этому ответу ему подошло.
Цитата:
Сообщение от hexor_boo Посмотреть сообщение
Супер! До такого варианта сам не додумался бы. Респект! А то упёрся в то, что обязательно регионом нужно сделать.
Цитата:
Сообщение от DIONISKA Посмотреть сообщение
ХР без SP1 была ужасной, кроме проблем с gdi/gdi+, отвала драйверов, множества дыр в безопасности, жора ресурсов у неё было множество других проблем, но то дела давно минувших дней, на дворе 2023-й и я давно не видел хр ниже SP2, не говоря уже о 95-й, 98-й и тп, так что сомневаюсь что ТС пишет под какую-то старую платформу. Тем-более если мне не изменяет память, то D7 вышла примерно в том-же году, что и SP1 для XP.
Просто механизм с регионами это дела ещё более давних дней минувших. Эта фишка была ещё в 9x.

Но я думаю он скажет спасибо за код.
Цитата:
Сообщение от hexor_boo Посмотреть сообщение
А как их у звезды-то вычислять? Я понимаю что звезду можно представить с большим количеством вписанных в неё прямоугольников, вот только как это описать кодом и с какого места начинать вычисления непонятно. Самое разумное. что приходило в голову - разбивка звезды на строки выcотой в 1px - вы это имели ввиду?
Он его спрашивал, но мне было не до тригонометрии.
macomics вне форума Ответить с цитированием
Старый 30.04.2023, 21:43   #18
hexor_boo
Разъяснятор
Форумчанин
 
Аватар для hexor_boo
 
Регистрация: 21.04.2022
Сообщений: 101
По умолчанию

Цитата:
Сообщение от 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;
Такое ощущение, что я здесь туплю в чём-то очень простом.
hexor_boo вне форума Ответить с цитированием
Старый 30.04.2023, 22:24   #19
macomics
Участник клуба
 
Регистрация: 17.04.2022
Сообщений: 1,833
По умолчанию

Цитата:
Сообщение от 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);

Последний раз редактировалось macomics; 30.04.2023 в 22:27.
macomics вне форума Ответить с цитированием
Старый 01.05.2023, 20:48   #20
hexor_boo
Разъяснятор
Форумчанин
 
Аватар для hexor_boo
 
Регистрация: 21.04.2022
Сообщений: 101
По умолчанию

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 символически обозначает проверку условия был ли записан первый регион, к которому потом будет плюсоваться последующие.

Последний раз редактировалось hexor_boo; 01.05.2023 в 20:51.
hexor_boo вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 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