Solved

Delphi: Screenshot opengl game full screen

Posted on 2013-11-05
36
1,938 Views
Last Modified: 2013-11-25
I need help to take screenshots fullscreen game (quake live).

This can take screenshots but only if i hit alt+tab:

procedure CaptureScreen(const FileName: string;Const FileType: TD3DXImageFileFormat);
var
pD3D: IDirect3D9;
pSurface: IDirect3DSurface9;
g_pD3DDevice: IDirect3DDevice9;
D3DPP: TD3DPresentParameters;
begin
FillChar(d3dpp, SizeOf(d3dpp), 0);
With D3DPP do
 Begin
  Windowed := True;
  Flags := D3DPRESENTFLAG_LOCKABLE_BACKBUFFER;
  SwapEffect := D3DSWAPEFFECT_DISCARD;
  BackBufferWidth := Screen.Width;
  BackBufferHeight := Screen.Height;
  BackBufferFormat := D3DFMT_X8R8G8B8;
 end;
pD3D := Direct3DCreate9(D3D_SDK_VERSION);
pD3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, GetDesktopWindow,D3DCREATE_SOFTWARE_VERTEXPROCESSING, @D3DPP, g_pD3DDevice);
 Try
  g_pD3DDevice.CreateOffscreenPlainSurface(Screen.Width, Screen.Height, D3DFMT_A8R8G8B8, D3DPOOL_SCRATCH, pSurface, nil);
  g_pD3DDevice.GetFrontBufferData(0, pSurface);
  D3DX9.D3DXSaveSurfaceToFile(PChar(FileName),FileType,pSurface,nil,nil);
 Finally
  pSurface := nil;
  g_pD3DDevice := nil;
  pD3D := nil;
 End;
end;

Open in new window


ssSave := ExtractFilePath(Application.ExeName);
ssNome_local := ssSave + FormatDateTime('dd_mm_yyyy', now) + '_' + FormatDateTime('hh_mm_ss', now);
CaptureScreen(ssNome_local + '.jpeg', D3DXIFF_JPG);

Open in new window


I need to do it while playing in fullscreen.
I try, Windowed := False; but don't work.

ty
0
Comment
Question by:Júlio
  • 22
  • 7
  • 6
  • +1
36 Comments
 

Author Comment

by:Júlio
ID: 39627635
Opengl code, don't work too, all black.

Procedure QLSS(salvar: string);
var
   pbuf: pointer;
   y: integer;
   bmp: TBitmap;
   p1, p2: pointer;
begin
   GetMem( pbuf, Screen.Width * Screen.Height * 4);
   glReadBuffer(GL_FRONT);
   glReadPixels( 0, 0, Screen.Width, Screen.Height, GL_RGBA, GL_UNSIGNED_BYTE, pbuf);
   bmp := TBitmap.Create;
   bmp.PixelFormat := pf32bit;
   bmp.Width := Screen.Width;
   bmp.Height := Screen.height;
   for y := 0 to (Screen.Height -1) do
   begin
      p1 := bmp.ScanLine[y];
      p2 := pointer( integer(pbuf)+ (y * bmp.Width * 4));
      CopyMemory( p1, p2, bmp.Width * 4);
   end;
   bmp.SaveToFile(salvar);
   bmp.Free;
   FreeMem( pbuf);
end;

Open in new window

0
 

Author Comment

by:Júlio
ID: 39631043
This only in windowed mode:

procedure SShot(shot: string);
 var
  dibH : hBitmap;
  bits : pointer;
  info : TBITMAPINFO;
  width,height : integer;
  screenDC,dibDC : hDC;
  f : file of byte;
  FileHeader : TBITMAPFILEHEADER;
begin
    screenDC := getDC(getDeskTopWindow);
    dibDC := createCompatibleDC(screenDC);
    width := getDeviceCaps(screenDC,HORZRES);
    height := getDeviceCaps(screenDC,VERTRES);
    info.bmiHeader.biXPelsPerMeter := round(getDeviceCaps(screenDC,LOGPIXELSX)*39.37);
    info.bmiHeader.biYPelsPerMeter := round(getDeviceCaps(screenDC,LOGPIXELSY)*39.37);
    zeromemory(@info,sizeOf(info));
    with info.bmiHeader do
    begin
         biSize := sizeOf(TBITMAPINFOHEADER);
         biWidth := width;
         biheight := height;
         biplanes := 1;
         biBitCount := 24;
         biCompression := BI_RGB;
    end;
    dibH := createDIBSection(dibDC,info,DIB_RGB_COLORS,bits,0,0);
    selectObject(dibDC,dibH);
    bitblt(
           dibDC,
           0,0,width,height,
           screenDC,
           0,0,
           SRCCOPY);
    releaseDC(getDeskTopWindow,screenDC);
    assignFile(f,shot);
    reWrite(f);

    if width and 3 <> 0 then
       width := 4*((width div 4)+1);

    with fileHeader do
    begin
         bfType := ord('B')+(ord('M')shl 8);
         bfSize := sizeOf(TBITMAPFILEHEADER)+sizeOf(TBITMAPINFOHEADER)+width*height*3;
         bfOffBits := sizeOf(TBITMAPINFOHEADER);
    end;

    blockWrite(f,fileHeader,sizeOf(TBITMAPFILEHEADER));
    blockWrite(f,info.bmiHeader,sizeOf(TBITMAPINFOHEADER));
    blockWrite(f,bits^,width*height*3);
    closeFile(f);
    deleteObject(dibH);
    deleteDC(dibDC);
end;

Open in new window

0
 
LVL 25

Expert Comment

by:Sinisa Vuk
ID: 39632178
I try your code and with little modification work for me:

procedure CaptureScreen(const FileName: string;Const FileType: TD3DXImageFileFormat);
var
  pD3D: IDirect3D9;
  pSurface: IDirect3DSurface9;
  g_pD3DDevice: IDirect3DDevice9;
  D3DPP: TD3DPresentParameters;
begin
  FillChar(d3dpp, SizeOf(d3dpp), 0);
  With D3DPP do
  Begin
    Windowed := True;
    Flags := D3DPRESENTFLAG_LOCKABLE_BACKBUFFER or D3DPRESENTFLAG_DEVICECLIP or D3DPRESENTFLAG_VIDEO;
    SwapEffect := D3DSWAPEFFECT_DISCARD;
    BackBufferWidth := Screen.Width;
    BackBufferHeight := Screen.Height;
    BackBufferFormat := D3DFMT_X8R8G8B8;
  end;

  pD3D := Direct3DCreate9(D3D_SDK_VERSION);
  pD3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, GetDesktopWindow,
    D3DCREATE_SOFTWARE_VERTEXPROCESSING, @D3DPP, g_pD3DDevice);
  Try
    g_pD3DDevice.CreateOffscreenPlainSurface(Screen.Width, Screen.Height, D3DFMT_A8R8G8B8,
      D3DPOOL_SYSTEMMEM, pSurface, nil); //D3DPOOL_SCRATCH
    g_pD3DDevice.GetFrontBufferData(0, pSurface);
    Winapi.D3DX9.D3DXSaveSurfaceToFile(PChar(FileName),FileType,pSurface,nil,nil);
  Finally
    pSurface := nil;
    g_pD3DDevice := nil;
    pD3D := nil;
  End;
end;

Open in new window


another versions are described in old EE quesitons:
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_26614393.html
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_25147197.html

GL variant:
(using: dglOpenGL.pas)
procedure CaptureScreen2(const AFileName: string);
var
  hWin: HWND;
  MyDC: HDC;
  MyRC: HGLRC;
  pPixels: PIntegerArray;
  pLine: PIntegerArray;
  bmp: TBitmap;
  i, j, iWidth, iHeight: Integer;
  rgba: Cardinal;
begin
  InitOpenGL;
  iWidth := Screen.Width;
  iHeight := Screen.Height;
  hWin := GetDesktopWindow;
  MyDC := GetDc(hWin);
  MyRC := CreateRenderingContext(MyDC, [opDoubleBuffered], 32, 24, 8, 0, 0, 0);
  ActivateRenderingContext(MyDC, MyRC);
  try
    bmp := TBitmap.Create;
    try
      //get buffer memory
      GetMem(pPixels, iWidth * iHeight * 4);
      try
        bmp.PixelFormat := pf32bit;
        bmp.Height := iHeight;
        bmp.Width := iWidth;
        //set byte align?
        glPixelStorei(GL_PACK_ALIGNMENT, 1);
        //gl which gl buffer
        glReadBuffer(GL_FRONT);
        //get pixels
        glReadPixels(0, 0, iWidth, iHeight, GL_RGBA, GL_UNSIGNED_BYTE, pPixels);
        //scan each line from bitmap and copy color bytes with byte transformation
        for i := 0 to iHeight-1 do
        begin
          pLine := bmp.ScanLine[i];
          //get each 32bit color in a row
          for j := 0 to iWidth-1 do
          begin
            rgba := pPixels[(iHeight-1-i) * iWidth + j];
            pLine^[j] :=
              (rgba and $FF000000) or
              ((rgba shl 16) and $00FF0000) or
              (rgba and $0000FF00) or
              ((rgba shr 16) and $000000FF);  //abgr -> argb
          end;
        end;
        bmp.SaveToFile(AFileName);
      finally
        FreeMem(pPixels);
      end;
    finally
      bmp.Free;
    end;
  finally
    //Deactivates current context
    DeactivateRenderingContext;
    wglDeleteContext(myRC);
    ReleaseDC(GetDesktopWindow, myDC);
  end;
end;

Open in new window

0
 

Author Comment

by:Júlio
ID: 39632452
1- OpenGl code error:

delphi system error. Code: -1073283066
dglOpenGL unit:  DescribePixelFormat(DC, PixelFormat, SizeOf(PFDescriptor), PFDescriptor);
Error all time.

I think the problem is here:

MyRC := CreateRenderingContext(MyDC, [opDoubleBuffered], 32, 24, 8, 0, 0, 0); With the "MyDC"

I change de opDoubleBuffered to opGDI, but the schreenshot is gray, but don't give error and it's very slow to create the file.
opDoubleBuffered = with acceleration, opGDI without acceleration.

I'm using the last nvidia driver 331.65 (opengl 4.3).

2- Directx Code error:

Access violation at addres 00524821... Read of address 0000000000.

These error happen when I enter the game full screen.

What you need to help me?
opengl-screen-problem.PNG
0
 
LVL 25

Expert Comment

by:Sinisa Vuk
ID: 39632822
Seem that in that moment MyDC is zero. These threads try to use window handle from game and DC from it but think without success:
Topic 1 and
Topic 2

try to use zero for handle:
hWin := 0;
MyDC := GetDc(hWin);
if MyDC>0 then
begin
  MyRC := CreateRenderingContext(MyDC, [opDoubleBuffered], 32, 24, 0, 0, 0, 0);
  ActivateRenderingContext(MyDC, MyRC);
...  

Open in new window

0
 

Author Comment

by:Júlio
ID: 39633229
With "0" don't work too.
What i need? Hook?

Trying this one, generate a tga file with 1kb =/:

procedure GLScreenShot(name : string);

type TTGAHEADER = packed record
    tfType : Byte;
    tfColorMapType : Byte;
    tfImageType : Byte;
    tfColorMapSpec : Array[0..4] of Byte;
    tfOrigX : Array [0..1] of Byte;
    tfOrigY : Array [0..1] of Byte;
    tfWidth : Array [0..1] of Byte;
    tfHeight : Array [0..1] of Byte;
    tfBpp : Byte;
    tfImageDes : Byte;
  end;

const MaxSize_ = 1920 * 1080 * 4 + 1;

var Buffer : array of Byte;
    c,i,j,temp : integer;
    f : file;
    tgaHeader : TTGAHEADER;
    ffwidth, ffheight : integer;
    viewport : Array[0..3] of integer;
    Bit : TBitMap;

begin
 glGetIntegerv(GL_VIEWPORT, @viewport);
 ffwidth := viewport[2];
 ffheight:= viewport[3];

 c:= ffWidth * ffHeight * 4;

 if c > maxsize_ then Exit;

 SetLength(buffer,c);

 ZeroMemory(@tgaHeader, SizeOf(tgaHeader));

    // Fill the structure with info for the image to be saved
    tgaHeader.tfImageType := 2; // TGA_RGB = 2
    tgaHeader.tfWidth[0] := ffWidth and 255;
    tgaHeader.tfWidth[1] := ffWidth shr 8;
    tgaHeader.tfHeight[0] := ffHeight and 255;
    tgaHeader.tfHeight[1] := ffHeight shr 8;
    tgaHeader.tfBpp := 24;
// glReadBuffer(GL_FRONT);
 glReadPixels(0,0,ffWidth, ffHeight, GL_RGBA, GL_UNSIGNED_BYTE, @Buffer[0]);   // get image as 32-bit format

    // swap rgb to bgr
     i := 0;
     while ( i < c) do
     begin
        temp := buffer[i];
        buffer[i] := buffer[i+2];
        buffer[i+2] := temp;
      inc(i,4);
     end;

 c := ffwidth * ffheight * 3;
 i := 0;
 j := 0;

    while ( i < c) do        // convert from 32-bit to 24 bitformat
    begin
      Buffer[i] := Buffer[j];
      Buffer[i+1] := Buffer[j+1];
      Buffer[i+2] := Buffer[j+2];
      Inc(i,3);
      Inc(j,4);
    end;

 AssignFile(f, name);
 Rewrite( f,1 );
 BlockWrite(F, tgaHeader, SizeOf(tgaHeader));
 BlockWrite(f, buffer[0], c );
 CloseFile(f);
 SetLength(buffer, 0 );

end;

Open in new window

0
 
LVL 25

Expert Comment

by:Sinisa Vuk
ID: 39633265
In Topic 1 and Topc 2 (upper post) there are few examples - can you try some?
Try to do debug with step by step (F8) and step in (F7) and go in CreateRenderingContext function wich fail to look/find place...
0
 

Author Comment

by:Júlio
ID: 39633317
I'm trying.

Debug your code give this, the problem is with PixelFormat:

 PixelFormat := ChoosePixelFormat(DC, @PFDescriptor);
  if GetPixelFormat(DC) <> PixelFormat then
    if not SetPixelFormat(DC, PixelFormat, @PFDescriptor) then
      RaiseLastOSError;
0
 
LVL 25

Expert Comment

by:Sinisa Vuk
ID: 39633425
Maybe you need right combination - couse function ChoosePixelFormat didn't find compatible format:

MyRC := CreateRenderingContext(MyDC, [opDoubleBuffered], 24, 16, 0, 0, 0, 0);

or

MyRC := CreateRenderingContext(MyDC, [opDoubleBuffered], 24, 0, 0, 0, 0, 0);

Open in new window


your example for saving in tga works?
0
 

Author Comment

by:Júlio
ID: 39633435
Yes, The problem is with PixelFormat, look what i did to get handle and now the error is:

"System Error. Code: 2000.
The pixel format is invalid."

unit unir_principal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg,
  dglOpenGL, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    procedure CaptureScreen2(const AFileName: string);
    { Private declarations }
  public
      RC        : HGLRC;
    DC        : HDC;
      FoundWindow : hwnd;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
//-------------------here
function AllWindows(wHnd: THandle; List: TStringList): Bool; stdcall;
var
 Buffer: array[0..255] of char;
begin
    SendMessage(wHnd, WM_GETTEXT, 255, LongInt(@Buffer[0]));
    if (Buffer <> '') and IsWindow(wHnd) then
      begin
        List.AddObject(Buffer, TObject(wHnd));
      end;
    Result := True;
end;
//-----------------------
{$R *.dfm}

procedure TForm1.CaptureScreen2(const AFileName: string);
var
  hWin: HWND;
  MyDC: HDC;
  MyRC: HGLRC;
  pPixels: PIntegerArray;
  pLine: PIntegerArray;
  bmp: TBitmap;
  i, j, iWidth, iHeight: Integer;
  rgba: Cardinal;
  ListIndex : Integer;
begin
  InitOpenGL;
  iWidth := Screen.Width;
  iHeight := Screen.Height;
//-------------------here
  ListIndex := ListBox1.ItemIndex;
  hWin := THandle(ListBox1.Items.Objects[ListIndex]);
//---------------------
 // hWin := GetDesktopWindow;
  MyDC := GetDc(hWin);
  MyRC := CreateRenderingContext(MyDC, [opDoubleBuffered], 32, 24, 8, 0, 0, 0);
  ActivateRenderingContext(MyDC, MyRC);
  try
    bmp := TBitmap.Create;
    try     
      GetMem(pPixels, iWidth * iHeight * 4);
      try
        bmp.PixelFormat := pf32bit;
        bmp.Height := iHeight;
        bmp.Width := iWidth;      
        glPixelStorei(GL_PACK_ALIGNMENT, 1);      
        glReadBuffer(GL_FRONT);     
        glReadPixels(0, 0, iWidth, iHeight, GL_RGBA, GL_UNSIGNED_BYTE, pPixels);    
        for i := 0 to iHeight-1 do
        begin
          pLine := bmp.ScanLine[i];   
          for j := 0 to iWidth-1 do
          begin
            rgba := pPixels[(iHeight-1-i) * iWidth + j];
            pLine^[j] :=
              (rgba and $FF000000) or
              ((rgba shl 16) and $00FF0000) or
              (rgba and $0000FF00) or
              ((rgba shr 16) and $000000FF);  //abgr -> argb
          end;
        end;
        bmp.SaveToFile(AFileName);
      finally
        FreeMem(pPixels);
      end;
    finally
      bmp.Free;
    end;
  finally   
    DeactivateRenderingContext;
    wglDeleteContext(myRC);
    ReleaseDC(GetDesktopWindow, myDC);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
 ListIndex : Integer;
begin
InitOpenGL;
//-------------------here
ListIndex := ListBox1.ItemIndex;
 FoundWindow := THandle(ListBox1.Items.Objects[ListIndex]); 
//--------------------------
if foundwindow > 0 then
begin
DC := GetDC(FoundWindow);
RC := CreateRenderingContext(DC, [opDoubleBuffered], 32, 24, 0, 0, 0, 0);
ActivateRenderingContext(DC, RC);
glEnable(GL_DEPTH_TEST);
glDepthFunc(GL_LESS);
glClearColor(0,0,0,0);
Form1.Caption := inttostr (FoundWindow);
end
else
Form1.Caption := 'Game Not Found';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
CaptureScreen2('t_est.bmp');
end;

procedure TForm1.Button3Click(Sender: TObject); //find all then i select the game
begin
ListBox1.Clear;
EnumWindows(@AllWindows, LParam(ListBox1.Items));
end;

end.

Open in new window

0
 

Author Comment

by:Júlio
ID: 39633447
With tga don't work too, i got a file with 1kb and corrupt.
The handle problem maybe is solved, now need to find a solution to pixel, let me try what you told. =)
0
 

Author Comment

by:Júlio
ID: 39633529
I fix it, but screenshot is black. =(

unit unir_principal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg,
  dglOpenGL, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ListBox1: TListBox;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    hotkey1 : Integer;
    procedure CaptureScreen2(const AFileName: string);
    procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;
    { Private declarations }
  public
    RC        : HGLRC;
    DC        : HDC;
    FoundWindow : hwnd;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

function AllWindows(wHnd: THandle; List: TStringList): Bool; stdcall;
var
 Buffer: array[0..255] of char;
begin
    SendMessage(wHnd, WM_GETTEXT, 255, LongInt(@Buffer[0]));
    if (Buffer <> '') and IsWindow(wHnd) then
      begin
        List.AddObject(Buffer, TObject(wHnd));
      end;
    Result := True;
end;

{$R *.dfm}

procedure TForm1.CaptureScreen2(const AFileName: string);
var
  hWin: HWND;
  MyDC: HDC;
  MyRC: HGLRC;
  pPixels: PIntegerArray;
  pLine: PIntegerArray;
  bmp: TBitmap;
  i, j, iWidth, iHeight: Integer;
  rgba: Cardinal;
  ListIndex : Integer;
begin
  InitOpenGL;
  iWidth := Screen.Width;
  iHeight := Screen.Height;
  ListIndex := ListBox1.ItemIndex;
  hWin := THandle(ListBox1.Items.Objects[ListIndex]);
 // hWin := GetDesktopWindow;
  MyDC := GetDc(hWin);
  MyRC := CreateRenderingContext(MyDC, [opDoubleBuffered], 24, 16, 0, 0, 0, 0);
  ActivateRenderingContext(MyDC, MyRC);
  try
    bmp := TBitmap.Create;
    try
      GetMem(pPixels, iWidth * iHeight * 4);
      try
        bmp.PixelFormat := pf32bit;
        bmp.Height := iHeight;
        bmp.Width := iWidth;
        glPixelStorei(GL_PACK_ALIGNMENT, 1);
        glReadBuffer(GL_FRONT);
        glReadPixels(0, 0, iWidth, iHeight, GL_RGBA, GL_UNSIGNED_BYTE, pPixels);
        for i := 0 to iHeight-1 do
        begin
          pLine := bmp.ScanLine[i];
          for j := 0 to iWidth-1 do
          begin
            rgba := pPixels[(iHeight-1-i) * iWidth + j];
            pLine^[j] :=
              (rgba and $FF000000) or
              ((rgba shl 16) and $00FF0000) or
              (rgba and $0000FF00) or
              ((rgba shr 16) and $000000FF);  //abgr -> argb
          end;
        end;
        bmp.SaveToFile(AFileName);
      finally
        FreeMem(pPixels);
      end;
    finally
      bmp.Free;
    end;
  finally
    DeactivateRenderingContext;
    wglDeleteContext(myRC);
    ReleaseDC(GetDesktopWindow, myDC);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
const MOD_CONTROL = 2;
VK_A = 65;
begin
hotkey1 := GlobalAddAtom('Hotkey1');
RegisterHotKey(handle, hotkey1, MOD_CONTROL,VK_A);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
UnRegisterHotKey(handle, hotkey1);
end;

procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
if msg.HotKey = hotkey1 then button2.Click;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
 ListIndex : Integer;
begin
InitOpenGL;
ListIndex := ListBox1.ItemIndex;
 FoundWindow := THandle(ListBox1.Items.Objects[ListIndex]);
if foundwindow > 0 then
begin
DC := GetDC(FoundWindow);
RC := CreateRenderingContext(DC, [opDoubleBuffered], 24, 16, 0, 0, 0, 0);
ActivateRenderingContext(DC, RC);
glEnable(GL_DEPTH_TEST);
glDepthFunc(GL_LESS);
glClearColor(0,0,0,0);
Form1.Caption := inttostr (FoundWindow);
end
else
Form1.Caption := 'Game Not Found';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
CaptureScreen2(FormatDateTime('dd_mm_yyyy', now) + '_' + FormatDateTime('hh_mm_ss', now) + '.bmp');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
ListBox1.Clear;
EnumWindows(@AllWindows, LParam(ListBox1.Items));
end;

end.

Open in new window


1- Enter a server of Quake live (quakelive.com)
2- Press Button3 "List All"
3- Select the window of the game (listbox)
4- Press Button1 "Handle"
5- Go play fullscreen and use the shortcut CTRL + A (button3 "screenshot").
6- bmp all black.
0
 

Author Comment

by:Júlio
ID: 39633840
Maybe the problem of black screenshot is here:

     
  for i := 0 to iHeight-1 do
        begin
          pLine := bmp.ScanLine[i];
          for j := 0 to iWidth-1 do
          begin
            rgba := pPixels[(iHeight-1-i) * iWidth + j];
            pLine^[j] :=
              (rgba and $FF000000) or
              ((rgba shl 16) and $00FF0000) or
              (rgba and $0000FF00) or
              ((rgba shr 16) and $000000FF);  //abgr -> argb
          end;
        end;

Open in new window


When i remove screenshot is white =p

Do i need a OpenGL Hook? If so, i don't know how to hook.
0
 
LVL 25

Expert Comment

by:Sinisa Vuk
ID: 39634622
I think that hook is not needed. Conversion abgr -> argb is for color only. For "black"/"white" pixels you can try glReadBuffer(GL_BACK) instead of glReadBuffer(GL_FRONT)
0
 

Author Comment

by:Júlio
ID: 39634770
glReadBuffer(GL_BACK) screenshot is all black too =(.

I don't know what to do.
0
 

Author Comment

by:Júlio
ID: 39634826
I found something, i think.

The client game windows is a sub-handle.

The handle i was talking is de main of application, let say Handle 919112.
The in-game "handle" is 002508E0.

I found this with Spy++.
How to find sub-handle (caption and class always quake live) starting at main handle?

spy
This is like a Twebbrower inside of a form. Quake Live ia web-browser 3D opengl game.
handle-game.PNG
0
 
LVL 25

Expert Comment

by:Sinisa Vuk
ID: 39634892
when you find main window with FindWindow for example then you can fin sub child window with FindWindowEx. It is quite easy to do this when you know class and/or text.
http://msdn.microsoft.com/en-us/library/windows/desktop/ms633500%28v=vs.85%29.aspx

My suggestion is to use EnumWindows function which will go to all windows not depending of parent/child relationship.
http://www.swissdelphicenter.ch/torry/showcode.php?id=410

Another thought is to use "third part" tools:
http://www.frontiernet.net/~w2m/apprehend.html
http://taksi.sourceforge.net/
0
 

Author Comment

by:Júlio
ID: 39634911
This is my code:

All windows:

"function AllWindows(wHnd: THandle; List: TStringList): Bool; stdcall;
var
 Buffer: array[0..255] of char;
begin
    SendMessage(wHnd, WM_GETTEXT, 255, LongInt(@Buffer[0]));
    if (Buffer <> '') and IsWindow(wHnd) then
      begin
        List.AddObject(Buffer, TObject(wHnd));
      end;
    Result := True;
end;

Open in new window


EnumWindows(@AllWindows, LParam(ListBox1.Items));

Open in new window


Child of Main handle:

function EnumChildProc(wnd: HWND; List_child: TListBox): BOOL; stdcall;
var
  buf, caption: array[0..255] of char;
  id_control: Integer;
begin
  GetClassName(wnd, buf, SizeOf(buf) - 1);  //class
  SendMessage(wnd, WM_GETTEXT, 256, Integer(@Caption)); //name
  id_control := GetDlgCtrlID(wnd);   //id
  List_child.Items.Add('ID: ' + IntToStr(id_control) + ' - ' + ' Classe: ' + (buf) + ' - Caption: ' + (caption));
  Result := True;
end;

Open in new window


EnumChildWindows(FoundWindow, @EnumChildProc, Integer(ListBox2));

Open in new window



This is not a window, how i get the handle of the child, the id is 0?
Maybe this is the key to solve the black screenshot.
If you want i can send my project.

This is always "0" when i try FindWindowEx with the selected child:

Var
 listIndex1 : Integer;
begin
ListIndex1 := ListBox2.ItemIndex;
 FoundWindow2 := THandle(ListBox2.Items.Objects[ListIndex1]);
 FoundWindow3 := FindWindowEx(FoundWindow, 0, 'Quake Live', 0);
 if FoundWindow3 > 0 then
   Listbox3.Items.Add(inttostr(FoundWindow3))
 Else
  Begin
   exit; // FoundWindow4 := GetDlgItem(FoundWindow2, ?);
  End;
end;

Open in new window


Taksi don't work too, because of the child.
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:Júlio
ID: 39635850
I tested with a standalone opengl game and all screenshots are black too.

The game is windowed 800x600 and the screenshot is 1920x1080 all black.

Solution:

 GetWindowRect(hWin, WindRect);
   iWidth := WindRect.Width;
   iHeight := WindRect.Height;

Open in new window


All sceenshot is black =(

I wa thinking about sruface, and if the game is in a different surface, how to find it?
0
 
LVL 62

Expert Comment

by:☠ MASQ ☠
ID: 39635970
dm0000 have you still got   glReadBuffer(GL_FRONT)  commented out in your current code?

Yes, this is a layer issue.  AFAIK you don't have to define the layer you are looking at just ignore the front one.

<disclaimer - I am NOT a programmer !!>
0
 

Author Comment

by:Júlio
ID: 39636108
Don't work remove glReadBuffer(GL_FRONT) .
I think if i need is glReadBuffer(GL_BACK) because it is doublebufferd and GL_FRONT single.

Yes, this a layer problem, with quake 3 same engine of Quake Live, screenshot is all black too, so the problem ins't the handle.
0
 
LVL 12

Expert Comment

by:satsumo
ID: 39637536
As much as I enjoy all this messing with surfaces and buffers, have you considered grabbing the window image with BitBlt or something similar? This is the relevant page from MSDN. It's not clever, or especially fast, but it will get around the black screen issue.
0
 

Author Comment

by:Júlio
ID: 39638587
Don't work too, screenshot now are all gray.

const
  CAPTUREBLT = $40000000;

var
  hdcScreen     : DWORD;
  hdcCompatible : DWORD;
  hbmScreen     : DWORD;
  bmp           : TBitmap;

begin
  bmp := TBitmap.Create;
  try
    hdcScreen     := CreateDC('DISPLAY', nil, nil, nil);
    if hdcScreen = 0 then begin
      ShowMessage('CreateDC: '+SysErrorMessage(GetLastError));
      Exit;
    end;
    try
      hdcCompatible := CreateCompatibleDC(hdcScreen);
      if hdcCompatible = 0 then begin
        ShowMessage('CreateCompatibleDC: '+SysErrorMessage(GetLastError));
        Exit;
      end;
      try
        SetStretchBltMode(hdcCompatible,HALFTONE);
        StretchBlt(hdcCompatible, 0, 0, bmp.Width, bmp.Height,
               hdcScreen,
               0,0,
               GetSystemMetrics (SM_CXSCREEN),
               GetSystemMetrics (SM_CYSCREEN),
               SRCCOPY);
        hbmScreen := CreateCompatibleBitmap(hdcScreen,GetDeviceCaps(hdcScreen, HORZRES),GetDeviceCaps(hdcScreen, VERTRES));
        if hbmScreen = 0 then begin
          ShowMessage('CreateCompatibleBitmap: '+SysErrorMessage(GetLastError));
          Exit;
        end;
        try
          SelectObject(hdcCompatible, hbmScreen);
          bmp.Handle := hbmScreen;
          BitBlt(hdcCompatible, 0, 0, bmp.Width, bmp.Height,  hdcScreen,  0, 0,
            SRCCOPY or CAPTUREBLT);
            bmp.SaveToFile(ExtractFilePath(application.ExeName) +  'Screenshot.bmp');
          finally
            DeleteObject(hbmScreen);
          end;
      finally
        DeleteDC(hdcCompatible);
      end;
    finally
      DeleteDC(hdcScreen);
    end;
  finally
    FreeAndNil(bmp);
  end;
end;

Open in new window

0
 
LVL 12

Expert Comment

by:satsumo
ID: 39638767
What is the StretchBlt on line 26 for?
0
 

Author Comment

by:Júlio
ID: 39638830
To map pixels, i think.
0
 
LVL 12

Expert Comment

by:satsumo
ID: 39640522
I don't think that part of the code achieves anything. After CreateCompatibleDC, hdcCompatble will be a 1x1 monochrome memory DC. So the StretchBlt probably won't do anything useful. That DC only has a size after selecting hbmScreen into it. Then the code does a BitBlt that should work, Its using HORZRES and VERTRES to create the bitmap, then bmp.Width and bmp.Height for the blit, can you check they are the same values?
0
 

Author Comment

by:Júlio
ID: 39641483
Don't work to 3D Application.

Procedure TForm1.SS(const file_name : string);
const
  CAPTUREBLT = $40000000;

var
  hdcScreen     : DWORD;
  hdcCompatible : DWORD;
  hbmScreen     : DWORD;
  bmp           : TBitmap;
  ListIndex     : Integer;
  iWidth        : Integer;
  iHeight       : integer;
  WindRect      : TRect;
  hwin          : HWND;
begin

  ListIndex := Listbox1.ItemIndex;
  hWin := THandle(ListBox1.Items.Objects[ListIndex]); //1

begin
  bmp := TBitmap.Create;
  try
    hdcScreen     := CreateDC('DISPLAY', nil, nil, nil);
    if hdcScreen = 0 then begin
      ShowMessage('CreateDC: '+SysErrorMessage(GetLastError));
      Exit;
    end;
    try
      hdcCompatible := CreateCompatibleDC(hdcScreen);
      if hdcCompatible = 0 then begin
        ShowMessage('CreateCompatibleDC: '+SysErrorMessage(GetLastError));
        Exit;
      end;
      try
     GetWindowRect(hWin, WindRect);
     iWidth := WindRect.Width;
     iHeight := WindRect.Height;
        hbmScreen := CreateCompatibleBitmap(hdcScreen,WindRect.Width,WindRect.Height);  //GetDeviceCaps(hdcScreen, HORZRES) GetDeviceCaps(hdcScreen, VERTRES))
        if hbmScreen = 0 then begin
          ShowMessage('CreateCompatibleBitmap: '+SysErrorMessage(GetLastError));
          Exit;
        end;
        try
          SelectObject(hdcCompatible, hbmScreen);
          bmp.Handle := hbmScreen;
          BitBlt(hdcCompatible, 0, 0, WindRect.Width, WindRect.Height,  hdcScreen,  0, 0, SRCCOPY or CAPTUREBLT);
            bmp.SaveToFile(file_name);
          finally
            DeleteObject(hbmScreen);
          end;
      finally
        DeleteDC(hdcCompatible);
      end;
    finally
      DeleteDC(hdcScreen);
    end;
  finally
    FreeAndNil(bmp);
  end;
end;
end;

Open in new window


Maybe inject dll with opengl code and take screenshot without hook? I'm not good with hook.

Opengl code:

procedure TForm1.CaptureScreen2(const AFileName: string);
var
  hWin: HWND;
  MyDC: HDC;
  MyRC: HGLRC;
  pPixels: PIntegerArray;
  pLine: PIntegerArray;
  bmp: TBitmap;
  i, j, iWidth, iHeight: Integer;
  rgba: Cardinal;
  ListIndex, ListIndex2 : Integer;
  WindRect : TRect;
begin
  InitOpenGL;
  ListIndex := Listbox1.ItemIndex;
  hWin := THandle(ListBox1.Items.Objects[ListIndex]); //1
 if hwin <> 0 then
  Begin
   GetWindowRect(hWin, WindRect);
   iWidth := WindRect.Width;
   iHeight := WindRect.Height;
  End
 Else
  Begin
   Label4.Caption := 'No handle.';
   Exit;
  End;
   MyDC := GetDc(hWin);
   MyRC := CreateRenderingContextVersion(MyDC, [opDoubleBuffered], 4, 0, TRUE, 32, 24, 8, 0, 0, 0);  //CreateRenderingContextVersion(MyDC, [opDoubleBuffered], 4, 0, TRUE, 32, 24, 8, 0, 0, 0);`(opDoubleBuffered, opGDI, opStereo);
   ActivateRenderingContext(MyDC, MyRC);
  try
    bmp := TBitmap.Create;
    try
     GetMem(pPixels, iWidth * iHeight * 4);
      try
        bmp.PixelFormat := pf32bit;
        bmp.Height :=  iHeight;
        bmp.Width := iWidth;
        glReadBuffer(GL_BACK);
        glPixelStorei(GL_PACK_ALIGNMENT, 1);
        glReadPixels(0, 0, iWidth, iHeight, GL_RGBA, GL_UNSIGNED_BYTE, pPixels);
        for i := 0 to iHeight-1 do
         begin
          pLine := bmp.ScanLine[i];
           for j := 0 to iWidth-1 do
            begin
             rgba := pPixels[(iHeight-1-i) * iWidth + j];
             pLine^[j] :=  (rgba and $FF000000) or
            ((rgba shl 16) and $00FF0000) or  (rgba and $0000FF00) or
            ((rgba shr 16) and $000000FF);  //abgr -> argb
           end;
         end;

        bmp.Canvas.Brush.Color := clGreen;
        bmp.Canvas.TextOut(0, 0, FormatDateTime('dd_mm_yyyy', now) + '_' + FormatDateTime('hh_mm_ss', now));
        bmp.SaveToFile(AFileName);
        ListBox3.Items.Add(IntToStr(hwin) + ' : Screenshot');
      finally
        FreeMem(pPixels);
      end;
    finally
      bmp.Free;
    end;
  finally
    DeactivateRenderingContext;
    wglDeleteContext(myRC);
    ReleaseDC(hWin, myDC);
  end;
end;

Open in new window

0
 
LVL 12

Expert Comment

by:satsumo
ID: 39642782
If this is going to work, it can't create its own rendering context in that way. Unless a context is shared, it will have its own back buffer. So the back buffer you read from will be different to the buffer being used by the program. To capture it would need the buffers used by the game. This is why it's easier to read from the shared display buffer. If you have a DLL that is running in the process of the game, you could try getting the active context for OpenGL and using that.
0
 

Author Comment

by:Júlio
ID: 39644534
I don't know how to do that.
Need to inject and hook or just inject em call?

Could you please give me a exmaple?
hook SwapBuffers and do a readback with glReadPixels
0
 

Author Comment

by:Júlio
ID: 39644895
Like this?

I inject dll with this:

function InjectDLL(dwPID: DWORD; DLLPath: PWideChar): integer;
var
  dwThreadID: Cardinal;
  hProc, hThread, hKernel: THandle;
  BytesToWrite, BytesWritten: SIZE_T;
  pRemoteBuffer, pLoadLibrary: Pointer;
begin
  hProc := OpenProcess(PROCESS_CREATE_THREAD or PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or PROCESS_VM_WRITE or PROCESS_VM_READ, False, dwPID);
  if hProc = 0 then
    exit(0);
  try
    BytesToWrite := SizeOf(WideChar)*(Length(DLLPath) + 1);
    pRemoteBuffer := VirtualAllocEx(hProc, nil, BytesToWrite, MEM_COMMIT, PAGE_READWRITE);
    if pRemoteBuffer = nil then
      exit(0);
    try
      if not WriteProcessMemory(hProc, pRemoteBuffer, DLLPath, BytesToWrite, BytesWritten) then
        exit(0);
      hKernel := GetModuleHandle('kernel32.dll');
      pLoadLibrary := GetProcAddress(hKernel, 'LoadLibraryW');
      hThread := CreateRemoteThread(hProc, nil, 0, pLoadLibrary, pRemoteBuffer, 0, dwThreadID);
      try
        WaitForSingleObject(hThread, INFINITE);
      finally
        CloseHandle(hThread);
      end;
    finally
      VirtualFreeEx(hProc, pRemoteBuffer, 0, MEM_RELEASE);
    end;
  finally
    CloseHandle(hProc);
  end;
  exit(1);
end;

Open in new window


dll to screenshot:

library Project2;

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls,
  TLHelp32,
  dglOpenGL in '..\..\..\Desktop\QLShot2\Win32\Debug\dglOpenGL.pas';

Var
 SwapBuffers : Function(DC: HDC): BOOL;
 SwapHook : HHOOK;
 Listproc, Listproc2 : TStringList;
 Handle_game : THandle;

{$R *.res}
// Gdi32.dll

Function ProcessIDFromAppname32( appname: String ): DWORD;
Var
 HDL : THandle;
 Estrutura : TProcessEntry32;
Begin
Result := 0;
appName := UpperCase( appname );
HDL := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
	If HDL <> 0 Then
	 try
	   Estrutura.dwSize := Sizeof(Estrutura);
	    If Process32First(HDL, Estrutura) Then
	  Repeat
		    If Pos(appname, UpperCase(ExtractFilename(StrPas(Estrutura.szExeFile)))) > 0
	       Then
          Begin
		       Result:= Estrutura.th32ProcessID;
		       Break;
		      End;
	  Until not Process32Next(HDL, Estrutura);
	 finally
	  CloseHandle(HDL);
	End;
End;

Procedure ListarProcessos;
var
  HDL : THandle;
  Estrutura : TProcessEntry32;
begin
Listproc := TStringList.Create;
HDL := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
Try
Estrutura.dwSize:=Sizeof(TProcessEntry32);
if Process32First(HDL, Estrutura) then
 Listproc.Add(Estrutura.szExeFile);
// ListBox.Items.Add(Estrutura.szExeFile);
while Process32Next(HDL, Estrutura) do
 Listproc.Add(Estrutura.szExeFile);
 //ListBox.Items.Add(Estrutura.szExeFile);
 if Listproc.IndexOf('Quake') > -1 Then
  Handle_game := ProcessIDFromAppname32(listproc.Strings[Listproc.IndexOf('Quake')]);
Finally
  Listproc.Free;
End;


end;

Function SwapBufferCallBack(DC: HDC) : BOOL;
Begin
if DC > 0 then
 Result := Swapbuffers(DC);
End;

procedure CaptureScreen2(const AFileName: string);
var
  hWin: HWND;
  MyDC: HDC;
  MyRC: HGLRC;
  pPixels: PIntegerArray;
  pLine: PIntegerArray;
  bmp: TBitmap;
  i, j, iWidth, iHeight: Integer;
  rgba: Cardinal;
  ListIndex, ListIndex2 : Integer;
  WindRect : TRect;
begin
  InitOpenGL;
  //ListIndex := Listbox1.ItemIndex;
 // hWin := THandle(ListBox1.Items.Objects[ListIndex]); //1
 hWin := Handle_game;
 if hwin <> 0 then
  Begin
   GetWindowRect(hWin, WindRect);
   iWidth := WindRect.Width;
   iHeight := WindRect.Height;
  End
 Else
  Begin
  // Label4.Caption := 'No handle.';
   Exit;
  End;
   MyDC := GetDc(hWin);
   MyRC := CreateRenderingContextVersion(MyDC, [opDoubleBuffered], 4, 0, TRUE, 32, 24, 8, 0, 0, 0);  //CreateRenderingContextVersion(MyDC, [opDoubleBuffered], 4, 0, TRUE, 32, 24, 8, 0, 0, 0);`(opDoubleBuffered, opGDI, opStereo);
   ActivateRenderingContext(MyDC, MyRC);
  try
    bmp := TBitmap.Create;
    try
     GetMem(pPixels, iWidth * iHeight * 4);
      try
        bmp.PixelFormat := pf32bit;
        bmp.Height :=  iHeight;
        bmp.Width := iWidth;
        SwapBufferCallBack(MyDC);
        glReadBuffer(GL_BACK);
        glPixelStorei(GL_PACK_ALIGNMENT, 1);
        glReadPixels(0, 0, iWidth, iHeight, GL_RGBA, GL_UNSIGNED_BYTE, pPixels);
        for i := 0 to iHeight-1 do
         begin
          pLine := bmp.ScanLine[i];
           for j := 0 to iWidth-1 do
            begin
             rgba := pPixels[(iHeight-1-i) * iWidth + j];
             pLine^[j] :=  (rgba and $FF000000) or
            ((rgba shl 16) and $00FF0000) or  (rgba and $0000FF00) or
            ((rgba shr 16) and $000000FF);  //abgr -> argb
           end;
         end;

        bmp.Canvas.Brush.Color := clGreen;
        bmp.Canvas.TextOut(0, 0, FormatDateTime('dd_mm_yyyy', now) + '_' + FormatDateTime('hh_mm_ss', now));
        bmp.SaveToFile(AFileName);
        //ListBox3.Items.Add(IntToStr(hwin) + ' : Screenshot');
      finally
        FreeMem(pPixels);
      end;
    finally
      bmp.Free;
    end;
  finally
    DeactivateRenderingContext;
    wglDeleteContext(myRC);
    ReleaseDC(hWin, myDC);
  end;
end;


begin
Swaphook:= SetWindowsHookEx(WH_GETMESSAGE, @SwapBufferCallBack, 0, GetCurrentThreadID);
CaptureScreen2(FormatDateTime('dd_mm_yyyy', now) + '_' + FormatDateTime('hh_mm_ss', now) + '.bmp');
UnhookWindowsHookEx(SwapHook);
end.

Open in new window


I can inject, but my dll don't work. =(
0
 

Author Comment

by:Júlio
ID: 39655030
Help!
0
 
LVL 12

Expert Comment

by:satsumo
ID: 39656559
I'd like to, but I'm not sure how to inject code into a running game except to substitute a DLL for the original OpenGL. Most of the functions just call the corresponding function in the original DLL. You might do your screen grab thing in glSwapBuffers, before passing it on. I've never done this, I remember somebody asking about it on EE a while back, they were injecting into Direct3D.
0
 
LVL 25

Accepted Solution

by:
Sinisa Vuk earned 500 total points
ID: 39667651
Agree, injecting code is the only solution. To work with glReadPixels you need to be in remote process thread.

This is my last code with won't work but you can use it as starting point to injection process.
function EnumAllWindows(wHandle: HWND; pWinOut: PInteger): Bool; stdcall;
var
  l: Integer;
  sText, sClass: WideString;
begin
  Result := True;

  if IsWindowVisible(wHandle) then
  begin
    SetLength(sText, GetWindowTextLengthW(wHandle));
    if Length(sText) > 0 then
      GetWindowTextW(wHandle, PWideChar(sText), Length(sText) + 1);

    SetLength(sClass, 255);
    l := GetClassNameW(wHandle, PWideChar(sClass), 255);
    SetLength(sClass, l);

    if (sClass = 'Quake Live') and (sText = 'Quake Live') then
    begin
      pWinOut^ := wHandle;
    end
    else
    begin
      EnumChildWindows(wHandle, @EnumAllWindows, Integer(pWinOut));
    end;
    Result := (pWinOut^ = 0) // skip id found
  end;
end;

function FindQuakeWin: Cardinal;
begin
  Result := 0;
  EnumWindows(@EnumAllWindows, Integer(@Result));
end;

procedure CaptureScreen3(hWin: HWND; const AFileName: string);
var
  MyDC: HDC;
  MyRC: HGLRC;
  pPixels: PIntegerArray;
  pLine: PIntegerArray;
  bmp: TBitmap;
  i, j, iWidth, iHeight: Cardinal;
  rgba: Cardinal;
  index, nextIndex: Integer;
  Viewport: array [0 .. 3] of TGLint;
begin
  InitOpenGL;

  MyDC := GetDc(hWin);
  MyRC := CreateRenderingContext(MyDC, [], 32, 24, 8, 0, 0, 0);
  ActivateRenderingContext(MyDC, MyRC);
  try
    bmp := TBitmap.Create;
    try
      glGetIntegerv(GL_VIEWPORT, @Viewport);
      glFinish;
      iWidth := Viewport[2];
      iHeight := Viewport[3];
      // get buffer memory
      GetMem(pPixels, iWidth * iHeight * 4);
      ZeroMemory(pPixels, iWidth * iHeight * 4);
      try
        bmp.PixelFormat := pf32bit;
        bmp.Height := iHeight;
        bmp.Width := iWidth;

        glFinish;
        //set byte align?
        glPixelStorei(GL_PACK_ALIGNMENT, 4);
        glPixelStorei(GL_PACK_ROW_LENGTH, iWidth);
        glPixelStorei(GL_PACK_SKIP_ROWS, 0);
        glPixelStorei(GL_PACK_SKIP_PIXELS, 0);
        //which gl buffer
        glReadBuffer(GL_FRONT);
        //get pixels
        glReadPixels(0, 0, iWidth, iHeight, GL_BGRA, GL_UNSIGNED_BYTE, pPixels);
        //scan each line from bitmap and copy color bytes with byte transformation
        for i := 0 to iHeight-1 do
        begin
          pLine := bmp.ScanLine[iHeight-1-i];
          //copy row
          CopyMemory( pLine, Pointer( Cardinal(pPixels)+ (i * iWidth * 4)), iWidth * 4);
        end;
        bmp.SaveToFile(AFileName);
      finally
        FreeMem(pPixels);
      end;
    finally
      bmp.Free;
    end;
  finally
    // Deactivates current context
    DeactivateRenderingContext;
    wglDeleteContext(MyRC);
    ReleaseDC(hWin, MyDC);
  end;
end;

Open in new window


one thing - see that in this quake live game is already key combination to take screenshot (options)
0
 
LVL 12

Expert Comment

by:satsumo
ID: 39668748
sinisav's comment reminded me of another reason this wouldn't work without injecting. OpenGL is not multi-threaded, to use its functions correctly you have to be in the thread that created the OpenGL context. A DLL runs in the thread that calls it, unless it creates it own child threads.

Some interesting discussion about the topic:

http://stackoverflow.com/questions/15840143/injecting-a-frame-buffer
http://www.mpcforum.com/showthread.php?10529-Opengl-Hack-Injection-methods
0
 

Author Comment

by:Júlio
ID: 39674507
I've requested that this question be closed as follows:

Accepted answer: 0 points for dm0000's comment #a39644895

for the following reason:

I accpet, but need to work iin this.
0
 

Author Closing Comment

by:Júlio
ID: 39674508
Not the finnal soluction, but he deserv the credits.
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

The way I use Experts Exchange to assist me in analyzing and diagnosing a problem is I first enter a Verbose Question at Experts Exchange like: Office 2007 will hang when opening and saving files I then launch WordPad (any text editor will do) an…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Windows 8 comes with a dramatically different user interface known as Metro. Notably missing from the new interface is a Start button and Start Menu. Many users do not like it, much preferring the interface of earlier versions — Windows 7, Windows X…
With the advent of Windows 10, Microsoft is pushing a Get Windows 10 icon into the notification area (system tray) of qualifying computers. There are many reasons for wanting to remove this icon. This two-part Experts Exchange video Micro Tutorial s…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now