Полупрозрачная TPanel

← →
TankMan © (2004-02-05 18:44) [0]

Ни кто случайно не знает, как сделать TPanel полупрозрачной?... очень нада... хочу сделать полупрозрачный скроллинг... скроллинг то сделал из TPanel и 3х SpeedButton а вот прозрачными сделать не могу :( самое главное чтобы в 9х работало...

← →
}{enon © (2004-02-05 19:47) [1]

Ишь чего захотел :) В 9x даже форму прозрачной еще попробуй сделать. Кстати, если получится (думаю эту проблему как-то все же решают), то повтори те же действия по отношению к этим самым кнопкам - они ведь тоже окна.

← →
DVM © (2004-02-05 20:23) [2]

Сделать можно без особых проблем (чего не скажешь о обычном, не дочернем окне).
Идея примерно такова: берется кусок изображения с родительского окна (GetDC) и копируется (BitBlt) в дочернее, далее дочернее окно отрисовывает себя используя функцию смешения светов (AlphaBlend).

← →
TankMan © (2004-02-05 23:29) [3]

>>DVM
Аа... пример хоть какой нибудь есть?

← →
UNIVERSAL (2004-02-06 09:16) [4]

По моему есть функция для транспонирования двух рисунков TransparentBlt кажется. Может это поможет. Есть ещё одна установка атрибутов окна, но она работает на Win2000 и старше.

← →
RDen (2004-02-06 09:26) [5]

вот пример прозрачной формы - может поможет? :)

unit Prozr;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
// это просто кнопка на форме - для демонстрации
protected
procedure RebuildWindowRgn;
procedure Resize; override;
public
constructor Create(AOwner: TComponent); override;
end;
var
Form1 : TForm1;
implementation
// ресурс этой формы
{$R *.DFM}

{ Прозрачная форма }
constructor TForm1.Create(AOwner: TComponent);
begin
inherited;
// убираем сколлбары, чтобы не мешались
// при изменении размеров формы
HorzScrollBar.Visible:= False;
VertScrollBar.Visible:= False;
// строим новый регион
RebuildWindowRgn;
end;

procedure TForm1.Resize;
begin
inherited;
// строим новый регион
RebuildWindowRgn;
end;

procedure TForm1.RebuildWindowRgn;
var
FullRgn, Rgn: THandle;
ClientX, ClientY, I: Integer;
begin
// определяем относительные координаты клиенской части
ClientX:= (Width - ClientWidth) div 2;
ClientY:= Height - ClientHeight - ClientX;
// создаем регион для всей формы
FullRgn:= CreateRectRgn(0, 0, Width, Height);
// создаем регион для клиентской части формы
// и вычитаем его из FullRgn
Rgn:= CreateRectRgn(ClientX, ClientY, ClientX + ClientWidth, ClientY +
ClientHeight);
CombineRgn(FullRgn, FullRgn, Rgn, rgn_Diff);
// теперь добавляем к FullRgn регионы каждого контрольного элемента
for I:= 0 to ControlCount -1 do
with Controls[I] do begin
Rgn:= CreateRectRgn(ClientX + Left, ClientY + Top, ClientX + Left +
Width, ClientY + Top + Height);
CombineRgn(FullRgn, FullRgn, Rgn, rgn_Or);
end;
// устанавливаем новый регион окна
SetWindowRgn(Handle, FullRgn, True);
end;
end.

end.

← →
TankMan © (2004-02-06 18:49) [6]

Ага... только по этому примеру полупрозрачной TPanel не зделаешь... полностью прозрачный компонент я и сам могу сделать :)

← →
DVM © (2004-02-06 18:58) [7]

На королевстве делфи есть статья, там делается полупрозрачное окно в Win9X. По тому же принципу можно сделать полупрозрачную панель. Там же приложен алгоритм смешения цветов.

← →
TankMan © (2004-02-09 20:11) [8]

