3

使用：Delphi XE2、VCL 32 位应用程序、Windows 8

我正在尝试将框架的背景绘制到面板上（我正在使用 TJvPanel，因为它公开了 OnPaint 事件），这是框架的子控件。

在阅读了这篇文章并将画布添加为字段后，我仍然没有成功。

调用 ShowAddReceiptPanel 后，它应该在前景面板上绘制框架的 (TfrmMyFrame) 窗口内容，其中包含所有控件（包括网格和页面控件），在通过 ProEffectImage 方法处理后，灰度化，而是显示一个不透明的白色背景。我错过了什么吗？

这是我的代码：

type
  TfrmMyFrame = class(TFrame)
    pnlHdr: TPanel;
    pnlAddNewBG: TJvPanel;
    procedure pnlAddNewBGPaint(Sender: TObject);
  private
    { Private declarations }
    FBGImg: TProEffectImage;
    Fcnvs: TCanvas;

    procedure PaintWindow(DC: HDC); override;
    procedure ShowAddReceiptPanel;
    procedure HideAddReceiptPanel;
    procedure ResizePanel_pnlAddNewBG;

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

constructor TfrmMyFrame.Create(AOwner: TComponent);
begin
  inherited;

  FBGImg := TProEffectImage.Create(nil);
  Fcnvs := TCanvas.Create;

end;

destructor TfrmMyFrame.Destroy;
begin
  if Assigned(FBGImg) then
    FBGImg.Free;

  if Assigned(Fcnvs) then
    Fcnvs.Free;

  inherited;
end;

procedure TfrmMyFrame.ShowAddReceiptPanel;
begin
  ResizePanel_pnlAddNewBG;
  pnlAddNewBG.Visible := True;
end;

procedure TfrmMyFrame.PaintWindow(DC: HDC);
begin
  inherited;

  Fcnvs.Handle := DC;
end;

procedure TfrmMyFrame.pnlAddNewBGPaint(Sender: TObject);
var
  l, t, w, h: Integer;
  srct, drct: TRect;
begin

  // Copy Frame canvas to BGImg bitmap
  l := 0;
  t := pnlHdr.Height;
  w := ClientWidth;
  h := ClientHeight - t;

  srct := TRect.Create(l, t, w, h);
  FBGImg.Width := w;
  FBGImg.Height := h;
  drct := TRect.Create(l, t, w, h);
  FBGImg.Canvas.CopyMode := cmSrcCopy;
  FBGImg.Canvas.CopyRect(drct, Fcnvs, srct);
//  FBGImg.Picture.SaveToFile('c:\tmp\a.bmp');

  FBGImg.Effect_AntiAlias;
  FBGImg.Effect_GrayScale;

  // Draw BGImg onto Option panel
  TJvPanel(Sender).Canvas.CopyMode := cmSrcCopy;
  TJvPanel(Sender).Canvas.Draw(0, 0, FBGImg.Picture.Graphic);
end;

procedure TfrmMyFrame.ResizePanel_pnlAddNewBG;
var
  x1, y1, x2, y2: Integer;
  bmp: TBitmap;
begin
  x1 := 0;
  y1 := pnlHdr.Height;
  x2 := ClientWidth;
  y2 := ClientHeight - y1;

  pnlAddNewBG.SetBounds(x1, y1, x2, y2);
end;
4

3 回答 3

2

您分配给画布句柄的 DC 仅在 PaintWindow 调用期间有效。当它无效时，您在该函数之外使用它，因此您观察到的行为。

我认为您应该能够通过调用PaintTo方法来解决您的问题。创建一个大小合适的位图并将其画布传递给 PaintTo。

于 2013-04-05T10:55:46.630 回答
1

ATFrame没有画布。您可以像这样创建/添加一个，TCustomControl但您不必这样做。画布只是 Windows 设备上下文的一个方便的包装器。PaintWindow每当必须（部分）重绘框架时，都会调用该例程。该参数显示 DC，或者您可以使用 获得一个GetDC。

那么伪代码如下：

procedure TfrmMyFrame.PaintWindow(DC: HDC);
begin
  - Resize BG image and hide it (otherwise image itself will be copied too)
  - Paint the frame's contents to the image with:
    Self.PaintTo(FBGImg.Canvas.Handle, 0, 0)
  - Process the special effects on FBGImg
  - Paint the image onto DC with:
    BitBlt(DC, 0, 0, ClientWidth, ClientHeight, FBGImage.Canvas.Handle, 0, 0, SRCCOPY);
end;
于 2013-04-05T11:16:14.893 回答
0

访问 a Canvason a的一种简单方法是在其上TFrame添加 a并使用其属性。TPaintBoxAlign := alClientCanvas

我希望这种方法在将来也可以与任何版本的 Delphi 一起使用，因此使用它来代替PaintWindow似乎很棘手的方法。

于 2015-02-06T15:29:57.727 回答