winexec
asked on
Screen capture
Hello.
Here is an example of screen capture:
procedure GetDesktop;
var
aDC,MemDC:HDC;
hBmap,OldBitmap:HBitmap;
bmp:TBitmap;
begin
aDC:=GetDC(GetDesktopWindo w);
MemDC:=CreateCompatibleDC( aDC);
hBmap:=CreateCompatibleBit map(aDC,10 24,768);
OldBitmap:=SelectObject(Me mDC,hBmap) ;
BitBlt(MemDC,0,0,1024,768, ADC,0,0,SR CCOPY);
SelectObject(MemDC,OldBitm ap);
bmp:=TBitmap.Create;
bmp.Handle:=hbmap;
bmp.SaveToFile('c:\screen. bmp');
bmp.Free;
DeleteDC(MemDC);
ReleaseDC(GetDesktopWindow ,aDC);
end;
The code is OK, the only problem being that I don't want to use the Graphix unit. The TBitmap wich I used belongs to Graphix and all I need is to save the screenshot without using that unit.
Anyone can help me?
Thanks,
Winexec
Here is an example of screen capture:
procedure GetDesktop;
var
aDC,MemDC:HDC;
hBmap,OldBitmap:HBitmap;
bmp:TBitmap;
begin
aDC:=GetDC(GetDesktopWindo
MemDC:=CreateCompatibleDC(
hBmap:=CreateCompatibleBit
OldBitmap:=SelectObject(Me
BitBlt(MemDC,0,0,1024,768,
SelectObject(MemDC,OldBitm
bmp:=TBitmap.Create;
bmp.Handle:=hbmap;
bmp.SaveToFile('c:\screen.
bmp.Free;
DeleteDC(MemDC);
ReleaseDC(GetDesktopWindow
end;
The code is OK, the only problem being that I don't want to use the Graphix unit. The TBitmap wich I used belongs to Graphix and all I need is to save the screenshot without using that unit.
Anyone can help me?
Thanks,
Winexec
ASKER
Thx for response Robn, but doesn't help me.
Sorry cause I didn't specify more clear my problem: I want to use only Windows unit, and not Graphics, Classes (which is used in your sample) etc.
Sorry cause I didn't specify more clear my problem: I want to use only Windows unit, and not Graphics, Classes (which is used in your sample) etc.
You can use CreateFile and GetMem instead of a stream. Manage canvas handles, Palettes, brushes, etc yourself (without using the Delphi units). I was just showing the algorithm used to save a bitmap image. It would come in handy when you re-write it to use only API method calls.
It would be a lot of work though. If I was doing it, I would write a DLL that would take in a bitmap handle and filename and save that to file.
It would be a lot of work though. If I was doing it, I would write a DLL that would take in a bitmap handle and filename and save that to file.
ASKER
Yes, thx, I know I can use GetMem, CreateFile etc. in the place of the Classes stream, but I'm not so advanced to do it. Also, I have to get rid of Canvas... Seems pretty hard for me...
Hm, I didn't think it's so hard :( Can you Robn gimme an example (if you had one)? Or anybody else?
I increased the points to 300, but I need a sample.
Thx.
Hm, I didn't think it's so hard :( Can you Robn gimme an example (if you had one)? Or anybody else?
I increased the points to 300, but I need a sample.
Thx.
OK, let me try ;-)
procedure TForm1.Button1Click(Sender : TObject);
var
hdcScreen,hdcCompatible: hdc;
hbmScreen:Hbitmap;
begin
hdcScreen := CreateDC('DISPLAY', nil, nil, nil);
hdcCompatible:=CreateCompa tibleDC(hd cScreen);
hbmScreen:= CreateCompatibleBitmap(hdc Screen,
GetDeviceCaps(hdcScreen, HORZRES),
GetDeviceCaps(hdcScreen, VERTRES));
SelectObject(hdcCompatible , hbmScreen);
BitBlt(hdcCompatible,0,0,G etDeviceCa ps(hdcScre en, HORZRES),
GetDeviceCaps(hdcScreen, VERTRES),hdcScreen,
0,0,SRCCOPY);
// Additional code, uses Clipbrd unit
OpenClipboard(Handle);
EmptyClipboard;
SetClipboardData(CF_BITMAP ,hbmScreen );
CloseClipboard;
DeleteObject(hbmScreen);
DeleteDC(hdcCompatible);
DeleteDC(hdcScreen);
end;
Screen is stored in hbmScreen variable of HBitmap.
This code uses Windows unit only, as wanted.
procedure TForm1.Button1Click(Sender
var
hdcScreen,hdcCompatible: hdc;
hbmScreen:Hbitmap;
begin
hdcScreen := CreateDC('DISPLAY', nil, nil, nil);
hdcCompatible:=CreateCompa
hbmScreen:= CreateCompatibleBitmap(hdc
GetDeviceCaps(hdcScreen, HORZRES),
GetDeviceCaps(hdcScreen, VERTRES));
SelectObject(hdcCompatible
BitBlt(hdcCompatible,0,0,G
GetDeviceCaps(hdcScreen, VERTRES),hdcScreen,
0,0,SRCCOPY);
// Additional code, uses Clipbrd unit
OpenClipboard(Handle);
EmptyClipboard;
SetClipboardData(CF_BITMAP
CloseClipboard;
DeleteObject(hbmScreen);
DeleteDC(hdcCompatible);
DeleteDC(hdcScreen);
end;
Screen is stored in hbmScreen variable of HBitmap.
This code uses Windows unit only, as wanted.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
OK, I tried to hard to simplify this, and gave a formular that less code, but is not as it needs to be, you should change the line
biSizeImage := (biWidth * (BitC div 8)) * biHeight;
to these Two lines -
biSizeImage := ((biWidth * biBitCount) + 31) and not 31;
biSizeImage := Integer(biSizeImage div 8) * biHeight;
this will make sure each scan line (width) is DWORD aligned
biSizeImage := (biWidth * (BitC div 8)) * biHeight;
to these Two lines -
biSizeImage := ((biWidth * biBitCount) + 31) and not 31;
biSizeImage := Integer(biSizeImage div 8) * biHeight;
this will make sure each scan line (width) is DWORD aligned
ASKER
Thx a lot Slick812, that's what I wanted :)
One more thing I need to know (out of that question, if you could help): what could be done to retrieve a black&white screenshot ?
One more thing I need to know (out of that question, if you could help): what could be done to retrieve a black&white screenshot ?
????
I am not sure what you are asking about the black&white screenshot. . . There's more to a Graphic than just calling it black&white
so I do not have any Idea what you may mean,
I true black&white is in 1 bit color depth. . . however, that is never worth doing for a Full color monitor
You probaly mean "GreyScale". . . bot there are 4 bit, 8 bit and Full color greyscale. . .
and that's something for a whole NEW question, since it ain't so easy
I am not sure what you are asking about the black&white screenshot. . . There's more to a Graphic than just calling it black&white
so I do not have any Idea what you may mean,
I true black&white is in 1 bit color depth. . . however, that is never worth doing for a Full color monitor
You probaly mean "GreyScale". . . bot there are 4 bit, 8 bit and Full color greyscale. . .
and that's something for a whole NEW question, since it ain't so easy
Here it is...
This code uses the TCanvas but that is easy enough to remove.
procedure TBitmap.WriteStream(Stream
const
PalSize: array [Boolean] of Byte = (sizeof(TRGBQuad), sizeof(TRGBTriple));
var
Size, ColorCount: DWORD;
HeaderSize: DWORD;
BMF: TBitmapFileHeader;
Save: THandle;
BC: TBitmapCoreHeader;
Colors: array [Byte] of TRGBQuad;
begin
FillChar(BMF, sizeof(BMF), 0);
BMF.bfType := $4D42;
if FImage.FSaveStream <> nil then
begin
Size := FImage.FSaveStream.Size;
if WriteSize then
Stream.WriteBuffer(Size, sizeof(Size));
Stream.Write(FImage.FSaveS
Exit;
end;
DIBNeeded;
with FImage do
begin
Size := 0;
if FDIBHandle <> 0 then
begin
InternalGetDIBSizes(FDIBHa
if FOS2Format then
begin // OS2 format cannot have partial palette
HeaderSize := sizeof(BC);
if FDIB.dsbmih.biBitCount <= 8 then
Inc(HeaderSize, sizeof(TRGBTriple) * (1 shl FDIB.dsbmih.biBitCount));
end;
Inc(Size, HeaderSize + sizeof(BMF));
FillChar(BMF, sizeof(BMF), 0);
BMF.bfType := $4D42;
Canvas.RequiredState([csHa
Save := GDICheck(SelectObject(FCan
ColorCount := GetDIBColorTable(FCanvas.F
SelectObject(FCanvas.FHand
// GetDIBColorTable always reports the full palette; trim it back for partial palettes
if (0 < FDIB.dsbmih.biClrUsed) and (FDIB.dsbmih.biClrUsed < ColorCount) then
ColorCount := FDIB.dsbmih.biClrUsed;
if (not FOS2Format) and (ColorCount = 0) and (FPalette <> 0) and not FHalftone then
begin
ColorCount := PaletteToDIBColorTable(FPa
if FDIB.dsbmih.biBitCount > 8 then
begin // optional color palette for hicolor images (non OS2)
Inc(Size, ColorCount * sizeof(TRGBQuad));
Inc(HeaderSize, ColorCount * sizeof(TRGBQuad));
end;
end;
BMF.bfSize := Size;
BMF.bfOffBits := sizeof(BMF) + HeaderSize;
end;
if WriteSize then Stream.WriteBuffer(Size, SizeOf(Size));
if Size <> 0 then
begin
FixupBitFields(FDIB);
if (ColorCount <> 0) then
begin
if (FDIB.dsbmih.biClrUsed = 0) or (FDIB.dsbmih.biClrUsed <> ColorCount) then
FDIB.dsbmih.biClrUsed := ColorCount;
if FOS2Format then RGBQuadToTriple(Colors, Integer(ColorCount));
end;
if FOS2Format then
begin
with BC, FDIB.dsbmih do
begin
bcSize := sizeof(BC);
bcWidth := biWidth;
bcHeight := biHeight;
bcPlanes := 1;
bcBitCount := biBitCount;
end;
Stream.WriteBuffer(BMF, sizeof(BMF));
Stream.WriteBuffer(BC, sizeof(BC));
end
else
begin
Stream.WriteBuffer(BMF, Sizeof(BMF));
Stream.WriteBuffer(FDIB.ds
if (FDIB.dsbmih.biBitCount > 8) and
((FDIB.dsbmih.biCompressio
Stream.WriteBuffer(FDIB.ds
end;
Stream.WriteBuffer(Colors,
Stream.WriteBuffer(FDIB.ds
end;
end;
end;