Getting underlying window of transparent form - image

Question

I'm not sure how to explain this so I made an image which will help explaining the situation.
In this image the big black rectangle is my screen. and the amazing art you see is my wallpaper.
The green rectangle is my own application which is a transparent form.
I want to be able to copy the red rectangle and use it to do some stuff with like moving it to another location.
What I thought that was happening is that whatever is under my form was drawn on the canvas so I could just grab the rectangle from my canvas and save it as an image. Sadly it doesn't work like that.
Can anyone point me in the right direction?
Thanks in advance.

Answer 1

An easy way to aceive this would be to work with UpdateLayeredWindow
using a semitransparent Bitmap with at least a value off 1 in the AlphaCannel to be able to catch mousevents easily. To make the window visible in the example I took a value of 10.
Usually I would take a GDI+ library to paint on the Bitmap, in the example here I tried to reach the goal with usual GDI routined an manipulation off the Alphacannel of the bitmap.
We keep two positions for MouseDown, depending on the button pressed to be able to implement diffent behaviour for the Left and the right mouse button.
As implemented here the left button would be used for painting, the right on for moving the window.
A keypress of enter, caught due to KeyPreview=true, will calculate the coordinates depending on Left/Top and the selection and copy the content using 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.
Program in action:
and the captured result: