examples/GrabScreen/GrabScreen.lpr

   1 program SimpleLoadFromFile;
   2
   3 {$mode objfpc}{$H+}
   4
   5 uses
   6   {$IFDEF UNIX}{$IFDEF UseCThreads}
   7   cthreads,
   8   {$ENDIF}{$ENDIF}
   9   Classes, Windows, SysUtils, dglOpenGL, glBitmap, Helper;
  10
  11 var
  12   oglWindow: TOpenGLWindow;
  13   running: Boolean = true;
  14
  15 function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  16 var
  17   data: TglBitmapData;
  18 begin
  19   case Msg of
  20     WM_DESTROY: begin
  21       running := false;
  22     end;
  23
  24     WM_KEYDOWN: begin
  25       if wParam = VK_RETURN then begin
  26         data := TglBitmapData.Create;                               // create texture data object
  27         try
  28           TglBitmap2D.GrabScreen(0, 0, 800, 600, tfRGBA8ui1, data); // read pixels from frame buffer
  29           data.SaveToFile(                                          // save data to file
  30             ExtractFilePath(ApplicationName) +
  31             'screen.bmp', ftBMP);
  32           WriteLn('screen saved to screen.bmp');
  33         finally
  34           FreeAndNil(data);                                         // free texture data object when done
  35         end;
  36       end;
  37     end;
  38   end;
  39   result := DefWindowProc(hWnd, Msg, wParam, lParam);
  40 end;
  41
  42 procedure RenderLoop;
  43 begin
  44   glBegin(GL_TRIANGLES);
  45     glColor4f(1, 0, 0, 1); glVertex2f(400, 100);
  46     glColor4f(0, 1, 0, 1); glVertex2f(100, 500);
  47     glColor4f(0, 0, 1, 1); glVertex2f(700, 500);
  48   glEnd;
  49 end;
  50
  51 begin
  52   oglWindow := CreateOpenGLWindow('GrapScreen (hit enter to grab screen)', 800, 600, @WindowProc);
  53   while running and ProgressMesages do begin
  54     RenderLoop;
  55     SwapBuffers(oglWindow.DC);
  56   end;
  57   DestroyOpenGLWindow(oglWindow);
  58 end.
  59
  60