Monday, February 19, 2007

Průhledný formulář

Další z oblíbených příkladů na řadě diskusních fór je průhledný formulář. Opět se jedná spíše o ukázku možností, jak pracovat s formulářem, než o reálné použití v aplikacích. I když člověk nikdy neví.
V naší ukázce se po stisku prvního tlačítka formulář zprůhlední, po stisknutí tlačítka dvě se vše vrátí do původního stavu. Je třeba upozornit na to, že veškeré ostatní vizuální komponenty zůstanou nezměněny, takže například tlačítka se jaksi "vznášejí v prostoru". Taktéž zůstane zobrazen okraj formuláře.
private
{ Private declarations }
FullRgn, ClientRgn, CtlRgn: THandle;
procedure Pruhledny;
procedure Nepruhledny;
end;

{...}

implementation

{...}

procedure TForm1.Pruhledny;
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.Nepruhledny;
begin
FullRgn := CreateRectRgn(0, 0, Width, Height);
CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
SetWindowRgn(Handle, FullRgn, True);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Pruhledny;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Nepruhledny;
end;