{ Ultima alteracao em 27/12/2001 21:55 }
unit inutil2;
Interface
Uses Crt,graph,DOS;

Type
  tCordenada = record
    x,y:word;
  end;
  thora = record
    h,m,s,c : byte;
  end;

 { -- Move o cursor - duh -- }
 Procedure MoveCursor(x,y: byte); {ASM}

 { -- Escreve Centralizado -- }
 Procedure Writec(y:integer; texto:string);
 { -- Idem para modo grafico -- }
 Procedure Outtextxyc(y:integer; texto:string);

 { -- Escreve a direita -- }
 Procedure Writed(y:integer; texto:string);
 { -- Idem para modo grafico -- }
 Procedure Outtextxyd(y:integer; texto:string);

 { -- As procedures a seguir escrevem em xy no modo texto -- }
 Procedure Writexy(x,y:byte;s: string);
{ Procedure putstr(x,y:byte;s:string);}
 Procedure putstr(x,y:byte;s:string);
 Procedure putchar(x,y: byte; c : char); { ASM }

 { -- Limpa a area da tela. Em ClearArea voce pode determinar o caractere que vai ser usado -- }
 Procedure LimpaArea(x1,y1,x2,y2:byte);
 Procedure ClearArea(x1,y1,x2,y2:byte;c:char);

 { -- Troca o valor de duas Integers -- }
 Procedure Trocari(var x,y:integer);
 { -- Idem para Strings -- }
 Procedure Trocars(var x,y:string);
 { -- Troca o valor das variaveis -- }
 Procedure trocachar(var a,b:char);
 Procedure trocaint(var a,b:integer);
 Procedure trocalint(var a,b:longint);
 Procedure trocareal(var a,b:real);

 { -- Inicia modo grafico -- }
 Procedure IniciarModoGrafico(s: string);

 { -- Retorna uma string a partir de uma integer -- }
 Function IToS(I: longint): String;
 { -- Mesma funcao, nome diferente para manter compatibilidade -- }
 Function str_(I:longint): String;
 { -- Retorna uma integer a partir de uma string -- }
 Function SToI(S: string): longInt;
 { -- Mesma funcao, nome diferente para manter compatibilidade -- }
 Function val_(S: string): longint;

 { -- Retorna a string em caixa alta -- }
 Function UpCaseStr(S:string): string;

 { -- Converte Angulos de graus para radianos -- }
 Function GraustoRad (a: integer):real;
 { -- Converte Angulos de radianos para graus -- }
 Function RadtoGraus (a: real):integer;

 { -- Limpa o buffer do teclado -- }
 Procedure limpakey;
 { -- O Computador 'dorme' durante Cs centesimos de segundo.
 esta procedure se baseia no relogio do micro, portanto teoricamente o
 computador para o mesmo tempo em qualquer PC, ao contrario do Delay.
  Entretanto, devido a imprecisoes do relogio do micro, nao espere uma
  precisao maior que 5 centesimos de segundo... -- }
 Procedure Sleep(Cs:word);
 { -- Tentativa de fazer a sleep em assembly... NÆo a use, nÆo funciona..-- }
 Procedure Sleep2(Cs:word);
 { -- Espera cs centesimos de segundos, ou ate uma tecla ser precionada.
 Caso resetar seja true, chama limpakey -- }
 Procedure daumtempo(cs:word;resetar:boolean);

 { -- O nome diz tudo -- }
 Procedure SetText80x25;
 Procedure SetText80x50;

 { -- Retorna TRUE se o arquivo existir -- }
 Function FileExists(FileName: String): Boolean;

 { -- Retorna o maior/menor numero entre os passados -- }
 Function  maior (a,b:real):real;
 Function  menor (a,b:real):real;
 Function  maiori(a,b:longint):longint;
 Function  menori(a,b:longint):longint;

 { -- Funcionam como o ()?() do C. Se for true, retorna o segundo parametro, se nao, retorna zero ou uma string vazia -- }
 Function  ifint (expressao:boolean;v:longint):longint;
 Function  ifreal(expressao:boolean;v:real):real;
 Function  ifstr (expressao:boolean;v:string):string;
 { -- Funcionam como o ()?():() do C. Se for true, retorna o primeiro, se nao o segundo-- }
 Function  ifinte (expressao:boolean;v,f:longint):longint;
 Function  ifreale(expressao:boolean;v,f:real):real;
 Function  ifstre (expressao:boolean;v,f:string):string;

 Function  strp(s:string;tam:byte;c:char):string;
 Function  stre(num:longint;tam:byte):string;
 Function  poe0(num:longint;tam:byte):string;


