Files |  Tutorials |  Articles |  Links |  Home |  Team |  Forum |  Wiki |  Impressum

Aktuelle Zeit: Mo Mai 20, 2024 01:36

Foren-Übersicht » Programmierung » OpenGL 		Unbeantwortete Themen | Aktive Themen


Ein neues Thema erstellen Auf das Thema antworten  Seite 1 von 1
  [ 2 Beiträge ] 
  Vorheriges Thema | Nächstes Thema 
Autor Nachricht
dm0000
 Betreff des Beitrags: Screenshot fullscreen game OpenGl
BeitragVerfasst: Fr Nov 08, 2013 19:57 
Offline
DGL Member

Registriert: Fr Nov 08, 2013 04:22
Beiträge: 2
Programmiersprache: Delphi
Hi,
I'm trying to take a screenshot of a opengl game (quake live), but the screenshot is black =(

My code, Delphi XE2.

Code:
  1. unit unir_principal;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, jpeg,
  8.   dglOpenGL, StdCtrls;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     Button1: TButton;
  13.     Button2: TButton;
  14.     Button3: TButton;
  15.     ListBox1: TListBox;
  16.     Label1: TLabel;
  17.     procedure Button1Click(Sender: TObject);
  18.     procedure Button2Click(Sender: TObject);
  19.     procedure Button3Click(Sender: TObject);
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure FormDestroy(Sender: TObject);
  22.   private
  23.     hotkey1 : Integer;
  24.     procedure CaptureScreen2(const AFileName: string);
  25.     procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;
  26.     { Private declarations }
  27.   public
  28.     RC        : HGLRC;
  29.     DC        : HDC;
  30.     FoundWindow : hwnd;
  31.     { Public declarations }
  32.   end;
  33.  
  34. var
  35.   Form1: TForm1;
  36.  
  37. implementation
  38.  
  39. function AllWindows(wHnd: THandle; List: TStringList): Bool; stdcall;
  40. var
  41.  Buffer: array[0..255] of char;
  42. begin
  43.     SendMessage(wHnd, WM_GETTEXT, 255, LongInt(@Buffer[0]));
  44.     if (Buffer <> '') and IsWindow(wHnd) then
  45.       begin
  46.         List.AddObject(Buffer, TObject(wHnd));
  47.       end;
  48.     Result := True;
  49. end;
  50.  
  51. {$R *.dfm}
  52.  
  53. procedure TForm1.CaptureScreen2(const AFileName: string);
  54. var
  55.   hWin: HWND;
  56.   MyDC: HDC;
  57.   MyRC: HGLRC;
  58.   pPixels: PIntegerArray;
  59.   pLine: PIntegerArray;
  60.   bmp: TBitmap;
  61.   i, j, iWidth, iHeight: Integer;
  62.   rgba: Cardinal;
  63.  // ListIndex : Integer;
  64. begin
  65.   InitOpenGL;
  66.   iWidth := Screen.Width;
  67.   iHeight := Screen.Height;
  68. //  ListIndex := ListBox1.ItemIndex;
  69. //  hWin := THandle(ListBox1.Items.Objects[ListIndex]);
  70.  // hWin := GetDesktopWindow;
  71. //  MyDC := GetDc(hWin);
  72.  // MyRC := CreateRenderingContext(MyDC, [opDoubleBuffered], 24, 16, 0, 0, 0, 0);
  73.  // ActivateRenderingContext(MyDC, MyRC);
  74.   try
  75.     bmp := TBitmap.Create;
  76.     try
  77.       GetMem(pPixels, iWidth * iHeight * 4);
  78.       try
  79.         bmp.PixelFormat := pf32bit;
  80.         bmp.Height := iHeight;
  81.         bmp.Width := iWidth;
  82.         glPixelStorei(GL_PACK_ALIGNMENT, 1);
  83.         glReadBuffer(GL_FRONT);
  84.         glReadPixels(0, 0, iWidth, iHeight, GL_RGBA, GL_UNSIGNED_BYTE, pPixels);
  85.         for i := 0 to iHeight-1 do
  86.         begin
  87.           pLine := bmp.ScanLine[i];
  88.           for j := 0 to iWidth-1 do
  89.           begin
  90.             rgba := pPixels[(iHeight-1-i) * iWidth + j];
  91.             pLine^[j] :=
  92.               (rgba and $FF000000) or
  93.               ((rgba shl 16) and $00FF0000) or
  94.               (rgba and $0000FF00) or
  95.               ((rgba shr 16) and $000000FF);  //abgr -> argb
  96.           end;
  97.         end;
  98.         bmp.SaveToFile(AFileName);
  99.       finally
  100.         FreeMem(pPixels);
  101.       end;
  102.     finally
  103.       bmp.Free;
  104.     end;
  105.   finally
  106.     DeactivateRenderingContext;
  107.     wglDeleteContext(myRC);
  108.     ReleaseDC(GetDesktopWindow, myDC);
  109.   end;
  110. end;
  111.  
  112. procedure TForm1.FormCreate(Sender: TObject);
  113. const MOD_CONTROL = 2;
  114. VK_A = 65;
  115. begin
  116. hotkey1 := GlobalAddAtom('Hotkey1');
  117. RegisterHotKey(handle, hotkey1, MOD_CONTROL,VK_A);
  118. end;
  119.  
  120. procedure TForm1.FormDestroy(Sender: TObject);
  121. begin
  122. UnRegisterHotKey(handle, hotkey1);
  123. end;
  124.  
  125. procedure TForm1.WMHotKey(var Msg: TWMHotKey);
  126. begin
  127. if msg.HotKey = hotkey1 then button2.Click;
  128. end;
  129.  
  130. procedure TForm1.Button1Click(Sender: TObject);
  131. Var
  132.  ListIndex : Integer;
  133. begin
  134. InitOpenGL;
  135. ListIndex := ListBox1.ItemIndex;
  136.  FoundWindow := THandle(ListBox1.Items.Objects[ListIndex]);
  137. if foundwindow > 0 then
  138. begin
  139. DC := GetDC(FoundWindow);
  140. RC := CreateRenderingContext(DC, [opDoubleBuffered], 32, 24, 0, 0, 0, 0);
  141. ActivateRenderingContext(DC, RC);
  142. glEnable(GL_DEPTH_TEST);
  143. glDepthFunc(GL_LESS);
  144. glClearColor(0,0,0,0);
  145. Form1.Caption := inttostr (FoundWindow);
  146. end
  147. else
  148. Form1.Caption := 'Game Not Found';
  149. end;
  150.  
  151. procedure TForm1.Button2Click(Sender: TObject);
  152. begin
  153.  
  154. CaptureScreen2(FormatDateTime('dd_mm_yyyy', now) + '_' + FormatDateTime('hh_mm_ss', now) + '.bmp');
  155. end;
  156.  
  157. procedure TForm1.Button3Click(Sender: TObject);
  158. Var
  159.   s: string;
  160.   I: Integer;
  161. begin
  162. ListBox1.Clear;
  163. EnumWindows(@AllWindows, LParam(ListBox1.Items));
  164. end;
  165. end.


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.

