| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Написал универсальную функцию прозрачности окон.

Страницы:   < 1 2 >

Черный Шаман ©   (2007-12-25 21:40:00) 

Может кому-то нужно, заодно и покритикуете.

{-------------------------------------------------------------------------------
 Отрисовка всего 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 оконных элементов

Основной баг(неустранимый) - если прозрачные элементы накладываются друг на друга, то отрисовка тормозит. (Количество перекрывающихся прозрачных элементов)!

---

Черный Шаман   (2007-12-25 23:09:00) [21]

Вот гляньте пример

http://webfile.ru/1656358

---

homm   (2007-12-25 23:00:00) [22]

> [0] Черный Шаман   (25.12.07 21:40)
> lControl.Perform(WM_PRINT, DC, PRF_CLIENT or PRF_ERASEBKGND
> or PRF_CHILDREN);

А еще уконтроллов бывает Неклинтская часть, слыхал?

---

homm   (2007-12-25 22:58:00) [23]

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

Panel1 — Win-контрол.

---

Черный Шаман   (2007-12-25 22:51:00) [24]

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


Подходит только для Win-контролов

---

homm   (2007-12-25 22:17:00) [25]

Мдааа...
    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;

---

homm   (2007-12-25 22:07:00) [26]

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
 PrintParentFullZOrder(Panel1, PaintBox1.Canvas.Handle);
end;

И где чудо?

---

Черный Шаман   (2007-12-25 22:05:00) [27]

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


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

Можно рисовать на Canvas TBitmap, получаешь полную копию экрана под твоим оконным компонентом. А дальше уже смешать два TBitmap(подложка и отрисовка) -  стандартный способ.

---

Kolan   (2007-12-25 22:01:00) [28]

> В Paint наследника TCustomControl рисовать на свой Canvas.Handle

И что будет? Не понял что значит «функцию прозрачности»… может полупрозрачность… А как тогда задать величину(AlphaBlend)?

---

Черный Шаман   (2007-12-25 21:58:00) [29]

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


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

end;

---

Kolan   (2007-12-25 21:52:00) [30]

А как её использовать?

---

Страницы:   < 1 2 >

Наверх