hedgewars/uMisc.pas
changeset 1080 8735046fc698
parent 1066 1f1b3686a2b0
child 1121 d595dc56b4f3
--- a/hedgewars/uMisc.pas	Sun Jul 13 17:58:05 2008 +0000
+++ b/hedgewars/uMisc.pas	Mon Jul 14 20:24:29 2008 +0000
@@ -121,6 +121,7 @@
 procedure FreeTexture(tex: PTexture);
 function  toPowerOf2(i: Longword): Longword;
 function DecodeBase64(s: shortstring): shortstring;
+procedure MakeScreenshot(s: shortstring);
 
 var CursorPoint: TPoint;
     TargetPoint: TPoint = (X: NoPointX; Y: 0);
@@ -345,6 +346,36 @@
 byte(DecodeBase64[0]):= t - 1
 end;
 
+const GL_BGR = $80E0; // some opengl headers don't have that const (?)
+procedure MakeScreenshot(s: shortstring);
+const head: array[0..8] of Word = (0, 2, 0, 0, 0, 0, 0, 0, 24);
+var p: Pointer;
+	size: Longword;
+	f: file;
+begin
+head[6]:= cScreenWidth;
+head[7]:= cScreenHeight;
+
+size:= cScreenWidth * cScreenHeight * 3;
+p:= GetMem(size);
+
+glReadBuffer(GL_FRONT);
+glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_BGR, GL_UNSIGNED_BYTE, p);
+
+{$I-}
+Assign(f, s);
+Rewrite(f, 1);
+if IOResult = 0 then
+	begin
+	BlockWrite(f, head, sizeof(head));
+	BlockWrite(f, p^, size);
+	Close(f);
+	end;
+{$I+}
+
+FreeMem(p)
+end;
+
 {$IFDEF DEBUGFILE}
 procedure AddFileLog(s: shortstring);
 begin