Getting underlying window of transparent form

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: