获取透明表单的底层窗口

Question

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

在此图片中，黑色大矩形是我的屏幕。你看到的神奇艺术就是我的壁纸 绿色矩形是我自己的应用程序，它是一个透明的形式。

我希望能够复制红色矩形并使用它来做一些事情，比如把它移到另一个地方。

我认为发生的事情就是在画布上绘制的任何内容都画在画布上，所以我可以从画布中抓取矩形并将其保存为图像。可悲的是，它并没有像那样工作 有人能指出我正确的方向吗？

提前致谢。

Answer 1

一种简单的方法可以使用UpdateLayeredWindow 使用AlphaCannel中至少值为1的半透明位图，以便能够轻松捕获鼠标。为了使示例中的窗口可见，我取值为10 通常我会在Bitmap上绘制一个GDI +库，在这里的示例中，我试图通过GDI例程对位图的Alphacannel进行操作来达到目标​​。 我们为MouseDown保留两个位置，具体取决于按下的按钮，以便能够实现鼠标左键和右键的不同行为。
如此处所示，左侧按钮用于绘画，右侧用于移动窗口 由KeyPreview=true引起的按键按键将根据左/上和选择计算坐标，并使用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.

计划实施：

和捕获的结果：

Answer 2

This code by Zarko Gajic允许您截取屏幕截图并将其复制到TBitmap对象。