Delphi XE6中的iOS7模糊叠加层

Question

Delphi XE6中的iOS7模糊叠加层

delphifiremonkeydelphi-xe5delphi-xe6

4

我之前问过这个问题，但最后删除它了，原因是1）似乎需要做的工作比我想象中的多，2）我提问的方式不好，所以被关闭了。但是，在进行更多研究之后，我决定重新访问这个功能/问题/如何实现。

我正在尝试/想要创建模糊的叠加层，如下图所示。显然，应该使用'Blur'效果来实现FMX。我的问题是：如何渲染覆盖叠加层的图像，或者如何有效地复制图像以模糊叠加层？

我考虑过只使用两个相同的位图，一个用于背景，一个用于模糊，但是我就无法捕获控件或原始背景上方的任何其他内容的模糊效果。我还认为，如果我将叠加层滚动进入和退出视图，则其外观将不会如我所希望的那样。

考虑到以上情况，这让我相信我需要动态捕获背景以使其在叠加层滚动/进入视图时变得模糊。我该怎么做，并在Delphi XE6中捕获当前显示的屏幕内容？甚至不知道从哪里开始。

* 我不拥有图像

- ThisGuy

我已经找到了如何获取完整屏幕截图的方法，但似乎在FMX中找不到有关选定区域截图的任何信息。我认为这就是我需要一个简单解决方案的全部内容。 - ThisGuy

2个回答

2

我创建了一个TFrostGlass组件，它还可以：

缓存
有背景颜色调整
圆角
边框

您可以在此处查看/下载：https://github.com/Spelt/Frost-Glass

- Edward

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Eric · Accepted Answer

经过一些关于如何捕获父控件背景的研究，我根据FMX中TMagnifierGlass类编写了以下代码（请注意，我在XE5中编写了此代码，您需要检查XE6的兼容性）：

TGlass = class(TControl)
private
  FBlur: TBlurEffect;
  FParentScreenshotBitmap: TBitmap;
  function GetSoftness: Single;
  procedure SetSoftness(Value: Single);
protected
  procedure Paint; override;
public
  constructor Create(AOwner: TComponent);
  destructor Destroy; override;
  property Softness: Single read GetSoftness write SetSoftness;
end;


{ TGlass }

constructor TGlass.Create(AOwner: TComponent);
begin

  inherited Create(AOwner);

  // Create parent background
  FParentScreenshotBitmap := TBitmap.Create(0, 0);

  // Create blur
  FBlur := TBlurEffect.Create(nil);
  FBlur.Softness := 0.6;

end;

destructor TGlass.Destroy;
begin

  FBlur.Free;
  FParentScreenshotBitmap.Free;

  inherited Destroy;

end;

function TGlass.GetSoftness: Single;
begin

  Result := FBlur.Softness;

end;

procedure TGlass.SetSoftness(Value: Single);
begin

  FBlur.Softness := Value;

end;

procedure TGlass.Paint;
var
  ParentWidth: Single;
  ParentHeight: Single;

  procedure DefineParentSize;
  begin
    ParentWidth := 0;
    ParentHeight := 0;
    if Parent is TCustomForm then
    begin
      ParentWidth := (Parent as TCustomForm).ClientWidth;
      ParentHeight := (Parent as TCustomForm).ClientHeight;
    end;
    if Parent is TControl then
    begin
      ParentWidth := (Parent as TControl).Width;
      ParentHeight := (Parent as TControl).Height;
    end;
  end;

  function IsBitmapSizeChanged(ABitmap: TBitmap; const ANewWidth, ANewHeight: Single): Boolean;
  begin
    Result := not SameValue(ANewWidth * ABitmap.BitmapScale, ABitmap.Width) or
              not SameValue(ANewHeight * ABitmap.BitmapScale, ABitmap.Height);
  end;

  procedure MakeParentScreenshot;
  var
    Form: TCommonCustomForm;
    Child: TFmxObject;
    ParentControl: TControl;
  begin
    if FParentScreenshotBitmap.Canvas.BeginScene then
      try
        FDisablePaint := True;
        if Parent is TCommonCustomForm then
        begin
          Form := Parent as TCommonCustomForm;
          for Child in Form.Children do
            if (Child is TControl) and (Child as TControl).Visible then
            begin
              ParentControl := Child as TControl;
              ParentControl.PaintTo(FParentScreenshotBitmap.Canvas, ParentControl.ParentedRect);
            end;
        end
        else
          (Parent as TControl).PaintTo(FParentScreenshotBitmap.Canvas, RectF(0, 0, ParentWidth, ParentHeight));
      finally
        FDisablePaint := False;
        FParentScreenshotBitmap.Canvas.EndScene;
      end;
  end;

begin

  // Make screenshot of Parent control
  DefineParentSize;
  if IsBitmapSizeChanged(FParentScreenshotBitmap, ParentWidth, ParentHeight) then
    FParentScreenshotBitmap.SetSize(Round(ParentWidth), Round(ParentHeight));
  MakeParentScreenshot;

  // Apply glass effect
  Canvas.BeginScene;
  try
    FBlur.ProcessEffect(Canvas, FParentScreenshotBitmap, FBlur.Softness);
    Canvas.DrawBitmap(FParentScreenshotBitmap, ParentedRect, LocalRect, 1, TRUE);
  finally
    Canvas.EndScene;
  end;

end;

使用时，只需在任何控件上方实例化TGlass，它应该会产生您想要的“玻璃”效果。