image - 获取透明表单的底层窗口

Question

我不确定如何解释这一点，所以我制作了一张有助于解释情况的图像。

在这张图片中，黑色的大矩形是我的屏幕。你看到的令人惊叹的艺术就是我的壁纸。
绿色矩形是我自己的应用程序，它是一个透明表单。

我希望能够复制红色矩形并用它来做一些事情，比如将它移动到另一个位置。

我认为正在发生的事情是，我的表单下方的任何内容都绘制在 Canvas 上，因此我可以从 Canvas 中抓取矩形并将其保存为图像。可悲的是，它不是那样工作的。
谁能指出我正确的方向？

提前致谢。

Answer 1

一个简单的方法是使用 UpdateLayeredWindow
在 AlphaCannel 中使用至少值为 1 的半透明位图，以便能够轻松捕获鼠标事件。为了使示例中的窗口可见，我将值设为 10。
通常我会使用 GDI+ 库在位图上进行绘制，在此处的示例中，我尝试使用通常的 GDI 例程对位图的 Alphacannel 进行操作来达到目标​​。
我们为 MouseDown 保留两个位置，这取决于按下的按钮能够实现鼠标左键和右键的不同行为。
正如这里所实现的，左按钮将用于绘画，右按钮用于移动窗口。
一个回车键，由于 KeyPreview=true 而被捕获, 将根据 Left/Top 和选择计算坐标并使用 Bitblt 复制内容.

unit Unit7;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm7 = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
    { Private-Deklarationen }
    FDOWN: Boolean;
    FMDX: Integer;
    FMDY: Integer;
    FStartX: Integer;
    FStartY: Integer;
    FEndX: Integer;
    FEndY: Integer;
    procedure GenSnapShot;
    // procedure WMNCHitTest(var Message: TWMNCHitTest);message WM_NCHitTest;
  public
    { Public-Deklarationen }
  end;

var
  Form7: TForm7;

implementation

{$R *.dfm}

type
  pRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = ARRAY [0 .. 0] OF TRGBQuad;

Procedure SetAlpha4Red(bmp: TBitMap);
var
  pscanLine32: pRGBQuadArray;
  i, j: Integer;
begin
  for i := 0 to bmp.Height - 1 do
  begin
    pscanLine32 := bmp.Scanline[i];
    for j := 0 to bmp.Width - 1 do
    begin
      if pscanLine32[j].rgbRed = 255 then
        pscanLine32[j].rgbReserved := 255   // make red opaque
      else
        pscanLine32[j].rgbReserved := 10;  // anything else transparent
    end;
  end;
end;

procedure TForm7.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  KeyPreview := true;
end;

procedure TForm7.GenSnapShot;
var
  DC: HDC;
  BMP:TBitmap;

begin
  DC := GetDC(0);
  BMP:=TBitmap.Create;
  try
    BMP.Width :=  FEndX - FStartX;
    BMP.Height := FEndY - FStartY;
    Visible := false; // hide our window
    BitBlt(BMP.Canvas.Handle,0,0,BMP.Width,BMP.Height,DC,Left + FStartX, Top + FStartY,srcCopy);
    BMP.SaveToFile('C:\temp\Test.bmp'); // hardcoded for testing
  finally
    Visible := true;
    ReleaseDC(0, DC);
    BMP.Free;
  end;

end;

procedure TForm7.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    GenSnapShot;

end;

procedure TForm7.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in Shift then
  begin
    FDOWN := true;
    FStartX := X;
    FStartY := Y;
  end
  else if ssRight in Shift then
  begin
    FMDX := X;
    FMDY := Y;
  end;

end;

procedure TForm7.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in Shift then
  begin
    FEndX := X;
    FEndY := Y;
    Invalidate;
  end
  else if ssRight in Shift then
  begin
    Left := Left + X - FMDX;
    Top := Top + Y - FMDY;
  end;
end;

procedure TForm7.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FDOWN := False;
  Invalidate;
end;

procedure TForm7.FormPaint(Sender: TObject);
const
  C_Alpha = 1;
var
  DestPoint, srcPoint: TPoint;
  winSize: TSize;
  DC: HDC;
  blendfunc: BLENDFUNCTION;
  Owner: HWnd;
  curWinStyle: Integer;
  exStyle: Dword;
  BackImage: TBitMap;
  xx, yy: Integer;
begin

  DC := GetDC(0);
  BackImage := TBitMap.Create;
  BackImage.PixelFormat := pf32Bit;
  BackImage.Width := Width;
  BackImage.Height := Height;
  BackImage.Canvas.Brush.Color := clBlack;
  BackImage.Canvas.FillRect(Rect(0, 0, Width, Height));

  BackImage.Canvas.Pen.Color := clRed;

  // if FDown then
  begin
    if FStartX > FEndX then
      xx := FEndX
    else
      xx := FStartX;
    if FStartY > FEndY then
      yy := FEndY
    else
      yy := FStartY;
    Canvas.Brush.Style := bsClear;
    BackImage.Canvas.Rectangle(xx, yy, FEndX, FEndY);
    SetAlpha4Red(BackImage);
  end;
  try
    winSize.cx := Width;
    winSize.cy := Height;
    srcPoint.X := 0;
    srcPoint.Y := 0;

    DestPoint := BoundsRect.TopLeft;
    exStyle := GetWindowLongA(handle, GWL_EXSTYLE);
    if (exStyle and WS_EX_LAYERED = 0) then
      SetWindowLong(handle, GWL_EXSTYLE, (exStyle or WS_EX_LAYERED));

    With blendfunc do
    begin
      AlphaFormat := 1;
      BlendFlags := 0;
      BlendOp := AC_SRC_OVER;
      SourceConstantAlpha := 255 - C_Alpha;
    end;

    UpdateLayeredWindow(handle, DC, @DestPoint, @winSize, BackImage.Canvas.handle, @srcPoint, clBlack, @blendfunc, 2);

  finally
    ReleaseDC(0, DC);
    BackImage.Free;
  end;

end;

end.

正在执行的程序:



和捕获的结果: