Screenshot: Unterschied zwischen den Versionen

  // ungünstige Reihenfolge Rot Grün Blau 
  glReadPixels( 0, 0, Breite, Hoehe, GL_RGB, GL_UNSIGNED_BYTE, Daten );
  // auf neueren Grafikkarten:
  glReadPixels( 0, 0, Breite, Hoehe, GL_BGR, GL_UNSIGNED_BYTE, Daten );

 BITMAPFILEHEADER = packed record
    bfType: Word;
    bfSize: DWORD;
    bfReserved1: Word;
    bfReserved2: Word;
    bfOffBits: DWORD;
  end;

 BITMAPINFOHEADER = packed record
    biSize: DWORD;
    biWidth: Longint;
    biHeight: Longint;
    biPlanes: Word;
    biBitCount: Word;
    biCompression: DWORD;
    biSizeImage: DWORD;
    biXPelsPerMeter: Longint;
    biYPelsPerMeter: Longint;
    biClrUsed: DWORD;
    biClrImportant: DWORD;
  end;

procedure ScreenShot(const Name : string);
 var F : file;
     FileInfo: BITMAPINFOHEADER;
     FileHeader : BITMAPFILEHEADER;
     pPicData:Pointer;
     Viewport : array[0..3] of integer;
begin
 //Speicher für die Speicherung der Header-Informationen vorbereiten
 ZeroMemory(@FileHeader, SizeOf(BITMAPFILEHEADER));
 ZeroMemory(@FileInfo, SizeOf(BITMAPINFOHEADER));

 //Größe des Viewports abfragen --> Spätere Bildgrößenangaben
 glGetIntegerv(GL_VIEWPORT, @Viewport);

 //Initialisieren der Daten des Headers
 FileHeader.bfType := 19778; //$4D42 = 'BM'
 FileHeader.bfOffBits := SizeOf(BITMAPINFOHEADER)+SizeOf(BITMAPFILEHEADER);

 //Schreiben der Bitmap-Informationen
 FileInfo.biSize := SizeOf(BITMAPINFOHEADER);
 FileInfo.biWidth := Viewport[2];
 FileInfo.biHeight := Viewport[3];
 FileInfo.biPlanes := 1;
 FileInfo.biBitCount := 32;
 FileInfo.biSizeImage := FileInfo.biWidth*FileInfo.biHeight*(FileInfo.biBitCount div 8);

 //Größenangabe auch in den Header übernehmen
 FileHeader.bfSize := FileHeader.bfOffBits + FileInfo.biSizeImage;

 //Speicher für die Bilddaten reservieren
 GetMem(pPicData, FileInfo.biSizeImage);
 try
  //Bilddaten von OpenGL anfordern (siehe oben)
  glReadPixels(0, 0, Viewport[2], Viewport[3], GL_BGRA, GL_UNSIGNED_BYTE, pPicData);

  //Und den ganzen Müll in die Datei schieben ;-)
  //Moderne Leute nehmen dafür auch Streams ...
  AssignFile(f, name);
  Rewrite( f,1 );
  try
   BlockWrite(F, FileHeader, SizeOf(BITMAPFILEHEADER));
   BlockWrite(F, FileInfo, SizeOf(BITMAPINFOHEADER));
   BlockWrite(F, pPicData^, FileInfo.biSizeImage );
  finally
   CloseFile(f);
  end;
 finally
  //Und den angeforderten Speicher wieder freigeben ...
  FreeMem(pPicData, FileInfo.biSizeImage);
 end;
end;

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

procedure ScreenShot(const Name : string);
var 
  DataBuffer : array of Byte;
  f : file;
  tgaHeader : TTGAHEADER;
  width, height : integer;
  DataSize:Integer;
  viewport : Array[0..3] of integer;
begin
  //Viewport-Größe lesen
  glGetIntegerv(GL_VIEWPORT, @viewport);
  width := viewport[2];
  height := viewport[3];

  //Größe der Daten berechnen
  DataSize := Width * Height * 3;

  //Größe des Puffers festlegen (Speicher reservieren)
  SetLength(DataBuffer,DataSize);

  // TGA Kopf mit Daten füllen
  ZeroMemory(@tgaHeader, SizeOf(tgaHeader));
  tgaHeader.tfImageType := 2; // TGA_RGB = 2
  tgaHeader.tfWidth := Width; 
  tgaHeader.tfHeight := Height;
  tgaHeader.tfBpp := 24;

  //Daten von OpenGL anfordern
  glReadPixels(0,0,Width, Height, GL_BGR, GL_UNSIGNED_BYTE, @DataBuffer[0]);
  
  //Datei erstellen
  AssignFile(f, Name);
  Rewrite( f,1 );
  try 
    // TGA Kopf in die Datei reinschreiben
    BlockWrite(F, tgaHeader, SizeOf(tgaHeader));

    // Die eigentlichen Bilddaten in die Datei schreiben
    BlockWrite(f, DataBuffer[0], DataSize );
  finally
    CloseFile(f);
  end;
end;

uses
    sdl, sdl_utils;

procedure SwapBGR(Surface: PSDL_Surface);
var
  x,y: Integer;
  pixel: UInt32;
  pred, pgreen, pblue, palpha: PUInt8;
  red, green, blue, alpha: UInt8;
begin
  for y:=0 to (Surface.h-1) do
    for x:=0 to (Surface.w-1) do
    begin
      //reads the pixels them
      pixel:=SDL_GetPixel(Surface, x, y);

      pred:=@red;
      pgreen:=@green;
      pblue:=@blue;
      palpha:=@alpha;

      //read and swap color
      SDL_GetRGBA(pixel,Surface.format, pred, pgreen, pblue, palpha);
      pixel:=SDL_MapRGBA(Surface.format, blue, green, red, alpha);

      SDL_PutPixel(Surface, x, y, pixel);
    end;
end;

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

//Speichert eine Surface in eine TGA-Datei.
//Surface wird am Ende freigegeben. Die Videosurface sollte also vorher geblittet werden
//und diese dann weitergereicht werden.
function SaveSurfacetoTGA(filename: String; surface: PSDL_Surface): Boolean;
var
  TGAHEADER : TTGAHEADER;

  rwop: PSDL_RWops;
  ImageSize: Integer;
  i : Integer;
begin
  Result:=False;

  //Prüfen, ob's was zu Speichern gibt ...  
  if not Assigned(surface) then
  begin
    writeln('Keine Surface übergeben');
    exit;
  end;

  //Haben wir ein Pixelformat mit mindestens 24 Bit?
  if surface.format.BytesPerPixel<3 then
  begin
    writeln('Farbtiefe nicht unterstützt');
    exit;
  end;

  //Müssen wir die Reihenfolge der Farbkanäle anpassen?
  if SDL_BYTEORDER<>SDL_BIG_ENDIAN then
  begin
    SwapBGR(surface);
  end;

  //Na gut, füllen wir den Header aus ...
  with TGAHEADER do
  begin
    tfType:=0;
    tfColorMapType:=0;
    tfImageType:=2;
    for i:=0 to 4 do
      tfColorMapSpec[i]:=0;
    tfOrigX:=0;
    tfOrigY:=0;
    tfWidth:=surface.w;
    tfHeight:=surface.h;
    tfBpp:=surface.format.BitsPerPixel;
    tfImageDes:=0;
  end;

  //Ermitteln des benötigten Speicherplatze...
  ImageSize:=surface.w*surface.h*surface.format.BytesPerPixel;

  //Datei zum Schreiben öffnen.
  rwop:=SDL_RWfromFile(PChar(filename),'w+b');
  if rwop=nil then
  begin
    Writeln('Fehler beim Erstellen des Rwops');
    exit;
  end;
  try
    //Versuchen, den Header in die Datei zu schreiben
    if SDL_RWWrite(rwop,@TGAHEADER,SizeOf(TGAHEADER),1)<>1 then
    begin
      writeln('Fehler beim Schreiben des Headers');
      exit;
    end;

    //Versuchen, die Bilddaten in die Datei zu schreibenSchreiben der Bilddaten
    if SDL_RWWrite(rwop,surface.pixels,ImageSize,1)<>1 then
    begin
      writeln('Fehler beim Schreiben der Daten');
      exit;
    end;

    //Scheinbar waren wir erfolgreich
    Result:=True;
  finally
    //Datei schließen ...
    SDL_RWClose(rwop);

    //Und das Surface freigeben
    SDL_FreeSurface(surface);
  end;
end;