Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2008.09.28;
Скачать: [xml.tar.bz2];

Вниз

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

 
Черный Шаман   (2007-12-25 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 ©   (2007-12-25 21:52) [1]

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


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


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


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

end;


 
Kolan ©   (2007-12-25 22:01) [3]

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

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


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


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


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

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


 
homm ©   (2007-12-25 22:07) [5]

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


И где чудо?


 
homm ©   (2007-12-25 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;


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


> 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:58) [8]

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

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


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

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

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


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

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

http://webfile.ru/1656358


 
Черный Шаман   (2007-12-25 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 ©   (2007-12-25 23:16) [12]

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

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


 
homm ©   (2007-12-25 23:19) [13]

> [10] Черный Шаман   (25.12.07 23:09)

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


 
Черный Шаман   (2007-12-25 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 ©   (2007-12-25 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-ная особенность инвалидейтить все налюбой чих. От этого стока фликов.


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


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


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


 
homm ©   (2007-12-25 23:48) [17]

> [16] Черный Шаман   (25.12.07 23:42)
> Что не так?

Колбасит-с


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


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


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

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

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


 
Черный Шаман   (2007-12-25 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 ©   (2007-12-26 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 ©   (2007-12-26 00:06) [21]

Есть, кстати, еще одна досада. Положи на форму ричедит, попробуй по нему «проехаться». Эту гадость вообще ни одна прозрачность не берет :)


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

homm ©   (26.12.07 00:00) [20]
SetLeft чуть быстрее, но это и понятно.

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


 
homm ©   (2007-12-26 00:12) [23]

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

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

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


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


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


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

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


 
homm ©   (2007-12-26 00:27) [25]

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

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


 
PEAKTOP ©   (2007-12-26 06:24) [26]

Ребята, бросайте курить эту гадость ! :)

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

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


 
homm ©   (2007-12-26 07:12) [27]

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

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


 
Ketmar_   (2007-12-26 11:01) [28]

> PEAKTOP ©   (26.12.07 06:24) [26]
молодец. писать научился. осталось научиться думать перед тем как писать.

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


 
MetalFan ©   (2007-12-27 10:21) [29]

а для чего в этой функции SetWindowOrgEx ?


 
Черный Шаман   (2007-12-27 17:33) [30]


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


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

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



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2008.09.28;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.54 MB
Время: 0.045 c
2-1219221619
dmitry_12_08_74
2008-08-20 12:40
2008.09.28
Как можно, имея Handle объекта, определить указатель на него


2-1218611450
cvg
2008-08-13 11:10
2008.09.28
Почему некорректно работает frac?


15-1218084845
stas
2008-08-07 08:54
2008.09.28
Вопрос по HTML


2-1218725745
atomAltera
2008-08-14 18:55
2008.09.28
Минимизация окна...


8-1186690843
Spok
2007-08-10 00:20
2008.09.28
как зациклить MediaPlayer?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский