[TIP] Capture d'écran OpenGL en Delphi

Toutes les questions sur OpenGL

Modérateurs: MarneusCalgarXP, NeopPheus

[TIP] Capture d'écran OpenGL en Delphi

Messagepar MarneusCalgarXP » 29 Juin 2005 16:01

Bon là c'est pas une question, c'est un bout de code que j'ai trouvé sur le net pour effectuer une capture d'écran au format bmp, et je le mets ici pour le partager !

Code: Tout sélectionner

procedure SaveOpengGLToBitmap(aFileName: String; aWidth, aHeight: Integer);
var
  bitmap: TBitmap;
  buf : PChar;
  bufSize: Integer;
  W, H: Integer;
  BitmapBytesPerPixel: Integer;
  ByteArrayIndex: Integer;
begin
  W := aWidth;
  H := aHeight;
  bufsize := W * H * 3;
 try
    GetMem(buf, bufsize);

    glPixelStorei(GL_PACK_ALIGNMENT, 0);    
        glPixelStorei(GL_UNPACK_ALIGNMENT, 0);
        glPixelStorei(GL_PACK_ROW_LENGTH, w);
        glPixelStorei(GL_UNPACK_ROW_LENGTH, h);
        glPixelStorei(GL_PACK_SKIP_ROWS, 0);
        glPixelStorei(GL_PACK_SKIP_PIXELS, 0);
    gluOrtho2D(0, w, 0, h);
    glRasterPos2i(0, 0);

    glReadPixels(0, 0, w, h, GL_RGB,GL_UNSIGNED_BYTE, buf);

    bitmap := TBitmap.Create;
    // assume raw data is RGB format
    BitmapBytesPerPixel := 3;            
    bitmap.PixelFormat := pf24bit;
    bitmap.HandleType := bmDIB;
    bitmap.Width := w;
    bitmap.Height := h;

    // Copy and remap the pixels from RGB Array to the Bitmap Scanlines
    ByteArrayIndex := 0;
    for Y := bitmap.Height - 1 downto 0 do
      begin
        ScanLineBytePointer := bitmap.ScanLine[Y];
        X := 0;
        repeat
          ScanLineBytePointer[X + 2] := ord(buf[ByteArrayIndex + 0]);
          ScanLineBytePointer[X + 1] := ord(buf[ByteArrayIndex + 1]);
          ScanLineBytePointer[X + 0] := ord(buf[ByteArrayIndex + 2]);

          Inc(X, BitmapBytesPerPixel);
          Inc(ByteArrayIndex, BitmapBytesPerPixel);
        until X > (bitmap.Width * BitmapBytesPerPixel) - 1;
      end;
    bitmap.SaveToFile(aFileName);

  finally
    FreeMem(buf);
    bitmap.Free;
  end;
 
Dark Skull Software
http://www.darkskull.net
Avatar de l’utilisateur
MarneusCalgarXP
Site Admin
 
Messages: 215
Inscrit le: 06 Mai 2005 15:35
Localisation: Lille

Retour vers OpenGL

Qui est en ligne ?

Utilisateur(s) parcourant ce forum : Aucun utilisateur inscrit et 1 invité

cron