Implementation

 Procedure MoveCursor; Assembler;
 ASM
   mov ah,02h
   mov dl,x
   mov dh,y
   mov bh,0
   int 10h
 End;

 Procedure putchar; Assembler;
 Asm
   mov dl,x   { Coluna }
   mov dh,y   { Linha }
   mov bh,0   { Pagina de video (?) }
   mov ah,02h { Funcao 02h - mover cursor }
   int 10h    { A interrup‡Æo de video. }

   mov dl,c  { Coloca o ascii do caracter em dl }
   mov ah,02h { Fun‡ao 02h - imprimir caracter }
   int 21h { Interrup‡Æo de fun‡äes do DOS }
 End;
 Procedure putstr;
   var
    p: ^string;
 Begin
    p^:=s + '$';
    MoveCursor(x,y);
 Asm
   Push ds { Ds vai para pilha }
   lds dx, p { Joga o endere‡o da mem do ponteiro p para ds e o segmento para dx }
   Add dx, 1 { Strings do pascal comecam no 1 ... }
   mov ah, 09h { Funcao 09h: Imprimir string }
   int 21h  { Interrup‡Æo 21 }
   Pop ds   { Puxa ds da pilha }
 End;
 end;

 Procedure Writec;
  var
   x: integer;
  Begin
   x:=Lo(WindMax)-Lo(WindMin); { x = Largura da tela (ou da janela, se for o caso) }
   x:=(x-length(texto)) div 2; { Diferen‡a entre x e tamanho do texto sobre 2 }
   if x < 1 then x:=1; { NÆo pode ser menor que 1 }
   gotoxy(x,y);
   Write(texto);
  End;
 Procedure Writed;
  var
   x: integer;
  Begin
   x:=Lo(WindMax)-Lo(WindMin); { x = Largura da tela (ou da janela, se for o caso) }
   x:=(x-length(texto)); { Diferen‡a entre x e tamanho do texto sobre 2 }
   if x < 1 then x:=1; { NÆo pode ser menor que 1 }
   gotoxy(x,y);
   Write(texto);
  End;

 Procedure Outtextxyc;
  var
   x: integer;
  Begin
   x:=(GetMaxX-TextWidth(texto)) div 2; { Idem acima, mas com as fun‡äes do modo grafico }
   if x <= 0 then x:=1;
   Outtextxy(x,y,texto);
  End;

 Procedure Outtextxyd;
  var
   x: integer;
  Begin
   x:=(GetMaxX-TextWidth(texto)); { Idem acima, mas com as fun‡äes do modo grafico }
   if x <= 0 then x:=1;
   Outtextxy(x,y,texto);
  End;
 Procedure Trocari;
  var
   aux:integer;
  Begin
   aux:=x; { Maneira basica de trocar variaveis... Dispensa comentarios }
   x:=y;
   y:=aux;
  end;
 Procedure Trocars;
  var
   aux:string;
  Begin
   aux:=x;
   x:=y;
   y:=aux;
  end;
 Procedure IniciarModoGrafico;
  var
   d,m: integer;
  begin
   Randomize; { Um randomize nunca faz mal... :P }
   d:= detect; { Detecta o driver de video mais apropriado }
   initgraph(d,m,s); { Inicia o modo grafico }
  end;
 Function IToS;
  var
   S: string;
  begin
   Str(I, S); { Converte a Integer para string }
   IToS := S;
  end;
 Function Str_;
  var
   S: string;
  begin
   Str(I, S); { Converte a Integer para string }
   Str_ := S;
  end;
 Function SToI;
  var
   I: longInt;
   code: integer;
  begin
   val(S,I,code); { Converte a string para integer }
   SToI := I;
  end;
 Function Val_;
  var
   I: longInt;
   code: integer;
  begin
   val(S,I,code); { Converte a string para integer }
   Val_ := I;
  end;

 Function UpCaseStr;
  var
   i: integer;
  Begin
    for i := 1 to Length(s) do
      s[i] := UpCase(s[i]);
    UpCaseStr := s;
  End;
 Function GraustoRad;
  Begin
   GraustoRad:= (pi*a) / 180; { Calcula o valor em radianos a partir de um valor em graus }
  End;
 Function RadtoGraus;
  Begin
   RadtoGraus:= Round((180*a)/(pi)); { Calcula o valor em graus a partir de um valor em radianos }
  End;


 Procedure limpakey;
   var k : char;    {Tecla pressionada (k = Key)}
  begin
    while keypressed do k:=readkey;
  end;

 Procedure Sleep;
   Const
     Viradia : longint = 24 * 360000;
   var
     Hour,Minute,Second,Sec100: word;
     tempo,tempoatual : longint;
   Begin
     GetTime(Hour, Minute, Second, Sec100);
     tempo := ((Sec100) + (Second * 100) + (Minute * 6000) + (Hour * 360000)); { Tempo no inicio do Delay }
     repeat
       GetTime(Hour, Minute, Second, Sec100);
       tempoatual := (((Sec100) + (Second * 100) + (Minute * 6000) + (Hour * 360000)) - tempo + Viradia) mod ViraDia;
     until (tempoatual >= cs);
   End;

 Procedure Sleep2;
   var
     p: ^word;
   Begin
     cs:=cs*10;
     Asm
       Push ds
{       lds dx, p
       mov cx, ds}
       mov dx, cs
       Pop ds
       mov ah, 86h
       int 15h
     end;

   End;

 Procedure daumtempo;
   var i : integer; {Loop}
   begin
     i:=0;
     repeat
       delay(10);
       inc(i);
     until (keypressed) or (i>=cs);
     if resetar then limpakey;  {Apaga o buffer de teclas}
   end;



 Procedure SetText80x25;
   begin
     textmode(CO80);
   end;
 Procedure SetText80x50;
   begin
     textmode(CO80+Font8x8);
   end;


 Function FileExists;
  var
    F: file;
  begin
    {$I-}
    Assign(F, FileName);
    FileMode := 0;  { Set file access to read only }
    Reset(F);
    Close(F);
    {$I+}
    FileExists := (IOResult = 0) and (FileName <> '');
  end;  { FileExists }



  Function maior;
    begin
      if a>b then
        maior:=a
      else maior:=b;
    end;
  Function menor;
    begin
      if a<b then
        menor:=a
      else
        menor:=b;
    end;
  Function maiori;
    begin
      if a>b then
        maiori:=a
      else maiori:=b;
    end;
  Function menori(a,b:longint):longint;
    begin
      if a<b then
        menori:=a
      else menori:=b;
    end;


  Function ifint;
    begin
      if expressao then
        ifint:=v
      else ifint:=0;
    end;
  Function ifreal;
    begin
      if expressao then
        ifreal:=v
      else ifreal:=0;
    end;
  Function ifstr;
    begin
      if expressao then
        ifstr:=v
      else ifstr:='';
    end;
  Function ifinte;
    begin
      if expressao then
        ifinte:=v
      else ifinte:=f;
    end;
  Function ifreale;
    begin
      if expressao then
        ifreale:=v
      else ifreale:=f;
    end;
  Function ifstre;
    begin
      if expressao then
        ifstre:=v
      else ifstre:=f;
    end;



  Procedure trocachar;
    var
      temp:char;
    begin
      temp:=a;
      a:=b;
      b:=temp;
    end;
  Procedure trocaint;
    var
      temp:integer;
    begin
      temp:=a; a:=b; b:=temp;
    end;
  Procedure trocalint;
    var
      temp:longint;
    begin
      temp:=a; a:=b; b:=temp;
    end;
  Procedure trocareal;
    var
      temp:real;
    begin
      temp:=a; a:=b; b:=temp;
    end;

  Procedure Writexy;
    begin
      gotoxy(x,y);
      write(s);
    end;

  Function  strp;
    begin
      while length(s)<tam do
        s:=c+s;
      strp:=s;
    end;
  Function  stre;
    var
      pascalepodre : string;
    begin
      str(num,pascalepodre);
      while length(pascalepodre)<tam do
        pascalepodre:=' '+pascalepodre;
      stre:=pascalepodre;
    end;
  Function  poe0;
    var
      pascalepodre : string;
    begin
      str(num,pascalepodre);
      while length(pascalepodre)<tam do
        pascalepodre:='0'+pascalepodre;
      poe0:=pascalepodre;
    end;
  Procedure ClearArea;
    var x,y:byte;
    begin
      for y:=menori(y1,y2) to maiori(y1,y2) do
        for x:=menori(x1,x2) to maiori(x1,x2) do
          putchar(x,y,c);
    end;
  Procedure LimpaArea;
    var x,y:byte;
    begin
      for y:=menori(y1,y2) to maiori(y1,y2) do
        for x:=menori(x1,x2) to maiori(x1,x2) do
          putchar(x,y,' ');
    end;



End.