Page 1 of 2 12 LastLast
Results 1 to 25 of 36

Thread: Dg's Small Procedures

  1. #1
    Join Date
    Jan 2008
    Location
    10° north of Hell
    Posts
    2,035
    Mentioned
    65 Post(s)
    Quoted
    164 Post(s)

    Default Dg's Small Procedures

    When doing personal projects I tend too make some useful functions and procedures.
    So I'm gonna post them all here =)
    Some of these might already be in SCAR/Simba/SRL (I didn't see it?)

    Simba Code:
    {*******************************************************************************
    procedure RemoveArrIndex(Index: integer; var Arr: TStringArray);
    By: Dgby714, Smartzkid, Sandstorm
    Description: Removes the Index'th item from Arr
    *******************************************************************************}

    procedure RemoveArrIndex(Index: integer; var Arr: TStringArray);
    var
      I, P: integer;
    begin
      if (not (InRange(Index, Low(Arr), High(Arr)))) then
        Exit;
      P := High(Arr);
      for I := Index + 1 to P do
        Arr[I - 1] := Arr[I];
      SetArrayLength(Arr, Length(Arr) - 1);
    end;

    Simba Code:
    {*******************************************************************************
    function InArr(const Data, Arr: variant): boolean;
    By: Dgby714
    Description: Returns True if Data is a item in Arr.
    *******************************************************************************}

    function InArr(const Data, Arr: variant): boolean;
    var
      I, P, T: integer;
    begin
      if (VarType(Arr) = 8204) then
      begin
        P := High(TVariantArray(Arr));
        T := VarType(Data);
        for I := 0 to P do
          if (T = VarType(Arr[I])) then
            if (Data = Arr[I]) then
            begin
              Result := True;
              Exit;
            end;
      end;
    end;

    Simba Code:
    {*******************************************************************************
    function in_string(Text, Data: string): boolean;

    By: Dgby714
    Description: Returns True if Text is in Data
    *******************************************************************************}

    function in_string(Text, Data: string): boolean;
    begin
      Result := (Pos(Lowercase(Text), Lowercase(Data)) > 0);
    end;

    Simba Code:
    {*******************************************************************************
    procedure QScreenShot;
    By: Dgby714
    Description: Saves a screenshot into your AppPath/Screenshots
    *******************************************************************************}

    procedure QScreenShot;
    var
      Path, Filename: string;
      I: integer;
    begin
      Path := AppPath + 'Screenshots' + {$IFDEF WINDOWS}'\'{$ELSE}'/'{$ENDIF};
      if (not (DirectoryExists(Path))) then
        if (not (CreateDirectory(Path))) then
          RaiseException(erCustomError, 'Exception in QScreenShot: Cannot create directory "' + Path + '"');
      for I := 0 to High(I) do
      begin
        Filename := 'Screenshot_' + IntToStr(I) + '.bmp';
        if (not (FileExists(Path + Filename))) then
          Break;
      end;
      SaveScreenshot(Path + Filename);
      DebugLn('QScreenShot: Screenshot saved as "' + Path + Filename + '"');
    end;

    Simba Code:
    {*******************************************************************************
    function RandomKey(Len: integer): string;
    By: Dgby714, Sandstorm, Smartzkid
    Description: Returns a random string with Len Length
    *******************************************************************************}

    function RandomKey(Len: integer): string;
    var
      I: integer;
    begin
      Result := '';
      for I := 1 to Len do
        Result := Result + chr(33 + Random(93));
    end;

    Simba Code:
    {*******************************************************************************
    function Center(str: string; len: integer): string;
    By: Dgby714
    Description: Returns a str centered with len Length  [Center('hey', 5) = ' hey ']
    *******************************************************************************}

    function Center(str: string; len: integer): string;
    begin
      Result := Trim(str);
      while (Length(Result) < Len) do
      begin
        if (Length(Result) = (Len - 1)) then
          Result := Result + ' '
        else
          Result := ' ' + Result + ' ';
      end;
    end;

    Simba Code:
    {*******************************************************************************
    function TimeStamp: string;
    By: Dgby714
    Description: Returns the current time in 24 hour HH:MM:SS format
    *******************************************************************************}

    function TimeStamp: string;
    var
      Time: TDateTime;
      H, M, S, MS: word;
    begin
      Time := Now;
      DecodeTime(Time, H, M, S, MS);
      Result := Padz(IntToStr(H), 2) + ':' + Padz(IntToStr(M), 2) + ':' + Padz(IntToStr(S), 2);
    end;

    Simba Code:
    {*******************************************************************************
    procedure WaitEx(TimeInMS: integer);
    By: Dgby714
    Description: Waits TimeInMs + Rand(10%) unless 1000 > TimeInMS > 5000!
    *******************************************************************************}

    procedure WaitEx(TimeInMS: integer);
    var
      RandTime: integer;
    begin
      if (TimeInMS < 1000) then
        RandTime := Random(1000)
      else if (TimeInMS > 5000) then
        RandTime := Random(5000)
      else
        RandTime := Random(TimeInMS / 10);
      Wait(TimeInMS + RandTime);
    end;

    Simba Code:
    {*******************************************************************************
    procedure WriteINIArr(Section, Name: string; Arr: TStringArray; Filename: string);
    By: Dgby714
    Description: Writes Arr to Filename under Scetion (The items are named Name)
    *******************************************************************************}

    procedure WriteINIArr(Section, Name: string; Arr: TStringArray; Filename: string);
    var
      I: integer;
    begin
      WriteINI(Section, 'Name', Name, Filename);
      WriteINI(Section, 'Count', IntToStr(Length(Arr)), Filename);
      for I := Low(Arr) to High(Arr) do
        WriteINI(Section, Name + '[' + IntToStr(I) + ']', Arr[I], Filename);
    end;

    {*******************************************************************************
    function ReadINIArr(Section, Filename: string): TStringArray;
    By: Dgby714
    Description: Returns a array from Filename under Section (Use WriteINIArr first)
    *******************************************************************************}

    function ReadINIArr(Section, Filename: string): TStringArray;
    var
      Name: string;
      Count, I: integer;
    begin
      Name := ReadINI(Section, 'Name', Filename);
      Count := StrToIntDef(ReadINI(Section, 'Count', Filename), 0);
      SetArrayLength(Result, Count);
      for I := 0 to Count - 1 do
        Result[I] := ReadINI(Section, Name + '[' + IntToStr(I) + ']', Filename);
    end;

    Simba Code:
    {*******************************************************************************
    function ToExtended(Data: variant): extended;
    By: Dgby714
    Description: Returns Data as a Double/Extended
    *******************************************************************************}

    function ToExtended(Data: variant): extended;
    begin
      case VarType(Data) of
        varInteger, varInt64, varSmallInt, varShortInt, varWord, varLongWord, varByte: Result := Data * 1.0;
        varString, varOleStr: Result := StrToIntDef(Data, 0) * 1.0;
        varNull: Result := 0.0;
        varDouble: Result := Data;
        varBoolean: if (Data) then
            Result := 1.0
          else
            Result := 0.0;
      end;
    end;


    These next ones are some I've found aren't needed =/ Ill give why too.

    Simba Code:
    {*******************************************************************************
    function Space(num: integer): string;
    By: Dgby714
    Description: Returns num spaces
    *******************************************************************************}

    function Space(num: integer): string;
    var
      I: Integer;
    begin
      Result := '';
      for I := 0 to Num do
        Result := Result + ' ';
    end;
    This one can be....
    Simba Code:
    StringOfChar(' ', 5);
    Last edited by Dgby714; 08-10-2011 at 08:58 PM.

    Dg's Small Procedures | IRC Quotes
    Thank Wishlah for my nice new avatar!
    Quote Originally Posted by IRC
    [22:12:05] <Dgby714> Im agnostic
    [22:12:36] <Blumblebee> :O ...you can read minds

  2. #2
    Join Date
    Jan 2008
    Location
    10° north of Hell
    Posts
    2,035
    Mentioned
    65 Post(s)
    Quoted
    164 Post(s)

    Default

    Some useful integer array procedures.
    Simba Code:
    function MostCommonNumber(Arr: TIntegerArray): LongInt;
    var
      H, I, Cur, Count, HighCount: LongInt;
    begin
      QuickSort(Arr);
     
      Cur := Arr[0] - 1;
      Count := 0;
      HighCount := 0;
     
      H := High(Arr);
      for I := 0 to H do
      begin
        if (Cur <> Arr[I]) then
        begin
          if (Count > HighCount) then
          begin
            HighCount := Count;
            Result := Cur;
          end;

          Count := 0;
          Cur := Arr[I];
        end;

        Inc(Count);
      end;
    end;
    Simba Code:
    {*******************************************************************************
    procedure Push(var Arr: TIntegerArray; Val: integer);
    By: Dgby714
    Description: Pushes Val onto Arr.
    *******************************************************************************}

    procedure Push(var Arr: TIntegerArray; Val: integer);
    var
      L: integer;
    begin
      L := Length(Arr);
      SetLength(Arr, L + 1);
      Arr[L] := Val;
    end;

    {*******************************************************************************
    function Pop(var Arr: TIntegerArray): integer;
    By: Dgby714
    Description: Pops a val off of Arr.
    *******************************************************************************}

    function Pop(var Arr: TIntegerArray): integer;
    var
      H: integer;
    begin
      H := High(Arr);
      Result := Arr[H];
      SetLength(Arr, H);
    end;

    {*******************************************************************************
    function PopI(var Arr: TIntegerArray; Index: integer): integer;
    By: Dgby714
    Description: Pops val at Index off of Arr.
    *******************************************************************************}

    function PopI(var Arr: TIntegerArray; Index: integer): integer;
    var
      H, I: integer;
    begin
      H := High(Arr);
      Result := Arr[Index];
      for I := Index + 1 to H do
        Arr[I - 1] := Arr[I];
      SetLength(Arr, H);
    end;

    Simba Code:
    {*******************************************************************************
    function RandIntArr(L: integer): TIntegerArray;
    By: Dgby714
    Description: Creates a randomly sorted Integer array from 0 to L. Simple Solution.
    *******************************************************************************}

    function RandIntArr(L: integer): TIntegerArray;
    var
      I, J, H: integer;
      IntArr: TIntegerArray;
    begin
      SetLength(IntArr, L);
      for I := 0 to L - 1 do
        IntArr[I] := I;

      while (Length(IntArr) > 0) do
      begin
        SetLength(Result, Length(Result) + 1);
        J := Random(High(IntArr) + 1);
        Result[High(Result)] := IntArr[J];

        H := High(IntArr);
        for I := J + 1 to H do
          IntArr[I - 1] := IntArr[I];
        SetLength(IntArr, Length(IntArr) - 1);
      end;
    end;

    Simba Code:
    {*******************************************************************************
    function RandIntArr(L: integer): TIntegerArray;
    By: Dgby714
    Description: Creates a randomly sorted Integer array from 0 to L. Elegant Solution.
    *******************************************************************************}

    function RandIntArr(L: integer): TIntegerArray;
    var
      I, J, H, C: integer;
      RArr: TPointArray;
    begin
      SetLength(RArr, 1);
      RArr[0] := Point(0, L - 1);

      SetLength(Result, L);
      C := 0;

      while (Length(RArr) > 0) do
      begin
        J := Random(Length(RArr));
        Result[C] := RandomRange(RArr[J].X, RArr[J].Y);

        if (not ((Result[C] = RArr[J].X) or (Result[C] = RArr[J].Y))) then
        begin
          SetLength(RArr, Length(RArr) + 1);
          RArr[High(RArr)] := Point(Result[C] + 1, RArr[J].Y);
          RArr[J].Y := Result[C] - 1;
        end else
        begin
          if ((Result[C] = RArr[J].X) and (Result[C] = RArr[J].Y)) then
          begin
             H := High(RArr);
             for I := J + 1 to H do
               RArr[I - 1] := RArr[I];
             SetLength(RArr, Length(RArr) - 1);

             Inc(C);
             Continue;
          end;

          if (Result[C] = RArr[J].X) then
            Inc(RArr[J].X);

          if (Result[C] = RArr[J].Y) then
            Dec(RArr[J].Y);
        end;

        Inc(C);
      end;
    end;

    Simba Code:
    {*******************************************************************************
    function DownloadToFile(const URL, Filename: string): boolean;
    By: Dgby714
    Description: Downloading file from URL to Filename.
    *******************************************************************************}

    function DownloadToFile(const URL, Filename: string): boolean;
    var
      FileI: LongInt;
      FileC, FileH: string;
    begin
      Result := (not (FileExists(Filename)));
      if (Result) then
      begin
        Result := False;
        FileI := InitializeHTTPClient(True);
        try
          FileC := GetHTTPPage(FileI, URL);
          FileH := GetRawHeaders(FileI);

          if ((FileC = '') or (FileH = '')) then
          begin
            WriteLn('Error downloading "' + URL + '".');
            Exit;
          end;

          FileH := Copy(GetRawHeaders(FileI), 10, Pos(#13, FileH) - 10); //Error Code
          if (FileH <> '200 OK') then
          begin
            WriteLn('Couldn''t download "' + URL + '", Error Code: ' + FileH + '.');
            Exit;
          end;
        finally
          FreeHTTPClient(FileI);
        end;

        FileI := CreateFile(Filename);
        try
          Result := WriteFileString(FileI, FileC);
        finally
          CloseFile(FileI);
        end;
      end;
    end;

    Simba Code:
    function IntToStrC(const Num: LongInt): string; //IntToStr with commas
    begin
      Result := Format('%M', [Extended(Num)]);
      Result := Copy(Result, 2, Length(Result) - 4);
    end;

    Simba Code:
    procedure CopyIntArr(const Src: TIntegerArray; out Dest: TIntegerArray);
    var
      I, H: LongInt;
    begin
      H := Length(Src);
      SetLength(Dest, H);
      Dec(H);
      for I := 0 to H do
        Dest[I] := Src[I];
    end;

    procedure Copy2DIntArr(const Src: T2DIntegerArray; out Dest: T2DIntegerArray);
    var
      I, H: LongInt;
    begin
      H := Length(Src);
      SetLength(Dest, H);
      Dec(H);
      for I := 0 to H do
        CopyIntArr(Src[I], Dest[I]);
    end;

    Simba Code:
    //FloatToStr that handles filtering letters out... 'l33t' = 33
    function GetNumbers(const x: string): Extended;
    begin
      Result := StrToFloatDef(ReplaceRegExpr('[^\d+-\.]*([-+]?[0-9]*\.?[0-9]+)[^\d]*', x, '$1', True), 0);
    end;
    Last edited by Dgby714; 04-03-2013 at 02:33 AM.

    Dg's Small Procedures | IRC Quotes
    Thank Wishlah for my nice new avatar!
    Quote Originally Posted by IRC
    [22:12:05] <Dgby714> Im agnostic
    [22:12:36] <Blumblebee> :O ...you can read minds

  3. #3
    Join Date
    Jan 2008
    Location
    10° north of Hell
    Posts
    2,035
    Mentioned
    65 Post(s)
    Quoted
    164 Post(s)

    Default

    Not exactly a procedure/function, but @Probably Glitched; needed help with this so I made it after seeing @bob_dole;'s version (here).

    Simba Code:
    program MinimapBuilder;
    {$DEFINE SMART}
    {$I SRL-OSR/SRL.Simba}

    const
      Width = 4;
      Height = 2;
      FileName = 'Minimaps/minimap1.bmp';

    function getCircle(Radius: LongInt; Center: TPoint): TPointArray;
    var
      RadiusSqrd: Extended;
      X, Y, I: LongInt;
    begin
      RadiusSqrd := Sqr(Radius);
      SetLength(Result, Floor(Pi * RadiusSqrd));

      for X := -Radius to Radius do
        for Y := -Radius to Radius do
          if ((Sqr(X) + Sqr(Y)) <= RadiusSqrd) then
          begin
            Result[I] := Point(X + Center.X, Y + Center.Y);
            Inc(I);
          end;

      SetLength(Result, I);
    end;

    procedure WaitForSmart(Enable: Boolean);
    begin
      repeat
        Wait(10);
      until (Enable = SmartEnabled(SmartCurrentTarget));
    end;

    var
      Circle: TPointArray;
      Bitmap, I: LongInt;
      Colors: TIntegerArray;

    begin
      Circle := getCircle(66, Point(642, 76));

      SetupSRL();
      Bitmap := CreateBitmap(Width * 132 + 1, Height * 132 + 1);

      for I := 0 to Width * Height - 1 do
      begin
        WaitForSmart(True);

        WriteLn('Saving map #' + IntToStr(I) + '... ');
        try
          Colors := GetColors(Circle);
          FastSetPixels(Bitmap, getCircle(66, Point(132 * (I mod Width) + 66, 132 * Floor(I div Width) + 66)), Colors);
        except
          WriteLn('Error Saving?');
          Continue;
        end;
        WriteLn('Saved!');

        WaitForSmart(False);
      end;

      SaveBitmap(Bitmap, FileName);

      DrawBitmapDebugImg(Bitmap);
      DisplayDebugImgWindow(Width * 132, Height * 132);

      FreeBitmap(Bitmap);
    end.
    Last edited by Dgby714; 12-17-2014 at 05:01 AM.

    Dg's Small Procedures | IRC Quotes
    Thank Wishlah for my nice new avatar!
    Quote Originally Posted by IRC
    [22:12:05] <Dgby714> Im agnostic
    [22:12:36] <Blumblebee> :O ...you can read minds

  4. #4
    Join Date
    Oct 2009
    Location
    Stockton, CA
    Posts
    2,040
    Mentioned
    0 Post(s)
    Quoted
    1 Post(s)

    Default

    Why is this in tutorials?
    Join the IRC! irc.rizon.net:6667/srl | SQLite (0.99rc3+) | SRL Doc | Simba Doc | Extra Simba Libraries (openSSL & sqlite3)
    Quote Originally Posted by #srl
    10:45 < Toter> daphil when can get sex anyday I want
    10:45 < Toter> he is always on #SRL
    "A programmer is just a tool which converts caffeine into code"

  5. #5
    Join Date
    Jan 2008
    Location
    10° north of Hell
    Posts
    2,035
    Mentioned
    65 Post(s)
    Quoted
    164 Post(s)

    Default

    Quote Originally Posted by Sex View Post
    Why is this in tutorials?
    Where else should i of put it?

    Dg's Small Procedures | IRC Quotes
    Thank Wishlah for my nice new avatar!
    Quote Originally Posted by IRC
    [22:12:05] <Dgby714> Im agnostic
    [22:12:36] <Blumblebee> :O ...you can read minds

  6. #6
    Join Date
    May 2007
    Location
    Everywhere
    Posts
    1,428
    Mentioned
    0 Post(s)
    Quoted
    2 Post(s)

    Default

    Cool, good job.
    I'm going to find this one useful soon

    Simba Code:
    {*******************************************************************************
    function in_string(Text, Data: string): boolean;
    By: Dgby714
    Description: Returns True if Text is in Data
    *******************************************************************************}

    function in_string(Text, Data: string): boolean;
    begin
      Result := (PosEx(Lowercase(Text), Lowercase(Data), 1) > 0);
    end;

  7. #7
    Join Date
    May 2007
    Location
    England
    Posts
    4,140
    Mentioned
    11 Post(s)
    Quoted
    266 Post(s)

    Default

    Quote Originally Posted by Dgby714 View Post
    Where else should i of put it?
    Here.
    <3

    Quote Originally Posted by Eminem
    I don't care if you're black, white, straight, bisexual, gay, lesbian, short, tall, fat, skinny, rich or poor. If you're nice to me, I'll be nice to you. Simple as that.

  8. #8
    Join Date
    Jan 2008
    Location
    10° north of Hell
    Posts
    2,035
    Mentioned
    65 Post(s)
    Quoted
    164 Post(s)

    Default

    Quote Originally Posted by Rich View Post
    I don't want them added too SRL though? I was just posting them so other could use them.

    Dg's Small Procedures | IRC Quotes
    Thank Wishlah for my nice new avatar!
    Quote Originally Posted by IRC
    [22:12:05] <Dgby714> Im agnostic
    [22:12:36] <Blumblebee> :O ...you can read minds

  9. #9
    Join Date
    May 2007
    Location
    England
    Posts
    4,140
    Mentioned
    11 Post(s)
    Quoted
    266 Post(s)

    Default

    Quote Originally Posted by Dgby714 View Post
    I don't want them added too SRL though? I was just posting them so other could use them.
    Here then.
    Test Corner Post your procedures and functions here
    <3

    Quote Originally Posted by Eminem
    I don't care if you're black, white, straight, bisexual, gay, lesbian, short, tall, fat, skinny, rich or poor. If you're nice to me, I'll be nice to you. Simple as that.

  10. #10
    Join Date
    Jan 2008
    Location
    10° north of Hell
    Posts
    2,035
    Mentioned
    65 Post(s)
    Quoted
    164 Post(s)

    Default

    Quote Originally Posted by Rich View Post
    Isn't that for testing?

    Well if a mod+ see this they can move it there^

    Dg's Small Procedures | IRC Quotes
    Thank Wishlah for my nice new avatar!
    Quote Originally Posted by IRC
    [22:12:05] <Dgby714> Im agnostic
    [22:12:36] <Blumblebee> :O ...you can read minds

  11. #11
    Join Date
    May 2008
    Posts
    1,345
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    Simba Code:
    {*******************************************************************************
    function Center(str: string; len: integer): string;
    By: Dgby714
    Description: Returns a str centered with len Length  [Center('hey', 5) = ' hey ']
    *******************************************************************************}

    function Center(str: string; len: integer): string;
    begin
      Result := Trim(str);
      while (Length(Result) < Len) do
      begin
        if (Length(Result) = (Len - 1)) then
        begin
          Result := Result + ' ';
        end else
        begin
          Result := ' ' + Result + ' ';
        end;
      end;
    end;

    If syntax is the same as SCAR:

    Simba Code:
    {*******************************************************************************
    function Center(str: string; len: integer): string;
    By: Dgby714
    Description: Returns a str centered with len Length  [Center('hey', 5) = ' hey ']
    *******************************************************************************}

    function Center(str: string; len: integer): string;
    begin
      Result := Trim(str);
      while (Length(Result) < Len) do
      begin
        if (Length(Result) = (Len - 1)) then
          Result := Result + ' '
        else
          Result := ' ' + Result + ' ';
      end;
    end;;

    Simba Code:
    {*******************************************************************************
    function TimeStamp: string;
    By: Dgby714
    Description: Returns the current time in 24 hour HH:MM:SS format
    *******************************************************************************}

    function TimeStamp: string;
    var
      H, M, S, MS: word;
    begin
      DecodeTime(Now, H, M, S, MS);
      Result := Padz(IntToStr(H), 2) + ':' + Padz(IntToStr(M), 2) + ':' + Padz(IntToStr(S), 2);
    end;

    Not sure if that second one is properly done, but it cuts out an unneeded variable.

    Simba Code:
    {*******************************************************************************
    function RandomKey(Len: integer): string;
    By: Dgby714
    Description: Returns a random string with Len Length
    *******************************************************************************}

    function RandomKey(Len: integer): string;
    begin
      while (not (Length(Result) >= Len)) do
      begin
        Result := Result + Chr(RandomRange(33, 125))
      end;
    end;

    Just some shortenings. Don't ask me why :|.
    Last edited by Sandstorm; 10-14-2010 at 01:57 AM.

  12. #12
    Join Date
    Jan 2008
    Location
    10° north of Hell
    Posts
    2,035
    Mentioned
    65 Post(s)
    Quoted
    164 Post(s)

    Default

    Quote Originally Posted by Sandstorm View Post
    Simba Code:
    {*******************************************************************************
    function Center(str: string; len: integer): string;
    By: Dgby714
    Description: Returns a str centered with len Length  [Center('hey', 5) = ' hey ']
    *******************************************************************************}

    function Center(str: string; len: integer): string;
    begin
      Result := Trim(str);
      while (Length(Result) < Len) do
      begin
        if (Length(Result) = (Len - 1)) then
          Result := Result + ' '
        else
          Result := ' ' + Result + ' ';
      end;
    end;;

    Simba Code:
    {*******************************************************************************
    function TimeStamp: string;
    By: Dgby714
    Description: Returns the current time in 24 hour HH:MM:SS format
    *******************************************************************************}

    function TimeStamp: string;
    var
      H, M, S, MS: word;
    begin
      DecodeTime(Now, H, M, S, MS);
      Result := Padz(IntToStr(H), 2) + ':' + Padz(IntToStr(M), 2) + ':' + Padz(IntToStr(S), 2);
    end;

    Simba Code:
    {*******************************************************************************
    function RandomKey(Len: integer): string;
    By: Dgby714
    Description: Returns a random string with Len Length
    *******************************************************************************}

    function RandomKey(Len: integer): string;
    begin
      while (not (Length(Result) >= Len)) do
      begin
        Result := Result + Chr(RandomRange(33, 125))
      end;
    end;
    Yeah idk why i added those begin/ends

    I got a type mismatch when using Now directly in DecodeTime...

    I made RandomKey before i knew about Chr()

    Dg's Small Procedures | IRC Quotes
    Thank Wishlah for my nice new avatar!
    Quote Originally Posted by IRC
    [22:12:05] <Dgby714> Im agnostic
    [22:12:36] <Blumblebee> :O ...you can read minds

  13. #13
    Join Date
    May 2008
    Posts
    1,345
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    I personally don't have Simba installed, and will probably be sticking to SCAR, so those DO compile in SCAR, and I am completely clueless about what will compile in Simba.

  14. #14
    Join Date
    Jan 2008
    Location
    10° north of Hell
    Posts
    2,035
    Mentioned
    65 Post(s)
    Quoted
    164 Post(s)

    Default

    They should all compile in Simba too

    Added some functions i just made for my IRC bot =)

    Dg's Small Procedures | IRC Quotes
    Thank Wishlah for my nice new avatar!
    Quote Originally Posted by IRC
    [22:12:05] <Dgby714> Im agnostic
    [22:12:36] <Blumblebee> :O ...you can read minds

  15. #15
    Join Date
    Jan 2010
    Posts
    5,227
    Mentioned
    6 Post(s)
    Quoted
    60 Post(s)

    Default

    Pascal Code:
    {*******************************************************************************
    function Center(str: string; len: integer): string;
    By: Dgby714
    Description: Returns a str centered with len Length  [Center('hey', 5) = ' hey ']
    *******************************************************************************}

    function Center(str: string; len: integer): string;
    begin
      Result := Trim(str);
      while (Length(Result) < Len) do
        if (Length(Result) = (Len - 1)) then
          Result := Result + ' '
        else
          Result := ' ' + Result + ' ';
    end;

    :3

    Looks nice btw.

  16. #16
    Join Date
    Sep 2006
    Location
    New Jersey, USA
    Posts
    5,347
    Mentioned
    1 Post(s)
    Quoted
    3 Post(s)

    Default

    Simba Code:
    {*******************************************************************************
    procedure RemoveArrIndex(Index: integer; var Arr: TStringArray);
    By: Dgby714
    Description: Removes the Index'th item from Arr
    *******************************************************************************}

    procedure RemoveArrIndex(Index: integer; var Arr: TStringArray);
    var
      I: integer;
    begin
      if (not (InRange(Index, Low(Arr), High(Arr)))) then
        Exit;

      for I := Index + 1 to High(Arr) do
        Arr[I - 1] := Arr[I];
      SetArrayLength(Arr, Length(Arr) - 1);
    end;

    I believe that would do the same thing a bit quicker. Could this be changed to Array of Variant so it would work for any array?

    Simba Code:
    {*******************************************************************************
    function RandomKey(Len: integer): string;
    By: Dgby714
    Description: Returns a random string with Len Length
    *******************************************************************************}

    function RandomKey(Len: integer): string;
    var
      cTemp: char;
    begin
      Result := '';
      while (not (Length(Result) >= Len)) do
      begin
        cTemp := chr(33 + Random(93));
        Result := Result + cTemp;
      end;
    end;

    Ought to be a great deal quicker. If you want to optimize it even more, use a for loop.
    Last edited by Smartzkid; 10-14-2010 at 02:44 AM.
    Interested in C# and Electrical Engineering? This might interest you.

  17. #17
    Join Date
    May 2008
    Posts
    1,345
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    Simba Code:
    {*******************************************************************************
    procedure RemoveArrIndex(Index: integer; var Arr: TStringArray);
    By: Dgby714
    Description: Removes the Index'th item from Arr
    *******************************************************************************}

    procedure RemoveArrIndex(Index: integer; var Arr: TStringArray);
    var
      I, P : integer;
    begin
      if (not (InRange(Index, Low(Arr), High(Arr)))) then
        Exit;
      P := High(Arr);
      for I := Index + 1 to P do
        Arr[I - 1] := Arr[I];
      SetArrayLength(Arr, Length(Arr) - 1);
    end;

    Would, I believe, be even faster. Doesn't have to do High(Arr) every time it loops.

  18. #18
    Join Date
    Jan 2008
    Location
    10° north of Hell
    Posts
    2,035
    Mentioned
    65 Post(s)
    Quoted
    164 Post(s)

    Default

    Quote Originally Posted by Smartzkid View Post
    I believe that would do the same thing a bit quicker. Could this be changed to Array of Variant so it would work for any array?
    I dont thing the TVariantArray works the same as a Variant. If we changed it you wouldn't be able to pass a TStringArray as the parameter, or any other array. It would be looking for a TVariantArray.

    Ex:
    Simba Code:
    program new;

    procedure Test(TestArr: TVariantArray);
    begin
    end;

    var
      TestArr2: TStringArray;

    begin
      Test(TestArr2);
    end.

    Results in
    Code:
    Error: Type Mismatch at line 11

    Dg's Small Procedures | IRC Quotes
    Thank Wishlah for my nice new avatar!
    Quote Originally Posted by IRC
    [22:12:05] <Dgby714> Im agnostic
    [22:12:36] <Blumblebee> :O ...you can read minds

  19. #19
    Join Date
    Sep 2006
    Location
    New Jersey, USA
    Posts
    5,347
    Mentioned
    1 Post(s)
    Quoted
    3 Post(s)

    Default

    Quote Originally Posted by Sandstorm View Post
    Simba Code:
    {*******************************************************************************
    procedure RemoveArrIndex(Index: integer; var Arr: TStringArray);
    By: Dgby714
    Description: Removes the Index'th item from Arr
    *******************************************************************************}

    procedure RemoveArrIndex(Index: integer; var Arr: TStringArray);
    var
      I, P : integer;
    begin
      if (not (InRange(Index, Low(Arr), High(Arr)))) then
        Exit;
      P := High(Arr);
      for I := Index + 1 to P do
        Arr[I - 1] := Arr[I];
      SetArrayLength(Arr, Length(Arr) - 1);
    end;

    Would, I believe, be even faster. Doesn't have to do High(Arr) every time it loops.
    Yup!

    Quote Originally Posted by Dgby714 View Post
    I dont thing the TVariantArray works the same as a Variant. If we changed it you wouldn't be able to pass a TStringArray as the parameter, or any other array. It would be looking for a TVariantArray.[/Code]
    I see.

    Simba Code:
    program new;

    procedure Test(TestArr: variant);
    var
    i: integer;
    begin
      for i := 0 to 9 do
        writeln(testarr[i]);
    end;

    var
      TestArr2: TStringArray;
      i: integer;

    begin
      setlength(testarr2, 10);
      for i := 0 to 9 do
        testarr2[i] := inttostr(i);
      Test(TestArr2);
    end.

    That works, but when you declare the variant as a var, it gives trouble. Sadly, I don't think there is a solution.
    Interested in C# and Electrical Engineering? This might interest you.

  20. #20
    Join Date
    Jan 2008
    Location
    10° north of Hell
    Posts
    2,035
    Mentioned
    65 Post(s)
    Quoted
    164 Post(s)

    Default

    Quote Originally Posted by Smartzkid View Post
    ...
    Hmm Make more procedures instead like a RemoveIntArrIndex?

    Dg's Small Procedures | IRC Quotes
    Thank Wishlah for my nice new avatar!
    Quote Originally Posted by IRC
    [22:12:05] <Dgby714> Im agnostic
    [22:12:36] <Blumblebee> :O ...you can read minds

  21. #21
    Join Date
    Sep 2006
    Location
    New Jersey, USA
    Posts
    5,347
    Mentioned
    1 Post(s)
    Quoted
    3 Post(s)

    Default

    Or get someone to write it for simba, in which case it could work like writeln
    Interested in C# and Electrical Engineering? This might interest you.

  22. #22
    Join Date
    Jan 2008
    Location
    10° north of Hell
    Posts
    2,035
    Mentioned
    65 Post(s)
    Quoted
    164 Post(s)

    Default

    Quote Originally Posted by Smartzkid View Post
    Or get someone to write it for simba, in which case it could work like writeln
    That wont work... But i think we could make it
    Simba Code:
    function RemoveArrIndex(Index: integer; Arr: Variant): Variant;
    Altho we would need to change the guts a little...

    Dg's Small Procedures | IRC Quotes
    Thank Wishlah for my nice new avatar!
    Quote Originally Posted by IRC
    [22:12:05] <Dgby714> Im agnostic
    [22:12:36] <Blumblebee> :O ...you can read minds

  23. #23
    Join Date
    Jan 2008
    Location
    10° north of Hell
    Posts
    2,035
    Mentioned
    65 Post(s)
    Quoted
    164 Post(s)

    Default

    Quote Originally Posted by Smartzkid View Post
    Simba Code:
    {*******************************************************************************
    function RandomKey(Len: integer): string;
    By: Dgby714
    Description: Returns a random string with Len Length
    *******************************************************************************}

    function RandomKey(Len: integer): string;
    var
      cTemp: char;
    begin
      Result := '';
      while (not (Length(Result) >= Len)) do
      begin
        cTemp := chr(33 + Random(93));
        Result := Result + cTemp;
      end;
    end;

    Ought to be a great deal quicker. If you want to optimize it even more, use a for loop.
    Wouldn't this be faster?
    Simba Code:
    {*******************************************************************************
    function RandomKey(Len: integer): string;
    By: Dgby714, Sandstorm, Smartzkid
    Description: Returns a random string with Len Length
    *******************************************************************************}

    function RandomKey(Len: integer): string;
    var
      I: integer;
    begin
      SetLength(Result, Len);
      for I := 1 to Len do
        Result[I] := chr(33 + Random(93));
    end;

    Dg's Small Procedures | IRC Quotes
    Thank Wishlah for my nice new avatar!
    Quote Originally Posted by IRC
    [22:12:05] <Dgby714> Im agnostic
    [22:12:36] <Blumblebee> :O ...you can read minds

  24. #24
    Join Date
    Feb 2007
    Location
    Alberta,Canada
    Posts
    2,358
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    Quote Originally Posted by Dgby714 View Post
    Wouldn't this be faster?
    Simba Code:
    {*******************************************************************************
    function RandomKey(Len: integer): string;
    By: Dgby714, Sandstorm, Smartzkid
    Description: Returns a random string with Len Length
    *******************************************************************************}

    function RandomKey(Len: integer): string;
    var
      I: integer;
    begin
      SetLength(Result, Len);
      for I := 1 to Len do
        Result[I] := chr(33 + Random(93));
    end;
    Are you sure that would work? You deal with the string like it's an array which I didn't think was possible...

  25. #25
    Join Date
    Jan 2010
    Posts
    5,227
    Mentioned
    6 Post(s)
    Quoted
    60 Post(s)

    Default

    It would work if you imploded Result after, but that'd just make it longer for no reason (since you can't use Implode unless you change each item in the array to a string).

    pascal Code:
    {*******************************************************************************
    function RandomKey(Len: integer): string;
    By: Dgby714, Sandstorm, Smartzkid
    Description: Returns a random string with Len Length
    *******************************************************************************}

    function RandomKey(Len: Integer): string;
    var
      i: Integer;
    begin
      for i := 0 to Len - 1 do
        Result := Result + chr(33 + Random(93));
    end;

    That works nicely.

Page 1 of 2 12 LastLast

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •