Прозрачность окна

← →
webpauk © (2008-01-29 17:09) [0]

Делаю окно полупрозрачным.
Как делаю - не понимаю.
Точнее понимаю как, но не понимаю почему это происходит.
Привожу код:

unit Unit1; interface uses Windows, Messages, Classes, Graphics, Forms; type TRGB = record B, G, R: Byte; end; pRGB = ^TRGB; TForm1 = class(TForm) procedure FormPaint(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private fBmp: TBitmap; PrevParentWndProc: Pointer; procedure NewParentWndProc(var Msg: TMessage); end; var Form1: TForm1; FTransparency: Integer; FTranspColor: TColor; implementation {$R *.dfm} {Ñìåøèâàíèå öâåòîâ} function MixBytes(FG, BG, TRANS: byte): byte; asm push bx push cx push dx mov DH,TRANS mov BL,FG mov AL,DH mov CL,BG xor AH,AH xor BH,BH xor CH,CH mul BL mov BX,AX xor AH,AH mov AL,DH xor AL,$FF mul CL add AX,BX shr AX,8 pop dx pop cx pop bx end; {Âûçîâ ïðîöåäóðû ñìåøèâàíèÿ öâåòîâ äëÿ êàæäîãî pixel} procedure MixColors(Bitmap: TBitmap; Color: TColor); var x, y: Integer; Dest: pRGB; fR, fG, fB: Byte; begin fR:=GetRValue(FTranspColor); fG:=GetGValue(FTranspColor); fB:=GetBValue(FTranspColor); for y := 0 to Bitmap.Height - 1 do begin Dest := Bitmap.ScanLine[y]; for x := 0 to Bitmap.Width - 1 do begin with Dest^ do begin R:=MixBytes(fR, R, FTransparency); G:=MixBytes(fG, G, FTransparency); B:=MixBytes(fB, B, FTransparency); end; Inc(Dest); end; end; end; {çàõâàò DC è îòðèñîâêà íà Canvas} procedure TForm1.FormPaint(Sender: TObject); var DC: hDC; P, A: Tpoint; begin P:=Point(0, 0); A:=ClientToScreen(P); DC:=GetDC(0); BitBlt(fBmp.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, DC, A.X, A.Y, SrcCopy); ReleaseDC(0, DC); MixColors(fBmp, FTranspColor); BitBlt(Canvas.Handle, P.X, P.Y, fBmp.Width, fBmp.Height, fBmp.canvas.Handle, 0, 0, SRCCOPY); end; procedure TForm1.FormCreate(Sender: TObject); var p: Pointer; begin TransparentColorValue:=$00000001; TransparentColor:=True; FTransparency:=150; FTranspColor:=clBlue; fBmp:=TBitmap.Create; fBmp.Width:=ClientWidth; fBmp.Height:=ClientHeight; fBmp.PixelFormat := pf24Bit; PrevParentWndProc:=Pointer(GetWindowLong(Handle, GWL_WNDPROC)); p:=MakeObjectInstance(NewParentWndProc); SetWindowLong(Handle, GWL_WNDPROC, LongInt(p)); end; procedure TForm1.FormDestroy(Sender: TObject); begin fBmp.Free; if HandleAllocated then SetWindowLong(Handle, GWL_WNDPROC, LongInt(PrevParentWndProc)); end; procedure TForm1.NewParentWndProc(var Msg: TMessage); begin Msg.Result:=CallWindowProc(PrevParentWndProc, Handle, Msg.Msg, Msg.WParam, Msg.LParam); case Msg.Msg of wm_Move, WM_ACTIVATE: Paint; end; end; end.

развивалось следующим образом:
1. сначала скрывалось окно, потом захватывался DC, потом окно отображалось и на нем рисовалась часть DC.
2. Возникла идея не скрывать окно, а вырезать его часть, захватывая DC.
3. Вырезать можно используя TransparentColor. Собственно говоря данный пример и должен был сначала Canvas заливать TransparentColorValue, захватывать DC, потом заливать не TransparentColorValue и рисовать часть контекста. Но в данном примере ничего не вырезается!!!! И всё работает!!!!
Может кто-нибудь поймет почему?

← →
homm © (2008-01-29 17:11) [1]

> [0] webpauk © (29.01.08 17:09)
> Как делаю - не понимаю.

+1!

← →
webpauk © (2008-01-29 17:14) [2]

> homm © (29.01.08 17:11) [1]

8(
сам того же мнения

← →
webpauk © (2008-01-29 17:15) [3]

TransparentColor:=False;
тогда ничего не работает. Почему?

← →
Dimaxx © (2008-01-29 17:35) [4]

http://www.delphikingdom.com/asp/viewitem.asp?catalogid=30

← →
webpauk © (2008-01-29 17:55) [5]

> Dimaxx © (29.01.08 17:35) [4]

цитата из ссылки: "При необходимости перерисовать полупрозрачное окно надо это окно ненадолго убрать с экрана"

Это не мой вариант!!!

> webpauk © (29.01.08 17:09)
развивалось следующим образом:
1. сначала скрывалось окно, потом захватывался DC, потом окно отображалось и на нем рисовалась часть DC.
2. Возникла идея не скрывать окно, а вырезать его часть, захватывая DC.
3. Вырезать можно используя TransparentColor. Собственно говоря данный пример и должен был сначала Canvas заливать TransparentColorValue, захватывать DC, потом заливать не TransparentColorValue и рисовать часть контекста. Но в данном примере ничего не вырезается!!!! И всё работает!!!!
Может кто-нибудь поймет почему?

Вопрос не раскрыт: TransparentColor:=False/True - не работает/работает. Почему? Ведь нигде не производится заливка!

← →
Dimaxx © (2008-01-29 17:57) [6]

Вот как реализовано в KOL:

procedure TControl.SetAlphaBlend(const Value: Integer); const LWA_COLORKEY=$00000001; LWA_ALPHA=$00000002; ULW_COLORKEY=$00000001; ULW_ALPHA=$00000002; ULW_OPAQUE=$00000004; WS_EX_LAYERED=$00080000; type TSetLayeredWindowAttributes= function( hwnd: Integer; crKey: TColor; bAlpha: Byte; dwFlags: DWORD ) : Boolean; stdcall; var SetLayeredWindowAttributes: TSetLayeredWindowAttributes; User32: THandle; dw: DWORD; begin if Value = fAlphaBlend then Exit; fAlphaBlend := Value; User32 := GetModuleHandle( "User32" ); SetLayeredWindowAttributes := GetProcAddress( User32, "SetLayeredWindowAttributes" ); if Assigned( SetLayeredWindowAttributes ) then begin dw := GetWindowLong( GetWindowHandle, GWL_EXSTYLE ); if Byte( Value ) < 255 then begin SetWindowLong( fHandle, GWL_EXSTYLE, dw or WS_EX_LAYERED ); SetLayeredWindowAttributes( fHandle, 0, Value and $FF, LWA_ALPHA); end else SetWindowLong( fHandle, GWL_EXSTYLE, dw and not WS_EX_LAYERED ); end; end;

Раз у тебя ХРюша - это как раз то.

← →
webpauk © (2008-01-29 18:01) [7]

> Dimaxx © (29.01.08 17:57) [6]

AlphaBlend-устанавливает прозрачность для ВСЕЙ формы. Мне нужна часть!!!

← →
webpauk © (2008-01-29 18:04) [8]

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

а вот еще один метод прозрачности:
есть две формы одна со включенным alphablend, а вторая нет.
на одну из форм цепляем процедуры:

private procedure WMPOCHANGE(var Msg: TMessage); message WM_WINDOWPOSCHANGED; procedure wmhittest(var Msg: TMessage); message WM_NCHITTEST; procedure TForm1.WMPOCHANGE(var Msg: TMessage); begin inherited; if Form2=nil then exit; Form2.Left:=Left+20; Form2.Top:=Top+20; form2.BringToFront; end; procedure TForm1.wmhittest(var Msg: TMessage); var P: TPoint; begin inherited; p := Point(msg.LParamLo, msg.LParamHi); p := ScreenToClient(p); if PtInRect(Rect(0, 0, Width, 20), P) then Msg.Result:=HTCAPTION; end;

Любители сложных решений, блин.
Вы ето
gif с прозрачными областями,
png с переменной прозрачностью
или вообще psd со всеми наворотами для скинов не думали прикрутить?
Удачных вам подводных камней.

> Ведь нигде не производится заливка!

WM_ERASEBKGND

Прозрачность окна Найти похожие ветки