獲取透明表格的底層窗口

Question

我不知道如何解釋這個，所以我做了一個圖像，這將有助於解釋情況。

在這張圖片中，黑色的大矩形是我的屏幕。你看到的驚人藝術是我的壁紙。
綠色的矩形是我自己的應用程序，它是一種透明的形式。

我想能夠複製紅色的矩形，並使用它來做一些東西，如將它移動到另一個位置。

我以爲發生的事情是，我的表單上的任何內容都被繪製在畫布上，所以我可以從畫布上抓住矩形並將其保存爲圖像。可悲的是，它不能這樣工作。
任何人都可以指向正確的方向嗎？

在此先感謝。

Answer 1

一個簡單的方法來aceive這將是採用半透明的位圖至少在AlphaCannel關閉1值，以便能夠輕易地捕獲mousevents與UpdateLayeredWindow
工作。爲了使窗口在示例中可見，我使用了10的值。
通常我會在GDI +庫上繪製位圖，在這個例子中，我試圖用普通的GDI來實現目標，位圖。
我們爲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對象。