Hintergrundform abdunkeln, wenn andere Form Modal geöffnet wird?

[NoGAD]

(Eigener Thread, wegen neuem Code)

Delphi-Quellcode:

Type
  TDimmFormValues = record
    aForm: TForm;
    aParentForm: TForm;
    aDimmed: Boolean;
    aCentered: Boolean;
    aSpaceBelow: Integer;
    aAlphaBlendValue: Integer;
    aBackColor: TColor;
    aFadeIn: Boolean;
    aFadeOut: Boolean;

    class function Init(
      aDimmed: Boolean = True;
      aCentered: Boolean = True;
      aSpaceBelow: Integer = 0;
      aAlphaBlendValue: Integer = 192;
      aBackColor: TColor = clBlack;
      aFadeIn: Boolean = True;
      aFadeOut: Boolean = True): TDimmFormValues; static;
  end;

function ShowModalDimmed(const Dimm_Values: TDimmFormValues): TModalResult;
function GetFormShadow(aForm: TForm): TRect;

implementation

class function TDimmFormValues.Init(
  aDimmed: Boolean = True;
  aCentered: Boolean = True;
  aSpaceBelow: Integer = 0;
  aAlphaBlendValue: Integer = 192;
  aBackColor: TColor = 0;
  aFadeIn: Boolean = True;
  aFadeOut: Boolean = True): TDimmFormValues;
begin
  Result.aDimmed := aDimmed;
  Result.aCentered := aCentered;
  Result.aSpaceBelow := aSpaceBelow;
  Result.aAlphaBlendValue := aAlphaBlendValue;
  Result.aBackColor := aBackColor;
  Result.aFadeIn := aFadeIn;
  Result.aFadeOut := aFadeOut;
end;

function ShowModalDimmed(const Dimm_Values: TDimmFormValues): TModalResult;
var
  Back: TForm;

  Dummy_Rect: TRect;

  targetAlpha: Integer;
  Dummy_Alpha_inc: Integer;
  alphaDiff: Integer;
begin
  (* Hintergrundform abdunkeln *)
  if not Dimm_Values.aDimmed then
  begin
    Result := Dimm_Values.aForm.ShowModal;
    Exit;
  end;

  Back := TForm.Create(nil);
  try
    Back.Position := poDesigned; // poMainFormCenter;
    Back.AlphaBlend := True;

    targetAlpha := Dimm_Values.aAlphaBlendValue;
    if targetAlpha > 255 then
      targetAlpha := 255;
    if targetAlpha < 1 then
      targetAlpha := 1;

    if Dimm_Values.aFadeIn then
      Back.AlphaBlendValue := 1
    else
      Back.AlphaBlendValue := targetAlpha;
    Back.Color := Dimm_Values.aBackColor;
    Back.DoubleBuffered := True;
    Back.BorderStyle := bsNone;

    if Dimm_Values.aParentForm <> nil then
    begin
      Dummy_Rect := GetFormShadow(Dimm_Values.aParentForm);
      Back.SetBounds(Dimm_Values.aParentForm.Left + Dummy_Rect.Left, Dimm_Values.aParentForm.Top + Dummy_Rect.Top, Dimm_Values.aParentForm.Width - Dummy_Rect.Right, Dimm_Values.aParentForm.Height - Dummy_Rect.Bottom);
    end;
    if Dimm_Values.aParentForm = nil then
    begin
      Back.SetBounds(0, 0, Screen.Width, Screen.Height);
    end;
    Back.Show;
    if Dimm_Values.aFadeIn then
    begin
      Dummy_Alpha_inc := Back.AlphaBlendValue;
      while Back.AlphaBlendValue < targetAlpha do
      begin
        alphaDiff := targetAlpha - Back.AlphaBlendValue;
        Inc(Dummy_Alpha_inc, min(alphaDiff, 5));
        Back.AlphaBlendValue := Dummy_Alpha_inc;
        Application.ProcessMessages;
        Sleep(20);
      end;
      Back.AlphaBlendValue := Dimm_Values.aAlphaBlendValue;
    end;

    if Dimm_Values.aCentered then
    begin
      Dimm_Values.aForm.Position := poMainFormCenter; // Keine extra Berechnung notwendig
    end;

    Result := Dimm_Values.aForm.ShowModal;

    if Dimm_Values.aFadeOut then
    begin
      while Back.AlphaBlendValue > 1 do
      begin
        Back.AlphaBlendValue := Back.AlphaBlendValue - 12;
        Application.ProcessMessages;
        Sleep(20);
      end;
    end;
    Back.Hide;
  finally
    Back.Free;
  end;
end;

function GetFormShadow(aForm: TForm): TRect;
var
  R1, R2: TRect;
begin
  (* Breite eines Schattens einer TForm *)
  Result := default (TRect);
  if (Win32MajorVersion >= 6) and DwmCompositionEnabled then
  begin
    if DwmGetWindowAttribute(aForm.Handle, DWMWA_EXTENDED_FRAME_BOUNDS, @R1, SizeOf(R1)) = S_OK then
    begin
      R2 := aForm.BoundsRect;
      Result.Left := R2.Left - R1.Left; // Linke Breite des Schattens
      if Result.Left < 0 then
        Result.Left := Result.Left * -1;
      Result.Right := (R2.Right - R1.Right) + Result.Left; // Rechte Breite des Schattens
      if Result.Right < 0 then
        Result.Right := Result.Right * -1;
      Result.Top := R2.Top - R1.Top; // Obere Höhe des Schattens
      if Result.Top < 0 then
        Result.Top := Result.Top * -1;
      Result.Bottom := (R2.Bottom - R1.Bottom) + Result.Top; // Untere Höhe des Schattens
      if Result.Bottom < 0 then
        Result.Bottom := Result.Bottom * -1;
    end;
  end;

end;

Falls nun viele Aufrufe von ShowModalDimmed im Code erfolgen, würde ich eine globale Variable nutzen, damit nicht jedes Mal eine neue Variable erstellt werden muss. Durch class function TDimmFormValues.Init kann diese wieder auf die Standardwerte zurück gesetzt werden.

Aufruf (z.B.):

Delphi-Quellcode:

{
[..]
}
var
 Dimm_Values: TDimmFormValues;
{
[..]
}
 Dimm_Values := Dimm_Values.Init();
 Dimm_Values.aForm := Form2;
 Dimm_Values.aParentForm := Form1;
 Dimm_Values.aBackColor := clInfoBk;
 ShowModalDimmed(Dimm_Values);

LG Mathias