Ty!
Nach oben
 Profil  
Mit Zitat antworten  
dm0000
BeitragVerfasst: Di Nov 12, 2013 14:21 
Offline
DGL Member

Registriert: Fr Nov 08, 2013 04:22
Beiträge: 2
Programmiersprache: Delphi
New code:

Code:
  1. procedure TForm1.CaptureScreen2(const AFileName: string);
  2. var
  3.   hWin: HWND;
  4.   MyDC: HDC;
  5.   MyRC: HGLRC;
  6.   pPixels: PIntegerArray;
  7.   pLine: PIntegerArray;
  8.   bmp: TBitmap;
  9.   i, j, iWidth, iHeight: Integer;
  10.   rgba: Cardinal;
  11.   ListIndex, ListIndex2 : Integer;
  12.   WindRect : TRect;
  13. begin
  14.   InitOpenGL;
  15.   ListIndex := Listbox1.ItemIndex;
  16.   hWin := THandle(ListBox1.Items.Objects[ListIndex]); //1
  17.  if hwin <> 0 then
  18.   Begin
  19.    GetWindowRect(hWin, WindRect);
  20.    iWidth := WindRect.Width;
  21.    iHeight := WindRect.Height;
  22.   End
  23.  Else
  24.   Begin
  25.    Label4.Caption := 'No handle.';
  26.    Exit;
  27.   End;
  28.    MyDC := GetDc(hWin);
  29.    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);
  30.    ActivateRenderingContext(MyDC, MyRC);
  31.   try
  32.     bmp := TBitmap.Create;
  33.     try
  34.      GetMem(pPixels, iWidth * iHeight * 4);
  35.       try
  36.         bmp.PixelFormat := pf32bit;
  37.         bmp.Height :=  iHeight;
  38.         bmp.Width := iWidth;
  39.         glReadBuffer(GL_BACK);
  40.         glPixelStorei(GL_PACK_ALIGNMENT, 1);
  41.         glReadPixels(0, 0, iWidth, iHeight, GL_RGBA, GL_UNSIGNED_BYTE, pPixels);
  42.         for i := 0 to iHeight-1 do
  43.          begin
  44.           pLine := bmp.ScanLine[i];
  45.            for j := 0 to iWidth-1 do
  46.             begin
  47.              rgba := pPixels[(iHeight-1-i) * iWidth + j];
  48.              pLine^[j] :=  (rgba and $FF000000) or
  49.             ((rgba shl 16) and $00FF0000) or  (rgba and $0000FF00) or
  50.             ((rgba shr 16) and $000000FF);  //abgr -> argb
  51.            end;
  52.          end;
  53.  
  54.         bmp.Canvas.Brush.Color := clGreen;
  55.         bmp.Canvas.TextOut(0, 0, FormatDateTime('dd_mm_yyyy', now) + '_' + FormatDateTime('hh_mm_ss', now));
  56.         bmp.SaveToFile(AFileName);
  57.         ListBox3.Items.Add(IntToStr(hwin) + ' : Screenshot');
  58.       finally
  59.         FreeMem(pPixels);
  60.       end;
  61.     finally
  62.       bmp.Free;
  63.     end;
  64.   finally
  65.     DeactivateRenderingContext;
  66.     wglDeleteContext(myRC);
  67.     ReleaseDC(hWin, myDC);
  68.   end;
  69. end;


Don't work too, all black =(
Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  Seite 1 von 1
  [ 2 Beiträge ] 
Foren-Übersicht » Programmierung » OpenGL


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 11 Gäste

Du darfst keine neuen Themen in diesem Forum erstellen.
Du darfst keine Antworten zu Themen in diesem Forum erstellen.
Du darfst deine Beiträge in diesem Forum nicht ändern.
Du darfst deine Beiträge in diesem Forum nicht löschen.
Du darfst keine Dateianhänge in diesem Forum erstellen.

Suche nach:
Gehe zu:  
  Powered by phpBB® Forum Software © phpBB Group
Deutsche Übersetzung durch phpBB.de
[ Time : 0.008s | 14 Queries | GZIP : On ]