[Back to MISC SWAG index] [Back to Main SWAG index] [Original]

    {   I've seen a LOT of programs which Say they are doing something like
        Reading/Writing to files, and you wonder if they have crashed or what,
        I think it would be nice to have a nice Status Bar to show the progress
        of what is going on!  so here's my contribution to everyone:
        Statbar:  Highly Accurate Status Bar..  }

    Uses crt;
    Procedure HideCursor; Assembler;  Asm                 {I forget where I got}
    MOV   ax,$0100;  MOV   cx,$2607;  INT   $10 end;    {     these two      }

    Procedure ShowCursor; Assembler; Asm
    MOV   ax,$0100;  MOV   cx,$0506;  INT   $10 end;

    Procedure Dupeit(Str: String; Num: Integer);  {Just a little Helper, dupes}
    var Cnt: integer;                             {        lines              }
    begin
    For Cnt := 1 to Num do begin
    write(Str);
    end;
    end;

    Procedure Statbar(cnum,enum,xspot,yspot,fullcolor,emptycolor: Integer);
    var percentage: Integer;              {Uh-Oh, here comes the Mathematical}
    begin                                 {                Crap!!            }
    Hidecursor;                                 {Kill That Damned Cursor!}
    percentage := round(cnum / enum * 100 / 2);   {/2 can be changed for}
      Gotoxy(xspot,yspot);                          {  Shorter Stat Bars  }
     Textcolor(fullcolor);
    dupeit(#219,Percentage);                {Can change the Char to whatever}
     Textcolor(emptycolor);
    dupeit(#177,50 - Percentage);                    {same as above}

      write('  ',percentage * 2,'%');         {this is not needed, just an extra}
    Showcursor;
    end;

    Procedure WriteXy(x,y: Integer; dstr: String; tcolor: integer);
    Begin
    Hidecursor;
    Gotoxy(x,y);                      { Yeah, I now it's Cheap and cheezy}
    Textcolor(tcolor);                 { but it gets the job done well! }
    write(dstr);
    Showcursor;
    end;

    var B1,B2,B3: integer;

    Begin

      Clrscr;
      WriteXy(30,3,'Statbar By CJ Cliffe..',yellow);

    Repeat

     Inc(B1,1);
     Inc(B2,1);
     Inc(B3,1);

    { The Statbar procedure works like so:

    Statbar(Current Number, Final Number, x location, y location,
                       Color of completed bars, color of empty bars);

    Will process (as far as I know) Any pairs of numbers, as long as the Current
    Number does not exceed the Final Number, everything should look fine.. }

       Statbar(B1,800,15,5,Lightcyan,Cyan);     {800 Just makes em go nice 'n}
       Statbar(B2,800,15,7,LightRed,Red);       {slow because they are FAST  }
       Statbar(B3,800,15,9,LightGreen,Green);

    Until B1 = 800;

     WriteXy(30,15,'Press any key to quit...',Lightblue);
     Readkey;

    end.

[Back to MISC SWAG index] [Back to Main SWAG index] [Original]