Cześć,
chciałbym zrobić coś takiego:
Zakrywam cały formularz jakimś komponentem (i tu właśnie nie wiem jakim) np TPanel. Chciałbym, żeby ten Panel zamazał całe tło ale w taki sposób, że widać kontury komponentów w tle ale np tekstu już nie. Czasem spotyka się taki efekt na stronach internetowych gdzie otwiera się okno modalne i każą się zalogować, zapłacić itp.
W załączniku podsyłam przykład.
Czy ktoś wie jak można taki efekt uzyskać?
Możesz dać np jakiś komponent do malowania - w Lazarusie jest TPaintBox. Zamalowujesz to jakimś kolorem i ustawiasz przezroczystość.
Najłatwiej to na pewno wstawienie komponentu typu PaintBox, rozciągnięcie go na cały formularz i ukrycie;
Po kliknięciu w przycisk w celu otworzenia jakiegoś okienka modalnego, najpierw robisz "zrzut ekranu", tyle że samego aktywnego okna, pakujesz go do pomocniczej bitmapy, obrabiasz swoim filtrem, pokazujesz PaintBox, w nim malujesz gotową bitmapę i pokazujesz okienko modalne; Po jego zamknięciu chowasz PaintBox;
Wskazówki co do robienia screenshota aktywnego okna znajdziesz tutaj; Kod na rozmywanie obrazu możesz znaleźć nawet w artykułach na 4p; Z komponentami sobie poradzisz, więc nie ma co się rozpisywać;
karpov napisał(a)
Zamalowujesz to jakimś kolorem i ustawiasz przezroczystość.
To nie takie proste - PaintBox nie ma właściwości Transparent :]
Jak chcecie wiedzieć w jaki sposób stworzyć komponent obsługujący przezroczystość to przeanalizujcie sobie kod komponentu TImage; Komponent ten umożliwia wyświetlanie obrazów z przezroczystością (np. 32-bitowy PNG), więc imeplementuje mechanizmy pobierania obrazu tła do łączenia go z półprzezroczystą grafiką załadowaną do komponentu.
Zapożyczone z projektu "Odkurzacz" :)
private
procedure PrzyciemnijOkno(Wlacz: Boolean = True);
type
TTransparentPanel = class(TPanel)
private
Bmp: TBitmap;
procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
protected
procedure CaptureBackground;
procedure Paint; override;
public
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
property Canvas;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
end;
var
{Panel symulujący ściemnienie i rozmycie okna}
P_Przyciemnij: TTransparentPanel;
procedure GBlur(Bmp: TBitmap; Radius: Single);
type
TRGB = packed record b, g, r: Byte; end;
TRGBs = packed record b, g, r: Single; end;
TRGBArray = array[0..0] of TRGB;
var
MatrixRadius: Byte;
Matrix: array[-100..100] of Single;
R, G, B, Divisor: Single;
BmpSL: ^TRGBArray;
BmpRGB: ^TRGB;
BmpCopy: Array of Array of TRGBs;
BmpCopyRGB: ^TRGBs;
x, y, mx, BmpWidth, BmpHeight: Integer;
begin
Bmp.PixelFormat := pf24bit;
if Radius <= 0 then Radius := 1
else
if Radius > 99 then Radius := 99;
Radius := Radius + 1;
MatrixRadius := Trunc(Radius);
if Frac(Radius) = 0 then Dec(MatrixRadius);
Divisor := 0;
for x := -MatrixRadius to MatrixRadius do
begin
Matrix[x] := Radius - Abs(x);
Divisor := Divisor + Matrix[x];
end;
for x := -MatrixRadius to MatrixRadius do Matrix[x] := Matrix[x] / Divisor;
BmpWidth := Bmp.Width;
BmpHeight := Bmp.Height;
SetLength(BmpCopy, BmpHeight, BmpWidth);
for y :=0 to Pred(BmpHeight) do
begin
BmpSL := Bmp.Scanline[y];
BmpCopyRGB := @BmpCopy[y,0];
for x := 0 to Pred(BmpWidth) do
begin
R := 0;
G := 0;
B := 0;
for mx := -MatrixRadius to MatrixRadius do
begin
if x + mx < 0 then BmpRGB := @BmpSL^[0]
else
if x + mx >= BmpWidth then BmpRGB := @BmpSL^[Pred(BmpWidth)]
else BmpRGB := @BmpSL^[x + mx];
B := B + BmpRGB^.b * Matrix[mx];
G := G + BmpRGB^.g * Matrix[mx];
R := R + BmpRGB^.r *Matrix[mx];
end;
BmpCopyRGB^.b := B;
BmpCopyRGB^.g := G;
BmpCopyRGB^.r := R;
Inc(BmpCopyRGB);
end;
end;
for y := 0 to Pred(BmpHeight) do
begin
BmpRGB := Bmp.ScanLine[y];
for x := 0 to Pred(BmpWidth) do
begin
R := 0;
G := 0;
B := 0;
for mx := -MatrixRadius to MatrixRadius do
begin
if y + mx <= 0 then BmpCopyRGB := @BmpCopy[0,x]
else
if y + mx >= BmpHeight then BmpCopyRGB := @BmpCopy[Pred(BmpHeight),x]
else BmpCopyRGB := @BmpCopy[y + mx,x];
B := B + BmpCopyRGB^.b * Matrix[mx];
G := G + BmpCopyRGB^.g * Matrix[mx];
R := R + BmpCopyRGB^.r * Matrix[mx];
end;
BmpRGB^.b := Round(B);
BmpRGB^.g := Round(G);
BmpRGB^.r := Round(R);
Inc(BmpRGB);
end;
end;
end;
procedure TTransparentPanel.CaptureBackground;
var
Canvas: TCanvas;
DC: HDC;
SourceRect: TRect;
begin
Bmp := TBitmap.Create;
with Bmp do
begin
PixelFormat := pf24bit;
Width := ClientWidth;
Height := ClientHeight;
end;
SourceRect.TopLeft := ClientToScreen(ClientRect.TopLeft);
SourceRect.BottomRight := ClientToScreen(ClientRect.BottomRight);
DC := CreateDC('DISPLAY', nil, nil, nil);
try
Canvas := TCanvas.Create;
try
Canvas.Handle := DC;
Bmp.Canvas.CopyRect(ClientRect, Canvas, SourceRect);
{Rozmycie Gaussowskie}
GBlur(Bmp, 6);
finally
Canvas.Handle := 0;
Canvas.Free;
end;
finally
DeleteDC(DC);
end;
end;
constructor TTransparentPanel.Create(aOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle - [csSetCaption];
end;
destructor TTransparentPanel.Destroy;
begin
Bmp.Free;
inherited;
end;
procedure TTransparentPanel.Paint;
begin
if csDesigning in ComponentState then inherited;
// would need to draw frame and optional caption here
// do NOT call inherited, the control fills its client area if you do!
end;
procedure TTransparentPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
if Visible and HandleAllocated and not (csDesigning in ComponentState) then
begin
Bmp.Free;
Bmp := nil;
Hide;
inherited;
Parent.Update;
Show;
end
else inherited;
end;
procedure TTransparentPanel.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
var
Canvas: TCanvas;
begin
if csDesigning in ComponentState then inherited
else
begin
if not Assigned(Bmp) then CaptureBackground;
Canvas := TCanvas.Create;
try
Canvas.Handle := Msg.DC;
Canvas.Draw(0, 0, Bmp);
finally
Canvas.Handle := 0;
Canvas.Free;
end;
Msg.Result := 1;
end;
end;
procedure TForm1.PrzyciemnijOkno(const FormaRodzic: TForm; Wlacz: Boolean = True);
begin
if not Wlacz then
begin
P_Przyciemnij.Free;
Exit;
end;
if Wlacz then
begin
{Tworzenie przeźroczystego panelu}
P_Przyciemnij := TTransparentPanel.Create(FormaRodzic);
with P_Przyciemnij do
begin
Visible := False;
Parent := FormaRodzic;
AutoSize := False;
DoubleBuffered := True;
Left := 0;
Top := 0;
Height := FormaRodzic.ClientHeight;
Width := FormaRodzic.ClientWidth;
Name := 'P_Przyciemnij';
BringToFront;
end;
Application.ProcessMessages;
P_Przyciemnij.Visible := True;
end;
end;
{
Wywołanie np.: poprzez komponent TMS VistaDialog.
Pamiętaj o przywrócenia okna do stanu normalnego: Najpierw (True), potem (False)
}
procedure TFormMR.DialogVistaDialogCreated(Sender: TObject);
begin
PrzyciemnijOkno;
end;
{Przywrócenie okna i zwolnienie zmiennych}
procedure TFormMR.DialogVistaDialogClose(Sender: TObject;
var CanClose: Boolean);
begin
PrzyciemnijOkno(False);
end;