glBitmap/examples/GrabScreen/GrabScreen.lpr

program SimpleLoadFromFile;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, Windows, SysUtils, dglOpenGL, glBitmap, Helper;

var
  oglWindow: TOpenGLWindow;
  running: Boolean = true;

function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  data: TglBitmapData;
begin
  case Msg of
    WM_DESTROY: begin
      running := false;
    end;

    WM_KEYDOWN: begin
      if wParam = VK_RETURN then begin
        data := TglBitmapData.Create;                               // create texture data object
        try
          TglBitmap2D.GrabScreen(0, 0, 800, 600, tfRGBA8ui1, data); // read pixels from frame buffer
          data.SaveToFile(                                          // save data to file
            ExtractFilePath(ApplicationName) +
            'screen.bmp', ftBMP);
          WriteLn('screen saved to screen.bmp');
        finally
          FreeAndNil(data);                                         // free texture data object when done
        end;
      end;
    end;
  end;
  result := DefWindowProc(hWnd, Msg, wParam, lParam);
end;

procedure RenderLoop;
begin
  glBegin(GL_TRIANGLES);
    glColor4f(1, 0, 0, 1); glVertex2f(400, 100);
    glColor4f(0, 1, 0, 1); glVertex2f(100, 500);
    glColor4f(0, 0, 1, 1); glVertex2f(700, 500);
  glEnd;
end;

begin
  oglWindow := CreateOpenGLWindow('GrapScreen (hit enter to grab screen)', 800, 600, @WindowProc);
  while running and ProgressMesages do begin
    RenderLoop;
    SwapBuffers(oglWindow.DC);
  end;
  DestroyOpenGLWindow(oglWindow);
end.