Фишка в том, что все примеры, которые позволяли делать полупрозрачные окна в 9х были основаны на принципе того, что окно на очень малое время сворачивается, под ним прорисовывается, то что там должно быть, это дело все копируется и смешивается с изображением самой формы... вобщем так...
Я подумал так, если свернуть вместо формы только панель, срисовать то что находится под ней и показать панель заново, смешав предварительно цвета... вроде все нормально - даже проще (панелька быстрее перерисовывается) но фишка в том, что после сворачивания нужно как-то дать команду для перерисовки того компонента, который находится сзади, а как я не знаю :(... я думал сделать просто application.processmesages, но если его вставить между скрытием панельки и копированием того что должно быть за ней, дельфя выдает stack overflow :(... отладкой проверил, как только доходит до application.processmesages перерисовка происходит заново :(... как сделать, чтобы все нормально зарисовалось за панелькою не знаю :(

← →
DVM © (2004-02-09 21:13) [9]

> Фишка в том, что все примеры, которые позволяли делать полупрозрачные
> окна в 9х были основаны на принципе того, что окно на очень
> малое время сворачивается, под ним прорисовывается, то что
> там должно быть, это дело все копируется и смешивается с
> изображением самой формы... вобщем так...

Не надо ничего скрывать. Есть два способа:
Первый убрать у родительского окна стиль WS_CLIPCHILDREN, тогда фон родительского окна будет рисоваться под поверхностью дочернего.
Второй - не убирать стиль, а в процедуру отрисовки дочернего окна добавить закрашивание области той же кистью, наложение того же скина, и.т.д., что и у родительского.

> По моему есть функция для транспонирования двух рисунков
> TransparentBlt кажется.

Не поможет. Этой функцией можно отрисовать "дырку", но не полупрозрачность. Нужна функция смешения цветов. Где ее взять я уже написал.

← →
TankMan © (2004-02-10 00:23) [10]

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

А если не надо ничего скрывать, то каким образом можно узнать (скопировать) то что находится под панелью?

← →
DVM © (2004-02-10 01:53) [11]

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

Если изменяющееся изображение находится на Вашей панели, то ему будет приходить WM_PAINT при каждом изменении, реагируйте на него.

> А если не надо ничего скрывать, то каким образом можно узнать
> (скопировать) то что находится под панелью?

Примерно так:

DC:=GetDC(GetParent(hPanel));
MemDC:=CreateCompatibleDC(DC);
MemBitmap:=CreateCompatibleBitmap(DC, ParentWidth, ParentHeight);
SelectObject(MemBitmap, MemDC);
BitBlt(... копируете из DC в MemDC....);
Фон родительского окна получен в MemDC.
Далее в MemDC рисуете все что вздумается, прозрачность и т.д.
Затем BitBlt( из MemDC на PanelDC)
ReleaseDC(DC);

Все это надо наверное в WM_PAINT дочерней панели.
Не забывайте удалять объекты GDI.

← →
TankMan © (2004-02-10 18:20) [12]

...хм... у меня вобщем картина такая,
есть форма, есть видеопанель, и есть панель, которая должна быть полупрозрачной, вот эта "полупрозрачная" панель находится над видеопанелью, но родитель ее - форма.
У меня нет сейчас дельфи под рукой, (очень тороплюсь), но насколько я понял, что если я получу ДС от родителя "полупрозрачной" панели, то рисоваться туда будет именно кусок формы который будет находится под видео панелью...или не так?

← →
DVM © (2004-02-11 12:17) [13]

Получишь DC родителя и надо отрисовать изображение с его DC на DC дочернего окна используя функцию смешения цветов. Цвета пикселей родительского окна надо смешивать с цветами пикселей дочернего. Причем родительское окно не должно иметь стиля WS_CLIPCHILDREN.

← →
TankMan © (2004-02-21 04:04) [14]

DVM, пробовал я твой вариант, но почему-то не получается ничего :(... я уж так запутался :(... не мог бы пожалуйста помочь мне на практике? Если сможешь, я вышлю тебе мой проектик... просто я уже несколько дней все не могу разобраться в том, почему не работает :(

← →
DVM © (2004-02-21 13:59) [15]

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

program trans;

uses windows, messages;

var wc, wc2 : TWndClassEx;
MainWnd : HWND;
Mesg : TMsg;
ChildWnd : HWND;

function WindowProc(wnd:HWND; Msg : Integer; Wparam:Wparam; Lparam:Lparam):Lresult; stdcall;
var
DC, ParentDC: HDC;
ps: TPaintStruct;
rc: TRect;
br: HBRUSH;
Begin
case msg of

WM_ERASEBKGND: Result:=1;
WM_PAINT:
begin
DC:=BeginPaint(wnd, ps);
GetClientRect(MainWnd, rc);
br:=CreateHatchBrush(HS_CROSS, RGB(100,200,200));

FillRect(DC, rc, br);
DeleteObject(br);
EndPaint(wnd, ps);
Result:=0;
end;

wm_destroy :
Begin
postquitmessage(0); exit;
Result:=0;
End;

else Result:=DefWindowProc(wnd,msg,wparam,lparam);
end;
end;

function WindowProc2(wnd:HWND; Msg : Integer; Wparam:Wparam; Lparam:Lparam):Lresult; stdcall;
var
DC, ParentDC: HDC;
ps: TPaintStruct;
rc: TRect;
br: HBRUSH;
X, Y: INTEGER;
Color1, Color2: Cardinal;
R, G, B:INTEGER;
TranspColor: Cardinal;
const
Transparency=40;
Begin
case msg of
WM_PAINT:
begin
DC:=BeginPaint(wnd, ps);
GetClientRect(MainWnd, rc);
ParentDC:=GetDC(MainWnd);

GetClientRect(WND, rc);

TranspColor:=RGB(200,250,250);

for x:=0 to 100 do
for y:=0 to 70 do
begin
Color1 := GetPixel(DC, X, Y);
Color2 := GetPixel(ParentDC, X+20, Y+20);
R:=(Transparency*GetRValue(Color2)+(100-Transparency)*GetRValue(TranspColor)) div 100;
G:=(Transparency*GetGValue(Color2)+(100-Transparency)*GetGValue(TranspColor)) div 100;
B:=(Transparency*GetBValue(Color2)+(100-Transparency)*GetBValue(TranspColor)) div 100;
Color1:=rgb(r,g,b);
SetPixel(DC, X,Y, Color1);
end;
//BitBlt(DC, 0, 0, 100, 70, ParentDC, 20, 20, DSTINVERT);
DeleteObject(br);
EndPaint(wnd, ps);
Result:=0;
end;
WM_ERASEBKGND: Result:=1;
wm_destroy :
Begin
postquitmessage(0); exit;
Result:=0;
End;

else Result:=DefWindowProc(wnd,msg,wparam,lparam);
end;
end;

var xPos,yPos,nWidth,nHeight : Integer;

begin
wc.cbSize:=sizeof(wc);
//wc.style:=cs_hredraw or cs_vredraw;
wc.lpfnWndProc:=@WindowProc;
wc.cbClsExtra:=0;
wc.cbWndExtra:=0;
wc.hInstance:=HInstance;
wc.hIcon:=LoadIcon(0,idi_application);
wc.hCursor:=LoadCursor(0,idc_arrow);
wc.lpszMenuName:=nil;
wc.lpszClassName:="WndClass1";

RegisterClassEx(wc);

xPos:=10;
yPos:=10;
nWidth:=400;
nHeight:=250;

MainWnd:=CreateWindowEx(0,"WndClass1",
"Caption",
ws_overlappedwindow or WS_CLIPSIBLINGS,
xPos,yPos,nWidth,nHeight,0,0,
Hinstance,nil);

ShowWindow(MainWnd,CmdShow);

wc2.cbSize:=sizeof(wc);
wc2.style:=cs_hredraw or cs_vredraw;
wc2.lpfnWndProc:=@WindowProc2;
wc2.cbClsExtra:=0;
wc2.cbWndExtra:=0;
wc2.hInstance:=HInstance;
wc2.hIcon:=LoadIcon(0,idi_application);
wc2.hCursor:=LoadCursor(0,idc_arrow);
wc2.hbrBackground:=CreateSolidBrush(RGB(200,100,200));
wc2.lpszMenuName:=nil;
wc2.lpszClassName:="WndClass2";

RegisterClassEx(wc2);

xPos:=20;
yPos:=20;
nWidth:=100;
nHeight:=70;

ChildWnd:=CreateWindowEx(0,"WndClass2",
"Caption",
WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN ,
xPos,yPos,nWidth,nHeight,MainWnd,0,
Hinstance,nil);

ShowWindow(ChildWnd,CmdShow);

While GetMessage(Mesg,0,0,0) do
begin
TranslateMessage(Mesg);
DispatchMessage(Mesg);
end;

end.

← →
TankMan © (2004-02-25 16:37) [16]

.... мдя.... что то я не пойму... я проверил твой код - работает отлично, но такое вот создание компонентов мне неподходит, я чуть чуть изменил этот код для удобства, но почему-то это стало работать не корректно, не пойму почему :(

unit HPanels;

interface
uses ExtCtrls,Messages,WINDOWS,Classes,Controls;
type
TMainPanel=class(TPanel)
private
constructor Create(AOwner: TComponent); override;
procedure WndProc(var Msg: TMessage);override;
procedure CreateParams(var Params: TCreateParams); override;
end;

TChildPanel=class(TPanel)
private
constructor Create(AOwner: TComponent); override;
procedure WndProc(var Msg: TMessage);override;
procedure CreateParams(var Params: TCreateParams); override;
end;

implementation

constructor TMainPanel.Create(AOwner: TComponent);
begin
inherited;
end;

procedure TMainPanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style:=Params.Style or WS_CLIPSIBLINGS;
end;

procedure TMainPanel.WndProc(var Msg: TMessage);
var
DC, ParentDC: HDC;
ps: TPaintStruct;
rc: TRect;
br: HBRUSH;
Begin
case msg.Msg of

WM_ERASEBKGND: msg.Result:=1;
WM_PAINT:
begin
DC:=BeginPaint(self.Handle, ps);
Windows.GetClientRect(self.Handle, rc);
br:=CreateHatchBrush(HS_CROSS, RGB(100,200,200));
FillRect(DC, rc, br);
DeleteObject(br);
EndPaint(self.Handle, ps);
msg.Result:=0;
end;
else inherited;
end;
end;

constructor TChildPanel.Create(AOwner: TComponent);
begin
//WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN

inherited;
end;

procedure TChildPanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style:= WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
end;

procedure TChildPanel.WndProc(var Msg: TMessage);
var
DC, ParentDC: HDC;
ps: TPaintStruct;
rc: TRect;
br: HBRUSH;
X, Y: INTEGER;
Color1, Color2: Cardinal;
R, G, B:INTEGER;
TranspColor: Cardinal;
const
Transparency=40;
Begin
Begin
case msg.Msg of
WM_PAINT:
begin
DC:=BeginPaint(self.Handle, ps);
Windows.GetClientRect(self.ParentWindow, rc);
ParentDC:=GetDC(self.ParentWindow);
Windows.GetClientRect(self.ParentWindow, rc);

TranspColor:=RGB(200,250,250);

for x:=0 to 100 do
for y:=0 to 70 do
begin
Color1 := GetPixel(DC, X, Y);
Color2 := GetPixel(ParentDC, X+20, Y+20);
R:=(Transparency*GetRValue(Color2)+(100-Transparency)*GetRValue(TranspColor)) div 100;
G:=(Transparency*GetGValue(Color2)+(100-Transparency)*GetGValue(TranspColor)) div 100;
B:=(Transparency*GetBValue(Color2)+(100-Transparency)*GetBValue(TranspColor)) div 100;
Color1:=rgb(r,g,b);
SetPixel(DC, X,Y, Color1);
end;
//BitBlt(DC, 0, 0, 100, 70, ParentDC, 20, 20, DSTINVERT);
DeleteObject(br);
EndPaint(self.Handle, ps);
msg.Result:=0;
end;
WM_ERASEBKGND: msg.Result:=1;
else inherited;
end;
end;
end;
end.

← →
TankMan © (2004-02-25 16:43) [17]

Я использую этот unit, в главной программе, при Create главной формы создаю два компонента один TMainPanel другой TChildPanel

pmain:=TMainPanel.create(self);
pchild:=TChildPanel.create(self);
pmain.parent:=form1;
pchild.parent:=pmain;
//ну размеры там выставил.. но прорисовывается не правильно почему то :(
Можешь подсказать в чем моя ошибка? Или вообще так нельзя сделать? может чего лишнего написал?Помоги пожалуйста?

← →
DVM © (2004-02-25 17:35) [18]

Все работает!!! Найди отличия:)

unit HPanels;

interface
uses ExtCtrls,Messages,WINDOWS,Classes,Controls;

type
TChildPanel=class(TPanel)
private
procedure WndProc(var Msg: TMessage);override;
procedure CreateParams(var Params: TCreateParams); override;
end;

implementation

procedure TChildPanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style:= WS_BORDER or WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;

end;

procedure TChildPanel.WndProc(var Msg: TMessage);
var
DC, ParentDC: HDC;
ps: TPaintStruct;
rc: TRect;
br: HBRUSH;
X, Y: INTEGER;
Color1, Color2: Cardinal;
R, G, B:INTEGER;
TranspColor: Cardinal;
const
Transparency=50;
Begin
Begin
case msg.Msg of
WM_PAINT:
begin
DC:=BeginPaint(self.Handle, ps);
ParentDC:=GetDC(GetParent(self.Handle));
TranspColor:=RGB(200,10,10);

for x:=0 to 100 do
for y:=0 to 70 do
begin
Color1 := GetPixel(DC, X, Y);
Color2 := GetPixel(ParentDC, X+20, Y+20);
R:=(Transparency*GetRValue(Color2)+(100-Transparency)*GetRValue(TranspColor)) div 100;
G:=(Transparency*GetGValue(Color2)+(100-Transparency)*GetGValue(TranspColor)) div 100;
B:=(Transparency*GetBValue(Color2)+(100-Transparency)*GetBValue(TranspColor)) div 100;
Color1:=rgb(r,g,b);
SetPixel(DC, X,Y, Color1);
end;
//BitBlt(DC, 0, 0, 100, 70, ParentDC, 20, 20, DSTINVERT);
DeleteObject(br);
EndPaint(self.Handle, ps);
msg.Result:=0;
end;
WM_ERASEBKGND: msg.Result:=1;
else inherited;
end;
end;
end;
end.

//************************************

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, HPanels, ExtCtrls;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
TransPanel: TChildPanel;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
TransPanel:=TChildPanel.Create(self);
TransPanel.Left:=20;
TransPanel.Top:=20;
TransPanel.Width:=100;
TransPanel.Height:=70;
TransPanel.Parent:=form1;
end;

end.

Странно, а у меня не работает :(... т.е. панелька то создается, но при увеличении Transparency например до 100 то панель, становится белой а не серой как должно быть...

> Странно, а у меня не работает :(... т.е. панелька то создается,
> но при увеличении Transparency например до 100 то панель,
> становится белой а не серой как должно быть...

Алгоритм смешения цветов смотри. Может там чего поменять. Я не уверен, что он правильный на 100%.
Строчки R,G,B.

Так в том-то и фишка, я пробовал сместить область, из которой берутся пиксели родителя меняя строчку:
Color2 := GetPixel(ParentDC, X+20, Y+20);
И понял, что если пиксели берутся не из под панели, то цвет смешивается нормально :(, т.е. те пиксели которые берутся из под панели - белого цвета получаются :(

DVM, я конечно понимаю тебя и не хочу тебе загружать не нужной тебе проблемой, но просто чего уж останавливаться то на пол пути?...

> Странно, а у меня не работает :(... т.е. панелька то создается,
> но при увеличении Transparency например до 100 то панель,
> становится белой а не серой как должно быть...

в том коде, что я написал в начале (на WinApi) прозрачность работает правильно. 0%-голубая, 100% ее не видно. Так что надо искать проблему в VCL-окне и последовательности обработки сообщений родительским и дочерним окном.

В том коде, что на VCL выше нигде нет места, где убирается стиль ws_clipchildren родительского окна. Он есть у родителя или нет?

← →
webpauk (2004-02-29 14:42) [24]

http://www.delphimaster.ru/cgi-bin/download.pl?get=1078054443&n=0

← →
CrystalMind (2004-03-02 04:54) [25]

Есть несколько другая идея :) Что если использовать какой-нибудь компонентик типа TImageEn (HiComponents). У него в основе лежит скроллбох, если его сделать родителем твоей панельки, где показывается видео и обновить/перерисовать сам TImageEn, то твоя видео-панелька окажится под изображением. Затем, легким движением расслабляем альфаканал (AlphaChanelEnabled:=True) и как твоей душе угодно меняем прозрачность верхнего слоя. + Это возможность легко и просто выводить любую инфу поверх твоей видео панельки, включая твой логотип :) и прочую бурду, не в обиду будет сказано. Компонентик можно взять у них на оффсайте (www.hicomponents.com), ключик можно откопать в сети :-) С уважением, Алексей.

... я вот тут подумал, я вывожу изображение на панель, т.е. для видео рендера, я указываю, где выводить видео, любые комомпонены, расположенные на этой панели, не видны, при отображении видео на ней... и какая бы не была моя панелька прозрачной, ее всеравно не будет видно вообще, если родителем ее будет видео панель :(....
А вариант CrystalMind, я что-то не доконца понял, ты имееш ввиду, что прозрачной делать не ту панельку, которая мне нужна для управления видео, а саму панельку на которой выводится видео?... т.е. для этого мне нужно скачать компонент, и сделать его пладздармом для вывода видео?

Полупрозрачная TPanel Найти похожие ветки