Конференция "Основная" » Написал универсальную функцию прозрачности окон.
 
  • Черный Шаман (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;



    То совсем жить можно.
  • homm © (26.12.07 00:00) [20]
    > [18] Черный Шаман   (25.12.07 23:54)
    > Кстати, DoubleBuffered у контролов стоит?

    Демка та же, стоит.

    Если все равно не понятно, о чем я, вот так еще сделай:
    procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
    begin
     SkinVisualControl1.Left := X - (SkinVisualControl1.Width div 2);
     SkinVisualControl2.Left := X - (SkinVisualControl2.Width div 2);
     //SetLeft(SkinVisualControl1, X - (SkinVisualControl1.Width div 2));
     //SetLeft(SkinVisualControl2, X - (SkinVisualControl2.Width div 2));
     SkinVisualControl1.Refresh;
     SkinVisualControl2.Refresh;
    end;


    Только таймер отключи. А потом разремарь мой вариант и заремарь SkinVisualControl1.Left. Почувствуй, как говориться, разницу :)
  • homm © (26.12.07 00:06) [21]
    Есть, кстати, еще одна досада. Положи на форму ричедит, попробуй по нему «проехаться». Эту гадость вообще ни одна прозрачность не берет :)
  • Черный Шаман (26.12.07 00:09) [22]
    homm ©   (26.12.07 00:00) [20]
    SetLeft чуть быстрее, но это и понятно.

    Вполне прилично по скорости для прозрачных/полупрозрачных панелек если их сделать только парочку для крутоты.
  • homm © (26.12.07 00:12) [23]
    > [22] Черный Шаман   (26.12.07 00:09)
    > SetLeft чуть быстрее, но это и понятно.

    Скорость не причем. То, что тебе не вино разницы может быть обусловленно другой версией дельфи, плохим монитором, плохим зрением, или не желанием видеть.

    У меня Д7. Новее нет ничего сейчас на машине.
  • Черный Шаман (26.12.07 00:14) [24]

    > homm ©   (26.12.07 00:06) [21]
    >
    > Есть, кстати, еще одна досада. Положи на форму ричедит,
    > попробуй по нему «проехаться». Эту гадость вообще ни одна
    > прозрачность не берет :)


    Для большинства случаев хватит. Даже в Vista нормальной прозрачности дочерних элементов нет. Хотите полных наворотов - берите QT.

    Или же я обдумываю о создании библиотеки визуальных контролов через Direct3D. Нужно же загрузить процессорные мощности? :)
  • homm © (26.12.07 00:27) [25]
    > [24] Черный Шаман   (26.12.07 00:14)
    > Или же я обдумываю о создании библиотеки визуальных контролов
    > через Direct3D. Нужно же загрузить процессорные мощности?
    > :)

    Скорее ноборот, разгрузить ;)
  • PEAKTOP © (26.12.07 06:24) [26]
    Ребята, бросайте курить эту гадость ! :)

    Помоему, начиная с Delphi7 (или раньше ?) давно уже есть
    TCustomForm.AlphaBlendValue := [0..255];
    TCustomForm.AlphaBlend := [true || false];

    И все там прозрачно: и форма, и дочерние элементы управления ...
  • homm © (26.12.07 07:12) [27]
    > [26] PEAKTOP ©   (26.12.07 06:24)
    > Ребята, бросайте курить эту гадость ! :)

    Хорошо так, со стороны ляпнуть первое, что в голову пришло, и вроде умным показался и напрягатся особо не пришлось. Давай уже сам бросай, включай соображалку.
  • Ketmar_ (26.12.07 11:01) [28]
    > PEAKTOP ©   (26.12.07 06:24) [26]
    молодец. писать научился. осталось научиться думать перед тем как писать.

    зыж у меня, например, тоже была такая же реакция. но я не поддался, и потрудился хотя бы глянуть код перед постом. после чего понял, что не стоит глупости постить.
  • MetalFan © (27.12.07 10:21) [29]
    а для чего в этой функции SetWindowOrgEx ?
  • Черный Шаман (27.12.07 17:33) [30]

    > MetalFan ©   (27.12.07 10:21) [29]
    >
    > а для чего в этой функции SetWindowOrgEx ?


    Не нравится SetWindowOrgEx, можешь использовать SetViewportOrgEx :), только знаки в вычислениях поменяй на противоположные.

    Для того чтобы сместить точку отрисовки на Canvas(HDC).
 
Конференция "Основная" » Написал универсальную функцию прозрачности окон.
Есть новые Нет новых   [134431   +15][b:0][p:0.005]