Farderlorn
asked on
ScreenShot of "translucent", layered windows
ScreenShot of "translucent", layered windows
How can i get a screenshot including "translucent", layered windows like you can create with alphablending ??
I need a picture of the screen, including also the "translucent", layered windows, but i don't want to change the clipboard contents.
But creating a DC and using BitBlt() or WM_PRINT, works only with normal windows.
If possible in any way, i need a short code example.
PS:
I use Delphi 6 Enterp. and it has to work with it
Thank you for any answer.
How can i get a screenshot including "translucent", layered windows like you can create with alphablending ??
I need a picture of the screen, including also the "translucent", layered windows, but i don't want to change the clipboard contents.
But creating a DC and using BitBlt() or WM_PRINT, works only with normal windows.
If possible in any way, i need a short code example.
PS:
I use Delphi 6 Enterp. and it has to work with it
Thank you for any answer.
interesting (listening :)
You don't wish to simulate the "PrintScreen"-key press ?
ASKER
I need a picture of the screen, including also the "translucent", layered windows, but i don't want to change the clipboard contents.
I don't know how to do it, but you might save the clipboard content, simulate a PrintScreen key, and then reload the clipboard data saved earlier....
just a thaught
just a thaught
ASKER
Yes, that's possible, i thaught about it, too.
But it could slow down the machine, if you have a bigger amount of data in the clipboard, and you always have, if you use 1 or 2 office - products or special software, like we do.
But it could slow down the machine, if you have a bigger amount of data in the clipboard, and you always have, if you use 1 or 2 office - products or special software, like we do.
heres a code to get a picture of the screen and it don't use the clipboard
procedure TForm1.createClick(Sender: TObject);
var
DeskTopDC: HDc;
DeskTopCanvas: TCanvas;
DeskTopRect: TRect;
Bitmap: TBitmap;
begin
DeskTopDC := GetWindowDC(GetDeskTopWind ow);
DeskTopCanvas := TCanvas.Create;
DeskTopCanvas.Handle := DeskTopDC;
DeskTopRect := Rect(0,0,Screen.Width,Scre en.Height) ;
Bitmap := TBitmap.Create;
with Bitmap do
begin
Width := Screen.Width;
Height:= Screen.Height;
PixelFormat := pfDevice;
end;
Bitmap.Canvas.CopyRect(Des kTopRect,D eskTopCanv as,DeskTop Rect);
image1.Picture.Bitmap:=bit map;
Bitmap.Free;
DesktopCanvas.Free;
ReleaseDC(GetDeskTopWindow ,DeskTopDC );
end;
procedure TForm1.createClick(Sender:
var
DeskTopDC: HDc;
DeskTopCanvas: TCanvas;
DeskTopRect: TRect;
Bitmap: TBitmap;
begin
DeskTopDC := GetWindowDC(GetDeskTopWind
DeskTopCanvas := TCanvas.Create;
DeskTopCanvas.Handle := DeskTopDC;
DeskTopRect := Rect(0,0,Screen.Width,Scre
Bitmap := TBitmap.Create;
with Bitmap do
begin
Width := Screen.Width;
Height:= Screen.Height;
PixelFormat := pfDevice;
end;
Bitmap.Canvas.CopyRect(Des
image1.Picture.Bitmap:=bit
Bitmap.Free;
DesktopCanvas.Free;
ReleaseDC(GetDeskTopWindow
end;
ASKER
This is a usually way to get a screenshot, but it does not include the "translucent", layered windows like you can create with alphablending.
You will get a screenshot, only including not "translucent" windows.
It is not possible to solve this problem with functions, you have used the last years. I could do it with a DC, like you did and then use BitBlt() with the const. CAPTUREBLT. But CAPTUREBLT does not works on my Delphi 6 Enterp., it seems not to be defined. And if i define it my self with (DWORD)0x40000000 i only get a black picture, no screenshot.
This is a hard question, and I would give 1000 points to it, but i have only 114.
You will get a screenshot, only including not "translucent" windows.
It is not possible to solve this problem with functions, you have used the last years. I could do it with a DC, like you did and then use BitBlt() with the const. CAPTUREBLT. But CAPTUREBLT does not works on my Delphi 6 Enterp., it seems not to be defined. And if i define it my self with (DWORD)0x40000000 i only get a black picture, no screenshot.
This is a hard question, and I would give 1000 points to it, but i have only 114.
ASKER
I got the solution from <Serhiy Perevoznyk>:
procedure ScreenShot(x : integer; y : integer; Width : integer; Height :
integer; bm : TBitMap);
const
CAPTUREBLT = $40000000;
var
dc: HDC; lpPal : PLOGPALETTE;
begin
{test width and height}
if ((Width = 0) OR (Height = 0)) then exit;
bm.Width := Width;
bm.Height := Height;
{get the screen dc}
dc := GetDc(0);
if (dc = 0) then exit;
{do we have a palette device?}
if (GetDeviceCaps(dc, RASTERCAPS) AND
RC_PALETTE = RC_PALETTE) then
begin
{allocate memory for a logical palette}
GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
{zero it out to be neat}
FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
{fill in the palette version}
lpPal^.palVersion := $300;
{grab the system palette entries}
lpPal^.palNumEntries :=
GetSystemPaletteEntries(dc ,0,256,lpP al^.palPal Entry);
if (lpPal^.PalNumEntries <> 0) then
begin
{create the palette}
bm.Palette := CreatePalette(lpPal^);
end;
FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
end;
{copy from the screen to the bitmap}
BitBlt(bm.Canvas.Handle,0, 0,Width,He ight,Dc,x, y,SRCCOPY OR CAPTUREBLT);
{release the screen dc}
ReleaseDc(0, dc);
end;
procedure ScreenShot(x : integer; y : integer; Width : integer; Height :
integer; bm : TBitMap);
const
CAPTUREBLT = $40000000;
var
dc: HDC; lpPal : PLOGPALETTE;
begin
{test width and height}
if ((Width = 0) OR (Height = 0)) then exit;
bm.Width := Width;
bm.Height := Height;
{get the screen dc}
dc := GetDc(0);
if (dc = 0) then exit;
{do we have a palette device?}
if (GetDeviceCaps(dc, RASTERCAPS) AND
RC_PALETTE = RC_PALETTE) then
begin
{allocate memory for a logical palette}
GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
{zero it out to be neat}
FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
{fill in the palette version}
lpPal^.palVersion := $300;
{grab the system palette entries}
lpPal^.palNumEntries :=
GetSystemPaletteEntries(dc
if (lpPal^.PalNumEntries <> 0) then
begin
{create the palette}
bm.Palette := CreatePalette(lpPal^);
end;
FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
end;
{copy from the screen to the bitmap}
BitBlt(bm.Canvas.Handle,0,
{release the screen dc}
ReleaseDc(0, dc);
end;
it's 'SRCCOPY or CAPTUREBLT' that's important
DC := GetWindowDC(0);
try
BitBlt(BackBuf.Canvas.Hand le, 0, 0, BackBuf.Width, BackBuf.Height, DC, Cx, FCy, SRCCOPY or CAPTUREBLT);
finally
ReleaseDC(0, DC);
end;
Regards,
Steve
DC := GetWindowDC(0);
try
BitBlt(BackBuf.Canvas.Hand
finally
ReleaseDC(0, DC);
end;
Regards,
Steve
as in:
const
CAPTUREBLT = $40000000;
above
const
CAPTUREBLT = $40000000;
above
No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area that this question is:
PAQ with refund
Please leave any comments here within the next seven days.
PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!
Paul (pnh73)
EE Cleanup Volunteer
I will leave a recommendation in the Cleanup topic area that this question is:
PAQ with refund
Please leave any comments here within the next seven days.
PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!
Paul (pnh73)
EE Cleanup Volunteer
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.