Прозрачность формы

← →
MystiX (2003-04-09 16:17) [0]

Как сделать форму прозрачной, т.е. что бы прозрачной была только форма, а все видимые компоненты на ней были обычные.
Желательно чтоб работала во всех виндах.
----
Заранее спасибо!!!

← →
Cobalt (2003-04-09 19:27) [1]

глянь вот сюда -
procedure TCustomForm.SetLayeredAttribs;
И в MSDN , насчет применения стиля окон родительского относительно дочерних

← →
NA (2003-04-09 21:16) [2]

"Во всех виндах" нереально, но в твоем случае можно сказать, что Win32s и ранее ты вряд ли можешь иметь в виду. Посему в сторону

int SetWindowRgn(
HWND hWnd, // handle to window whose window region is to be set
HRGN hRgn, // handle to region
BOOL bRedraw // window redraw flag
);

смотреть надо. Ибо все вариации на тему альфаблендs только от w2k и выше работают.
Хотя, опять же, для твоего случая, возможно, проще будет найти готовую компоненту - таких несколько штук точно рабочих есть на torry.

← →
OxOTHuK (2003-04-09 21:57) [3]

Intell писал Вот ответ: Создайте компонент Shape на форме (чтобы предать будущей форме очертание), далее:
Form.borderstyle присваиваете bsNone и на функцию FormPaint ложите код:

procedure TForm1.FormPaint(Sender: TObject);
var
I: Integer;
FullRgn,
ClientRgn,
ControlRgn: THandle;
Margin,
MarginX,
MarginY,
X,
Y: Integer;
W,H,S :Integer;
bX,bY :Integer;
c :TColor;
begin
Margin := (Width - ClientWidth) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
MarginX := Margin;
MarginY := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(MarginX, MarginY, MarginX + ClientWidth, MarginY + ClientHeight);
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
DeleteObject(ClientRgn);
for I:=0 to ControlCount-1 do
begin
X := MarginX + Controls[I].Left;
Y := MarginY + Controls[I].Top;
W:=Controls[I].Width;
H:=Controls[I].Height;
{}
if controls[i] is timage then begin
with controls[i] as tImage do begin
c:=Picture.Bitmap.Canvas.Pixels[0,0];
for bX:=0 to Picture.Bitmap.Width-1 do begin
for bY:=0 to Picture.Bitmap.Height-1 do begin
if Picture.Bitmap.Canvas.Pixels[bX,bY]<>c then begin
ControlRgn := CreateRectRgn(X+bX, Y+bY, X + bX+1, Y + bY+1);
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end;
end;
end;
end;
end else
{}
if controls[i] is tShape then begin
if W < H then S := W else S := H;
if (Controls[i] as tshape).Shape in [stSquare, stRoundSquare, stCircle] then
begin
Inc(X, (W - S) div 2);
Inc(Y, (H - S) div 2);
W := S;
H := S;
end;
Inc(W); Inc(H); Inc(S);
case (controls[i] as tshape).Shape of
stRectangle, stSquare:
ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
stRoundRect, stRoundSquare:
ControlRgn := CreateRoundRectRgn(X, Y, X + W, Y + H, S div 4, S div 4);
stCircle, stEllipse:
ControlRgn:=CreateEllipticRgn(X, Y, X + W, Y + H);
else
ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
end;
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end else
{}
begin
ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end;
end;
SetWindowRgn(Handle, FullRgn, True);
DeleteObject(FullRgn);
end;

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

const
SC_DragMove = $F012; { a magic number }
begin
ReleaseCapture;
form1.perform(WM_SysCommand, SC_DragMove, 0);
end;

← →
Malder (2003-04-09 22:30) [4]

У меня тут способ попроще есть:

нужно переопределить метод CreateParams у формы

Соответственно, в объявлении типа формы пишем:

procedure CreateParams(var Params : TCreateParams); override;

В implementation:

procedure TForm1.CreateParams(var Params : TCreateParams); begin inherited CreateParams(Params); Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT; end;

Но способ немного глючный... в общем, попробуй сам

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