Получение базового окна прозрачной формы

Question

Я не уверен, как объяснить это, поэтому я сделал изображение, которое поможет объяснить ситуацию.

На этом изображении большой черный прямоугольник - мой экран. и удивительное искусство, которое вы видите, это мои обои.
Зеленый прямоугольник - это мое собственное приложение, которое является прозрачной формой.

Я хочу, чтобы иметь возможность скопировать красный прямоугольник и использовать его, чтобы сделать что-то вроде перемещения его в другое место.

То, что я думал, что происходит, состоит в том, что все, что было под моей формой, было нарисовано на холсте, поэтому я мог просто взять прямоугольник из своего холста и сохранить его как изображение. К сожалению, это не так.
Может ли кто-нибудь указать мне в правильном направлении?

Заранее спасибо.

Answer 1

Простой способ aceive это было бы работать с UpdateLayeredWindow
с помощью полупрозрачного Bitmap с, по меньшей мере, значение OFF 1 в AlphaCannel, чтобы иметь возможность легко поймать mousevents. Чтобы сделать окно видимым в примере, я принял значение 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. 

Программа в действии:

и захваченный результат:

Answer 2

This code by Zarko Gajic позволяет сделать снимок экрана и скопировать его в объект TBitmap.