Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1806
  • Last Modified:

Take screenshot while in fullscreen opengl game

I'm using this standard screenshot function. It get's the image fine when the game is in windowed mode, but just gives me a gray image when in fullscreen. How do I get the game image while in fullscreen?

procedure ScreenShot(destBitmap : TBitmap) ;
 var
    w,h : integer;
    DC : HDC;
    hWin : Cardinal;
 begin
      hWin := GetForegroundWindow;
      dc := GetDC(hWin) ;
      w := 1 ;
      h := 1 ;

    try
     destBitmap.Width := w;
     destBitmap.Height := h;
     BitBlt(destBitmap.Canvas.Handle,
            0,
            0,
            destBitmap.Width,
            destBitmap.Height,
            DC,
            X,
            Y,
            SRCCOPY) ;
    finally
     ReleaseDC(hWin, DC) ;
    end;
 end; 

Open in new window

0
Grant1842
Asked:
Grant1842
  • 4
  • 2
  • 2
  • +1
3 Solutions
 
jimyXCommented:
I have tried this successfully:

http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_25147197.html


procedure ScreenShot(Bild: TBitMap);
var
  c: TCanvas;
  r: TRect;
begin
  c := TCanvas.Create;
  c.Handle := GetWindowDC(GetDesktopWindow);
  try
    r := Rect(0, 0, Screen.Width, Screen.Height);
    Bild.Width := Screen.Width;
    Bild.Height := Screen.Height;
    Bild.Canvas.CopyRect(r, c, r);
  finally
    ReleaseDC(0, c.Handle);
    c.Free;
  end;
end;

Open in new window

0
 
ThommyCommented:
Check the below link for infos how to take screenshots from active window and full screen...

How to take a screenshot of the Active Window in Delphi?
http://stackoverflow.com/questions/661250/how-to-take-a-screenshot-of-the-active-window-in-delphi
0
 
Grant1842Author Commented:
Hey guys no go on full screen still get grey image.
Its quake live www.quakelive.com if that will help you.
0
The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

 
jimyXCommented:
Could you attach image sample please.
0
 
Ephraim WangoyaCommented:

Try this

uses
  DirectDraw;

procedure ScreenShot(ABitmap: TBitmap);
var
  DDSCaps: TDDSCaps;
  DesktopDC: HDC;
  DirectDraw: IDirectDraw;
  Surface: IDirectDrawSurface;
  SurfaceDesc: TDDSurfaceDesc;
begin
  if DirectDrawCreate(nil, DirectDraw, nil) = DD_OK then
    if DirectDraw.SetCooperativeLevel(GetDesktopWindow, DDSCL_EXCLUSIVE or
       DDSCL_FULLSCREEN or DDSCL_ALLOWREBOOT) = DD_OK then
    begin
      FillChar(SurfaceDesc, SizeOf(SurfaceDesc), 0);
      SurfaceDesc.dwSize := Sizeof(SurfaceDesc);
      SurfaceDesc.dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
      SurfaceDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX;
      SurfaceDesc.dwBackBufferCount := 1;
      if DirectDraw.CreateSurface(SurfaceDesc, Surface, nil) = DD_OK then
      begin
        if Surface.GetDC(DesktopDC) = DD_OK then
        try
          ABitmap.Width := Screen.Width;
          ABitmap.Height := Screen.Height;
          BitBlt(ABitmap.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DesktopDC, 0, 0, SRCCOPY);
        finally
          Surface.ReleaseDC(DesktopDC);
        end;
      end;
  end;
end;

0
 
Grant1842Author Commented:
@ewangoya that method is rather slow.  I'm trying to get enough screenshots to record video.
0
 
Grant1842Author Commented:
It works in fullscreen but is just a little too slow to use.
0
 
Ephraim WangoyaCommented:
I removed the back buffer and flipping, this should be faster

The BitBlt function tends to be slow and is the culprit here
procedure ScreenShot(ABitmap: TBitmap);
var
  DDSCaps: TDDSCaps;
  DesktopDC: HDC;
  DirectDraw: IDirectDraw;
  Surface: IDirectDrawSurface;
  SurfaceDesc: TDDSurfaceDesc;
begin
  if DirectDrawCreate(nil, DirectDraw, nil) = DD_OK then
    if DirectDraw.SetCooperativeLevel(GetDesktopWindow, DDSCL_EXCLUSIVE or
       DDSCL_FULLSCREEN or DDSCL_ALLOWREBOOT) = DD_OK then
    begin
      FillChar(SurfaceDesc, SizeOf(SurfaceDesc), 0);
      SurfaceDesc.dwSize := Sizeof(SurfaceDesc);
      SurfaceDesc.dwFlags := DDSD_CAPS;
      SurfaceDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
      SurfaceDesc.dwBackBufferCount := 0;
      if DirectDraw.CreateSurface(SurfaceDesc, Surface, nil) = DD_OK then
      begin
        if Surface.GetDC(DesktopDC) = DD_OK then
        try
          ABitmap.Width := Screen.Width;
          ABitmap.Height := Screen.Height;
          BitBlt(ABitmap.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DesktopDC, 0, 0, SRCCOPY);
        finally
          Surface.ReleaseDC(DesktopDC);
        end;
      end;
  end;
end;

Open in new window

0
 
Grant1842Author Commented:
thanks
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

  • 4
  • 2
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now