hedgewars/uMisc.pas
changeset 5912 d31eba29e706
parent 5911 4a28d0ae9624
child 6267 be5d40bb1e86
equal deleted inserted replaced
5911:4a28d0ae9624 5912:d31eba29e706
    23 
    23 
    24 uses SDLh, uConsts, GLunit, uTypes;
    24 uses SDLh, uConsts, GLunit, uTypes;
    25 
    25 
    26 procedure movecursor(dx, dy: LongInt);
    26 procedure movecursor(dx, dy: LongInt);
    27 function  doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
    27 function  doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
    28 procedure MakeScreenshot(filename: shortstring);
    28 function  MakeScreenshot(filename: shortstring): boolean;
    29 function  GetTeamStatString(p: PTeam): shortstring;
    29 function  GetTeamStatString(p: PTeam): shortstring;
    30 
    30 
    31 procedure initModule;
    31 procedure initModule;
    32 procedure freeModule;
    32 procedure freeModule;
    33 
    33 
    43 Inc(x, dx);
    43 Inc(x, dx);
    44 Inc(y, dy);
    44 Inc(y, dy);
    45 SDL_WarpMouse(x, y);
    45 SDL_WarpMouse(x, y);
    46 end;
    46 end;
    47 
    47 
    48 
    48 // captures and saves the screen. returns true on success.
    49 procedure MakeScreenshot(filename: shortstring);
    49 function MakeScreenshot(filename: shortstring): Boolean;
    50 var p: Pointer;
    50 var success: boolean;
       
    51     p: Pointer;
    51     size: QWord;
    52     size: QWord;
    52     f: file;
    53     f: file;
    53     // Windows Bitmap Header
    54     // Windows Bitmap Header
    54     head: array[0..53] of Byte = (
    55     head: array[0..53] of Byte = (
    55     $42, $4D, // identifier ("BM")
    56     $42, $4D, // identifier ("BM")
    77 size:= toPowerOf2(cScreenWidth) * toPowerOf2(cScreenHeight) * 3;
    78 size:= toPowerOf2(cScreenWidth) * toPowerOf2(cScreenHeight) * 3;
    78 p:= GetMem(size);
    79 p:= GetMem(size);
    79 
    80 
    80 // memory could not be allocated
    81 // memory could not be allocated
    81 if p = nil then
    82 if p = nil then
    82     exit;
    83 begin
       
    84     AddFileLog('Error: Could not allocate memory for screenshot.');
       
    85     exit(false);
       
    86 end;
    83 
    87 
    84 // update header information and file name
    88 // update header information and file name
    85 
    89 
    86 filename:= UserPathPrefix + '/Screenshots/' + filename + '.bmp';
    90 filename:= UserPathPrefix + '/Screenshots/' + filename + '.bmp';
    87 
    91 
   112 if IOResult = 0 then
   116 if IOResult = 0 then
   113     begin
   117     begin
   114     BlockWrite(f, head, sizeof(head));
   118     BlockWrite(f, head, sizeof(head));
   115     BlockWrite(f, p^, size);
   119     BlockWrite(f, p^, size);
   116     Close(f);
   120     Close(f);
       
   121     success:= true;
       
   122     end
       
   123 else
       
   124     begin
       
   125     AddFileLog('Error: Could not write to ' + filename);
       
   126     success:= false;
   117     end;
   127     end;
   118 {$IOCHECKS ON}
   128 {$IOCHECKS ON}
   119 
   129 
   120 FreeMem(p, size)
   130 FreeMem(p, size);
       
   131 
       
   132 MakeScreenshot:= success;
   121 end;
   133 end;
   122 
   134 
   123 // http://www.idevgames.com/forums/thread-5602-post-21860.html#pid21860
   135 // http://www.idevgames.com/forums/thread-5602-post-21860.html#pid21860
   124 function doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
   136 function doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
   125 var convertedSurf: PSDL_Surface;
   137 var convertedSurf: PSDL_Surface;