SRL Archive - SRL Archives

{*******************************************************************************
function SaveScreenshotEx(Path : string; BlackoutUsername : boolean) : boolean;
By: Da 0wner improved by Shuttleu and a suggestion by Cazax
Description: Saves a screenshot of the RS screen to the Scripts folder inside
your SCAR folder and names it whatever you put for Name and blanks out the
username if BlackoutUsername is set to true.
*******************************************************************************}
function SaveScreenshotEx(Name : string; BlackoutUsername : boolean) : boolean;
var
  W, H, BMP, i : integer;
  Name1 : string;
begin
  GetClientDimensions(W, H);
  BMP := BitmapFromString(W, H, '');
  CopyClientToBitmap(BMP, 0, 0, W, H);
  if BlackoutUsername then
    GetBitmapCanvas(BMP).Rectangle(10, 460, 104, 472); // Thanks Cazax
  while True do
  begin
    if FileExists(AppPath + 'Scripts\' + Name + IntToStr(i) + '.bmp') then
      Inc(i) else
      begin
        Name1:= (AppPath + 'Scripts\' + Name + IntToStr(i) + '.bmp');
        break;
      end;
  end;
  SaveBitmap(BMP, Name1);
  result := FileExists(Name1);
end;

This basically saves a screenshot of RuneScape. It is very simple and crappy. It also can blackout the username in the bottom left. I tried to add more checks to see if the file existed but it errored.

To block out the username use GetBitmapCanvas.Rectange(X1, Y1, X2, Y2);.

I like the blackout username thing. Cool I guess

function SaveScreenshotEx(Name : string; BlackoutUsername : boolean) : boolean;
var
  W, H, BMP, i : integer;
  Name1 : string;
begin
  GetClientDimensions(W, H);
  BMP := BitmapFromString(W, H, '');
  CopyClientToBitmap(BMP, 0, 0, W, H);
  if BlackoutUsername then
    FastDrawSizeTransparent(10, 460, 104, 472, BitmapFromString(1, 1, 'beNpjYGAAAAADAAE='), BMP);
  while True do
  begin
    if FileExists(AppPath + 'Scripts\' + Name + IntToStr(i) + '.bmp') then
      Inc(i) else
      begin
        Name1:= (AppPath + 'Scripts\' + Name + IntToStr(i) + '.bmp');
        break;
      end;
  end;
   SaveBitmap(BMP, Name1);
   result := FileExists(Name1);
end;

:)

~shut

There, added what you said Cazax.

Also, I tried to add failsafes, but there was just too many errors :(.

{*******************************************************************************
function SaveScreenshotEx(Path : string; BlackoutUsername : boolean) : boolean;
By: Da 0wner fixed by Shuttleu
Description: Saves a screenshot of the RS screen to the Scripts folder inside
your SCAR folder and names it whatever you put for Name and blanks out the
username if BlackoutUsername is set to true.
*******************************************************************************}
function SaveScreenshotEx(Name : string; BlackoutUsername : boolean) : boolean;
var
  W, H, BMP, i : integer;
  Name1 : string;
begin
  GetClientDimensions(W, H);
  BMP := BitmapFromString(W, H, '');
  CopyClientToBitmap(BMP, 0, 0, W, H);
  if BlackoutUsername then
    GetBitmapCanvas(BMP).Rectangle(10, 460, 104, 472); // Thanks Cazax
  while True do
  begin
    if FileExists(AppPath + 'Scripts\' + Name + IntToStr(i) + '.bmp') then
      Inc(i) else
      begin
        Name1:= (AppPath + 'Scripts\' + Name + IntToStr(i) + '.bmp');
        break;
      end;
  end;
  SaveBitmap(BMP, Name1);
  result := FileExists(Name1);
end;

added Cazax's little bit

~shut

{*******************************************************************************
procedure TakeScreenshot(Path: string);
By: lordsaturn
Description: Takes a screenshot, saving it to 'Path'. Checks that .bmp is present.
*******************************************************************************}
procedure TakeScreenshot(Path: string);
var
  bmp, Width, Height: integer;
begin
  Width := 765; Height := 503;
  bmp:= BitmapFromString(Width, Height, '');
  SafeCopyCanvas(GetClientCanvas, GetBitmapCanvas(bmp), 0, 0, Width, Height, 0, 0, Width, Height);
  if Pos('.bmp', Path) = 0 then
    Path := Path + '.bmp';
  try
    SaveBitmap(bmp, Path);
  except
    Writeln('Failed saving screenshot to ' + Path);
    Exit;
  finally
    FreeBitmap(bmp);
  end;
  Writeln('Screenshot saved successfully to ' + Path);
end;

debug.scar

not sure if it realy needs to be any more fancy than that.

~RM

{*******************************************************************************
procedure TakeScreenshot(Path: string);
By: lordsaturn edited by shuttleu
Description: Takes a screenshot, saving it to 'Path'. Checks that .bmp is present.
*******************************************************************************}
procedure TakeScreenshot(Path: string; BlackoutUsername: Boolean);
var
  bmp, Width, Height: integer;
begin
  Width := 765; Height := 503;
  bmp:= BitmapFromString(Width, Height, '');
  SafeCopyCanvas(GetClientCanvas, GetBitmapCanvas(bmp), 0, 0, Width, Height, 0, 0, Width, Height);
  if BlackoutUsername then
    GetBitmapCanvas(BMP).Rectangle(10, 460, 104, 472);
  if Pos('.bmp', Path) = 0 then
    Path := Path + '.bmp';
  try
    SaveBitmap(bmp, Path);
  except
    Writeln('Failed saving screenshot to ' + Path);
    Exit;
  finally
    FreeBitmap(bmp);
  end;
  Writeln('Screenshot saved successfully to ' + Path);
end;

could be changed to that

~shut

{*******************************************************************************
procedure TakeScreenshot(Path: string; BlackoutUsername : boolean);
By: lordsaturn modified by Da 0wner and Shuttleu
Description: Takes a screenshot, saving it to 'Path'. Checks that .bmp is present.
                    Also blacks out the username if BlackoutUsername is set to true.
*******************************************************************************}
procedure TakeScreenshot(Path: string; BlackoutUsername: Boolean);
var
  bmp, Width, Height: integer;
begin
  Width := 765; 
  Height := 503;
  bmp:= BitmapFromString(Width, Height, '');
  SafeCopyCanvas(GetClientCanvas, GetBitmapCanvas(bmp), 0, 0, Width, Height, 0, 0, Width, Height);
  if BlackoutUsername then
    GetBitmapCanvas(BMP).Rectangle(10, 460, 104, 472);
  if Pos('.bmp', Path) = 0 then
    Path := Path + '.bmp';
  try
    SaveBitmap(bmp, Path);
  except
    Writeln('Failed saving screenshot to ' + Path);
    Exit;
  finally
    FreeBitmap(bmp);
  end;
  Writeln('Screenshot saved successfully to ' + Path);
end;

There, that is good to commit right?

{*******************************************************************************
procedure TakeScreenshot(Path: string; BlackoutUsername : boolean);
By: lordsaturn modified by Da 0wner and Shuttleu
Description: Takes a screenshot, saving it to 'Path'. Checks that .bmp is present.
                    Also blacks out the username if BlackoutUsername is set to true.
                    Also doesnt overwrite any other screenshots.
*******************************************************************************}
procedure TakeScreenshotEx(Path: string; BlackoutUsername: Boolean);
var
  bmp, Width, Height, i: integer;
  Path1: string;
begin
  Width := 765;
  Height := 503;
  bmp:= BitmapFromString(Width, Height, '');
  SafeCopyCanvas(GetClientCanvas, GetBitmapCanvas(bmp), 0, 0, Width, Height, 0, 0, Width, Height);
  if BlackoutUsername then
    GetBitmapCanvas(BMP).Rectangle(10, 460, 104, 472);
  while True do
  begin
    if FileExists(Path + IntToStr(i) + '.bmp') then
      Inc(i) else
      begin
        Path1:= (Path + IntToStr(i) + '.bmp');
        break;
      end;
  end;
  try
    SaveBitmap(bmp, Path1);
  except
    Writeln('Failed saving screenshot to ' + Path1);
    Exit;
  finally
    FreeBitmap(bmp);
  end;
  Writeln('Screenshot saved successfully to ' + Path1);
end;

?
that way if someone didnt want to loose their screenshots then they wouldnt loose them

~shut

Yes that is perfect :D.

You are aware that your change breaks scripts.. right?

From: Nava2
You are aware that your change breaks scripts.. right?

which is why i put Ex in the function name :)

~shut

From: Shuttleu
which is why i put Ex in the function name :)

~shut

Nava, you just lost :)

Awesome function + idea Da 0wner! I like it!
Someone should commit this

Not to be a kitten killer, but

while True do
  begin
    if FileExists(Path + IntToStr(i) + '.bmp') then
      Inc(i) else
      begin
        Path1:= (Path + IntToStr(i) + '.bmp');
        break;
      end;
  end;

Could be

  while FileExists(Path + IntToStr(i) + '.bmp') do
    Inc(i);
  Path1:= (Path + IntToStr(i) + '.bmp');

Also, adding a limit to it would make sense to stop a script malfunctioning and filling up the computer with millions of screenshots, such as

  while FileExists(Path + IntToStr(i) + '.bmp') and (i < 100) do
    Inc(i);
  if (i >= 100) then
    //Do whatever here - most likely a SRL warn combined with exit
  Path1:= (Path + IntToStr(i) + '.bmp');

From: mixster
Not to be a kitten killer, but

while True do
  begin
    if FileExists(Path + IntToStr(i) + '.bmp') then
      Inc(i) else
      begin
        Path1:= (Path + IntToStr(i) + '.bmp');
        break;
      end;
  end;

Could be

  while FileExists(Path + IntToStr(i) + '.bmp') do
    Inc(i);
  Path1:= (Path + IntToStr(i) + '.bmp');

i didnt think of that
thanks

{*******************************************************************************
procedure TakeScreenshot(Path: string; BlackoutUsername : boolean);
By: lordsaturn modified by Da 0wner and Shuttleu
Description: Takes a screenshot, saving it to 'Path'. Checks that .bmp is present.
                    Also blacks out the username if BlackoutUsername is set to true.
                    Also doesnt overwrite any other screenshots.
*******************************************************************************}
procedure TakeScreenshotEx(Path: string; BlackoutUsername: Boolean);
var
  bmp, Width, Height, i: integer;
  Path1: string;
begin
  Width := 765;
  Height := 503;
  bmp:= BitmapFromString(Width, Height, '');
  SafeCopyCanvas(GetClientCanvas, GetBitmapCanvas(bmp), 0, 0, Width, Height, 0, 0, Width, Height);
  if BlackoutUsername then
    GetBitmapCanvas(BMP).Rectangle(10, 460, 104, 472);
  while FileExists(Path + IntToStr(i) + '.bmp') do
    Inc(i);
  Path1:= (Path + IntToStr(i) + '.bmp');
  try
    SaveBitmap(bmp, Path1);
  except
    Writeln('Failed saving screenshot to ' + Path1);
    Exit;
  finally
    FreeBitmap(bmp);
  end;
  Writeln('Screenshot saved successfully to ' + Path1);
end;

~shut