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

← →
Ag2002 (2003-03-04 18:19) [0]

Подскажите как сделать так чтобы моя форма была прозрачной а компоненты которые на ней расположены нет !!!

← →
Intell (2003-03-04 19:14) [1]

Вот ответ: Создайте компонент 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;

Надеюсь помог.

← →
Intell (2003-03-04 20:16) [2]

вариант 2 - но хуже предыдущего:

Прозрачная форма

var
FullRgn, ClientRgn, CtlRgn : THandle;

{Скрыть фон формы}
procedure TForm1.FormCreate(Sender: TObject);
var
AControl : TControl;
A, Margin, X, Y, CtlX, CtlY : Integer;
begin
Margin := ( Width - ClientWidth ) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
X := Margin;
Y := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn( X, Y, X + ClientWidth, Y + ClientHeight );
CombineRgn( FullRgn, FullRgn, ClientRgn, RGN_DIFF );
for A := 0 to ControlCount - 1 do begin
AControl := Controls[A];
if ( AControl is TWinControl ) or ( AControl is TGraphicControl )
then with AControl do begin
if Visible then begin
CtlX := X + Left;
CtlY := Y + Top;
CtlRgn := CreateRectRgn( CtlX, CtlY, CtlX + Width, CtlY + Height );
CombineRgn( FullRgn, FullRgn, CtlRgn, RGN_OR );
end;
end;
end;
SetWindowRgn(Handle, FullRgn, TRUE);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteObject(ClientRgn);
DeleteObject(FullRgn);
DeleteObject(CtlRgn);
end;

{Показать форму}
procedure TForm1.dxButton2Click(Sender: TObject);
begin
FullRgn := CreateRectRgn(0, 0, Width, Height);
CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
SetWindowRgn(Handle, FullRgn, TRUE);
end;

если возникнут вопросы, присылай на Мыло: sergein@nojabrsk.ru
помню сам долго расскапывал ответ...

← →
Beglec (2003-03-04 20:43) [3]

Вопрос на засыпку.
А как сделать прозрачную MDI child форму

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