Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / 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-27 17:33:00) [1]

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

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

Для того чтобы сместить точку отрисовки на Canvas(HDC).

MetalFan (2007-12-27 10:21:00) [2]
а для чего в этой функции SetWindowOrgEx ?

Ketmar_ (2007-12-26 11:01:00) [3]
> PEAKTOP © (26.12.07 06:24) [26]
молодец. писать научился. осталось научиться думать перед тем как писать.

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

homm (2007-12-26 07:12:00) [4]
> [26] PEAKTOP © (26.12.07 06:24)
> Ребята, бросайте курить эту гадость ! :)

Хорошо так, со стороны ляпнуть первое, что в голову пришло, и вроде умным показался и напрягатся особо не пришлось. Давай уже сам бросай, включай соображалку.

PEAKTOP (2007-12-26 06:24:00) [5]
Ребята, бросайте курить эту гадость ! :)

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

И все там прозрачно: и форма, и дочерние элементы управления ...

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

Скорее ноборот, разгрузить ;)

Черный Шаман (2007-12-26 00:14:00) [7]

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

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

Или же я обдумываю о создании библиотеки визуальных контролов через Direct3D. Нужно же загрузить процессорные мощности? :)

homm (2007-12-26 00:12:00) [8]
> [22] Черный Шаман (26.12.07 00:09)
> SetLeft чуть быстрее, но это и понятно.

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

У меня Д7. Новее нет ничего сейчас на машине.

Черный Шаман (2007-12-26 00:09:00) [9]
homm © (26.12.07 00:00) [20]
SetLeft чуть быстрее, но это и понятно.

Вполне прилично по скорости для прозрачных/полупрозрачных панелек если их сделать только парочку для крутоты.

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

homm (2007-12-26 00:00:00) [11]
> [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. Почувствуй, как говориться, разницу :)

Черный Шаман (2007-12-25 23:58:00) [12]
Если комбинировать ее с этой(аналог отрисовки бекраунда в темах 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;

То совсем жить можно.

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

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

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

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

SkinVisualControl1.DoubleBuffered := True;
SkinVisualControl2.DoubleBuffered := True;

homm (2007-12-25 23:48:00) [14]
> [16] Черный Шаман (25.12.07 23:42)
> Что не так?

Колбасит-с

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

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

С [14] вроде багов не заметил. Что не так?

homm (2007-12-25 23:36:00) [16]
Вот еще так попробуй:

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-ная особенность инвалидейтить все налюбой чих. От этого стока фликов.

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

> 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 (2007-12-25 23:19:00) [18]
> [10] Черный Шаман (25.12.07 23:09)

А теперь сам приглядись к примеру, и скажи, почему его так колбасит во все стороны, когда над контролами надписи пролетают. Подсказка: см [12]

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

Как не нужна? Она такая же часть окна.

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

> 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);
>
> А еще уконтроллов бывает Неклинтская часть, слыхал?

Бывает, но она в данном случае не нужна.

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

Наверх

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