Конференция "Основная" » Написал универсальную функцию прозрачности окон.
 
  • Черный Шаман (25.12.07 21:40) [0]
    Может кому-то нужно, заодно и покритикуете.

    {-------------------------------------------------------------------------------
     Отрисовка всего Z-order для оконных элементов(тяжелая по вычислениям)
     Control - сам оконный контрол на который будет происходить отрисовка
     DC - контекст устройства для WinControl Canvas.Handle
    -------------------------------------------------------------------------------}

    procedure PrintParentFullZOrder(Control: TControl; DC: HDC);
    var
     LastOrigin: TPoint;
     i: Integer;
     ControlInd: Integer;
     lControl: TControl;
     lIntersectRect, FirstRect, SecondRect: TRect;
    begin
     if not Assigned(Control.Parent) then Exit;
     if not (Control is TWinControl) then Exit;
     //запоминаем положение устройства вывода
     GetWindowOrgEx(DC, LastOrigin);
     //рисуем подложку parent
     SetWindowOrgEx(DC, LastOrigin.X + Control.Left, LastOrigin.Y + Control.Top, nil);
     Control.Parent.Perform(WM_ERASEBKGND, Integer(DC), Integer(DC));
     Control.Parent.Perform(WM_PRINT, DC, PRF_CLIENT or PRF_ERASEBKGND);
     //рисуем wincontrol в нижнем Zorder
     ControlInd := Control.Parent.ControlCount - 1;
     for i := 0 to ControlInd do
       begin
         lControl := Control.Parent.Controls[i];
         //если контрол сам то нижний z-ордер выбран
         if lControl = Control Then Break;
         //если контрол не wincontrol то пропускаем итерацию
         if not (lControl is TWinControl) then Continue;
         //проверка на видимость
         if not lControl.Visible then Continue;
         //если ректанглы не пересекаются то не рисуем
         //первый
         FirstRect.Left := lControl.Left;
         FirstRect.Top := lControl.Top;
         FirstRect.Right := lControl.Left + lControl.Width;
         FirstRect.Bottom := lControl.Top + lControl.Height;
         //второй
         SecondRect.Left := Control.Left;
         SecondRect.Top := Control.Top;
         SecondRect.Right := Control.Left + Control.Width;
         SecondRect.Bottom := Control.Top + Control.Height;
         //проверяем
         if not IntersectRect(lIntersectRect, FirstRect, SecondRect) then Continue;
         //устанавливаем новый вьюпоинт
         SetWindowOrgEx(DC, LastOrigin.X - lControl.Left + Control.Left, LastOrigin.Y - lControl.Top + Control.Top, nil);
         lControl.Perform(WM_ERASEBKGND, Integer(DC), Integer(DC));
         lControl.Perform(WM_PRINT, DC, PRF_CLIENT or PRF_ERASEBKGND or PRF_CHILDREN);
       end;
     //возвращаем VievPoint
     SetWindowOrgEx(DC, LastOrigin.X, LastOrigin.Y, nil);
    end;



    Для отсутствия мигания элемент на котором рисуется должен быть
    DoubleBuffered = True;

    Вызывать в Paint оконных элементов

    Основной баг(неустранимый) - если прозрачные элементы накладываются друг на друга, то отрисовка тормозит. (Количество перекрывающихся прозрачных элементов)!
  • Kolan © (25.12.07 21:52) [1]
    А как её использовать?
  • Черный Шаман (25.12.07 21:58) [2]

    > Kolan ©   (25.12.07 21:52) [1]
    >
    > А как её использовать?


    В Paint наследника TCustomControl рисовать на свой Canvas.Handle
    procedure Paint;
    begin
    PrintParentFullZOrder(Self, Canvas.Handle);
    //Остальной код

    end;

  • Kolan © (25.12.07 22:01) [3]
    > В Paint наследника TCustomControl рисовать на свой Canvas.Handle

    И что будет? Не понял что значит «функцию прозрачности»… может полупрозрачность… А как тогда задать величину(AlphaBlend)?
  • Черный Шаман (25.12.07 22:05) [4]

    > Kolan ©   (25.12.07 22:01) [3]
    >
    > > В Paint наследника TCustomControl рисовать на свой Canvas.
    > Handle
    >
    > И что будет? Не понял что значит «функцию прозрачности»…
    > может полупрозрачность… А как тогда задать величину(AlphaBlend)?


    Именно прозрачности.

    Можно рисовать на Canvas TBitmap, получаешь полную копию экрана под твоим оконным компонентом. А дальше уже смешать два TBitmap(подложка и отрисовка) -  стандартный способ.
  • homm © (25.12.07 22:07) [5]
    procedure TForm1.PaintBox1Paint(Sender: TObject);
    begin
     PrintParentFullZOrder(Panel1, PaintBox1.Canvas.Handle);
    end;



    И где чудо?
  • homm © (25.12.07 22:17) [6]
    Мдааа...
        FirstRect.Left := lControl.Left;
        FirstRect.Top := lControl.Top;
        FirstRect.Right := lControl.Left + lControl.Width;
        FirstRect.Bottom := lControl.Top + lControl.Height;
        FirstRect := lControl.BoundsRect;
        SecondRect.Left := Control.Left;
        SecondRect.Top := Control.Top;
        SecondRect.Right := Control.Left + Control.Width;
        SecondRect.Bottom := Control.Top + Control.Height;
        if not IntersectRect(lIntersectRect, FirstRect, SecondRect) then Continue;



    if not IntersectRect(lIntersectRect, FirstRect.BoundsRect, Control.BoundsRect) then Continue;

  • Черный Шаман (25.12.07 22:51) [7]

    > homm ©   (25.12.07 22:07) [5]
    >
    > procedure TForm1.PaintBox1Paint(Sender: TObject);
    > begin
    >  PrintParentFullZOrder(Panel1, PaintBox1.Canvas.Handle);
    >
    > end;
    > И где чудо?


    Подходит только для Win-контролов
  • homm © (25.12.07 22:58) [8]
    > [7] Черный Шаман   (25.12.07 22:51)
    > Подходит только для Win-контролов

    Panel1 — Win-контрол.
  • homm © (25.12.07 23:00) [9]
    > [0] Черный Шаман   (25.12.07 21:40)
    > lControl.Perform(WM_PRINT, DC, PRF_CLIENT or PRF_ERASEBKGND
    > or PRF_CHILDREN);

    А еще уконтроллов бывает Неклинтская часть, слыхал?
  • Черный Шаман (25.12.07 23:09) [10]
    Вот гляньте пример

    http://webfile.ru/1656358
  • Черный Шаман (25.12.07 23:10) [11]

    > homm ©   (25.12.07 23:00) [9]
    >
    > > [0] Черный Шаман   (25.12.07 21:40)
    > > lControl.Perform(WM_PRINT, DC, PRF_CLIENT or PRF_ERASEBKGND
    > > or PRF_CHILDREN);
    >
    > А еще уконтроллов бывает Неклинтская часть, слыхал?


    Бывает, но она в данном случае не нужна.
  • homm © (25.12.07 23:16) [12]
    > [11] Черный Шаман   (25.12.07 23:10)
    > Бывает, но она в данном случае не нужна.

    Как не нужна? Она такая же часть окна.
  • homm © (25.12.07 23:19) [13]
    > [10] Черный Шаман   (25.12.07 23:09)

    А теперь сам приглядись к примеру, и скажи, почему его так колбасит во все стороны, когда над контролами надписи пролетают. Подсказка: см [12]
  • Черный Шаман (25.12.07 23:32) [14]

    > homm ©   (25.12.07 23:19) [13]
    >
    > > [10] Черный Шаман   (25.12.07 23:09)
    >
    > А теперь сам приглядись к примеру, и скажи, почему его так
    > колбасит во все стороны, когда над контролами надписи пролетают.
    >  Подсказка: см [12]


    Сорри вы правы.


    procedure PrintParentFullZOrder(Control: TControl; DC: HDC);
    var
     LastOrigin: TPoint;
     i: Integer;
     ControlInd: Integer;
     lControl: TControl;
     lIntersectRect: TRect;
    begin
     if not Assigned(Control.Parent) then Exit;
     if not (Control is TWinControl) then Exit;
     //запоминаем положение устройства вывода
     GetWindowOrgEx(DC, LastOrigin);
     //рисуем подложку parent
     SetWindowOrgEx(DC, LastOrigin.X + Control.Left, LastOrigin.Y + Control.Top, nil);
     Control.Parent.Perform(WM_ERASEBKGND, Integer(DC), Integer(DC));
     Control.Parent.Perform(WM_PRINT, DC, PRF_CLIENT or PRF_ERASEBKGND);
     //рисуем wincontrol в нижнем Zorder
     ControlInd := Control.Parent.ControlCount - 1;
     for i := 0 to ControlInd do
       begin
         lControl := Control.Parent.Controls[i];
         //если контрол сам то нижний z-ордер выбран
         if lControl = Control Then Break;
         //если контрол не wincontrol то пропускаем итерацию
         if not (lControl is TWinControl) then Continue;
         //проверка на видимость
         if not lControl.Visible then Continue;
         //если ректанглы не пересекаются то не рисуем
         if not IntersectRect(lIntersectRect, lControl.BoundsRect, Control.BoundsRect) then Continue;
         //устанавливаем новый вьюпоинт
         SetWindowOrgEx(DC, LastOrigin.X - lControl.Left + Control.Left, LastOrigin.Y - lControl.Top + Control.Top, nil);
         lControl.Perform(WM_ERASEBKGND, Integer(DC), Integer(DC));
         lControl.Perform(WM_PRINT, DC, PRF_CLIENT or PRF_ERASEBKGND or PRF_CHILDREN or PRF_NONCLIENT);
       end;
     //возвращаем VievPoint
     SetWindowOrgEx(DC, LastOrigin.X, LastOrigin.Y, nil);
    end;

  • homm © (25.12.07 23:36) [15]
    Вот еще так попробуй:

    procedure SetLeft(Control:TWinControl; NewLeft: Integer);
    begin
     SetWindowPos(Control.Handle, 0, NewLeft, Control.Top, 0, 0,  SWP_NOSIZE or SWP_NOZORDER or SWP_NOCOPYBITS );

    end;

    procedure TMainForm.Timer1Timer(Sender: TObject);
    begin
     SetLeft(SkinVisualControl1, SkinVisualControl1.Left+2);
     SetLeft(SkinVisualControl2, SkinVisualControl2.Left+3);
     if SkinVisualControl1.Left > 400 then SetLeft(SkinVisualControl1, 2);
     if SkinVisualControl2.Left > 400 then SetLeft(SkinVisualControl2, 2);

     SkinVisualControl1.Refresh;
     SkinVisualControl2.Refresh;
    end;



    Зы. Бесит VCL-ная особенность инвалидейтить все налюбой чих. От этого стока фликов.
  • Черный Шаман (25.12.07 23:42) [16]

    > homm ©   (25.12.07 23:36) [15]


    С [14] вроде багов не заметил. Что не так?
  • homm © (25.12.07 23:48) [17]
    > [16] Черный Шаман   (25.12.07 23:42)
    > Что не так?

    Колбасит-с
  • Черный Шаман (25.12.07 23:54) [18]

    > homm ©   (25.12.07 23:48) [17]
    >
    > > [16] Черный Шаман   (25.12.07 23:42)
    > > Что не так?
    >
    > Колбасит-с


    Но пока это лучший способ из тех что я видел без полной переделки VCL. Подойдет при нечастом изменении подложки.

    Кстати, DoubleBuffered у контролов стоит?

     SkinVisualControl1.DoubleBuffered := True;
     SkinVisualControl2.DoubleBuffered := True;
  • Черный Шаман (25.12.07 23:58) [19]
    Если комбинировать ее с этой(аналог отрисовки бекраунда в темах XP, но работает начиная с Win95)


    {-------------------------------------------------------------------------------
     Отрисовка графического фона предка на оконных элемент, работает быстро
     Control - сам оконный контрол на который будет происходить отрисовка
     DC - контекст устройства для WinControl Canvas.Handle  Вспомогательная процедура отрисовки рамочки
    -------------------------------------------------------------------------------}

    procedure PrintParentBackground(Control: TControl; DC: HDC);
    var
     LastOrigin: TPoint;
    begin
     //проверки
     if not Assigned(Control.Parent) then Exit;
     if not (Control is TWinControl) then Exit;
     //запоминаем положение устройства вывода
     GetWindowOrgEx(DC, LastOrigin);
     //рисуем парента
     SetWindowOrgEx(DC, LastOrigin.X + Control.Left, LastOrigin.Y + Control.Top, nil);
     Control.Parent.Perform(WM_ERASEBKGND, Integer(DC), Integer(DC));
     Control.Parent.Perform(WM_PRINT, DC, PRF_CLIENT or PRF_ERASEBKGND);
     //возвращаем VievPoint
     SetWindowOrgEx(DC, LastOrigin.X, LastOrigin.Y, nil);
    end;



    То совсем жить можно.
 
Конференция "Основная" » Написал универсальную функцию прозрачности окон.
Есть новые Нет новых   [133939   +174][b:0][p:0.005]