Форум: "Основная";
Текущий архив: 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.Handleprocedure Paint;
begin
PrintParentFullZOrder(Self, Canvas.Handle);
//Остальной код
end;
← →
Kolan © (2007-12-25 22:01) [3]> В Paint наследника TCustomControl рисовать на свой Canvas.Handle
И что будет? Не понял что значит «функцию прозрачности»… может полупрозрачность… А как тогда задать величину(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