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

[NoGAD]

Hallo nochmal


Edit: Problem gelöst, siehe Anmerkungen im Code..


Den Code von Uwe habe ich versucht etwas zu erweiteren, was auch ganz gut klappt.
(Mir gefällt die Parameterliste in der Functionsübergabe noch nicht, das würde ich später als einen Type realiseren.)

Den Schatten der Form kann man auslesen (ein Beispiel habe ich hier gefunden: https://stackoverflow.com/questions/...rs-of-the-form, leider ergibt das bei mir aber Fehler: die Breiten/Höhen werden nicht korrekt ausgelesen.
Die entsprechende Form ist schon sichtbar, daran kann es wohl nicht liegen.

Delphi-Quellcode:

function ShowModalDimmed(Form: TForm; ParentForm: TForm = nil; aDimmed: Boolean = True; Centered: Boolean = True; SpaceBelow: Integer = 0; aAlphaBlendValue: Integer = 192; aBackColor: TColor = clBlack;
  aFadeIn: Boolean = True; aFadeOut: Boolean = True): TModalResult;
var
  Back: TForm;

  Dummy_Rect: TRect;

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

  Back := TForm.Create(nil);
  try
    Back.Position := poDesigned; //poMainFormCenter; <- war ein Fehler von mir
    Back.AlphaBlend := True;

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

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

    if ParentForm <> nil then
    begin
      Dummy_Rect := GetFormShadow(ParentForm);
      Back.SetBounds(ParentForm.Left + Dummy_Rect.Left, ParentForm.Top + Dummy_Rect.Top, ParentForm.Width - Dummy_Rect.Right, ParentForm.Height - Dummy_Rect.Bottom);
    end;
    if ParentForm = nil then
    begin
      Back.SetBounds(0, 0, Screen.Width, Screen.Height);
    end;
    Back.Show;
    if 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 := aAlphaBlendValue;
    end;

    if Centered then
    begin
      Form.Position := poMainFormCenter; // Keine extra Berechnung notwendig; außerdem für mehrere Monitore geeignet
    end;

    Result := Form.ShowModal;

    if 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;
(* uses: Winapi.DwmApi *)
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;

Delphi-Quellcode:

(* Diese beiden Brechnungen waren nicht korrekt *)
      Result.Right := (R2.Right - R1.Right) + Result.Left; // Rechte Breite des Schattens
      Result.Bottom := (R2.Bottom - R1.Bottom) + Result.Top; // Untere Höhe des Schattens

Ich hoffe, das ist jetzt fehlerfrei

LG Mathias