SoloCodigo

Unit mousegr2;

InTerface
Uses Dos,Crt,Graph;
Type Vermelho_Verde_Azul = Record Vermelho, Verde, Azul : Byte; End;
     TMenu= Record A, B : Integer;X:boolean;End;

VAR
                         Cor : Array[0..63] Of Vermelho_Verde_Azul;
                 AX,BX,CX,DX : word;
                 ExisteMouse : Boolean;
 Driver_grafico,Modo_Grafico,
                        Erro : Integer;

PROCEDURE Mouse( var Reg_AX, Reg_BX, Reg_CX, Reg_DX : word );

PROCEDURE LigaMouse;

PROCEDURE DesligaMouse;

Function  BotaoDireito:Boolean;

Function  BotaoEsquerdo:Boolean;

Function  BotaoCentral:Boolean;

Procedure Mostra_Ponteiro(Esconde : Boolean);

Procedure CursorMouse(Var X,Y:Integer);

Procedure WindowMouse(X,Y,X1,Y1:Byte);

Procedure Menu(X1,Y1,XX,YY : Integer; Texto : String; Cor, Bordas : Byte;
Var R:TMenu; A : Integer);

{Procedure Imagem_Menu(X1,Y1,X2,Y2 : Integer;  Boo : Boolean);}
Procedure Escreva(X,Y : Integer; St: String; Cor : byte);

Procedure Relogio(X,Y : Integer; Cor :Byte);

Procedure Data(X,Y : Integer; Cor : Byte; Caso : Boolean);

Procedure Tela(A : Integer);

Procedure PoeBotao(X1,Y1,XX,YY : Integer; Texto : String; Cor, Bordas : Byte);

Procedure Botao(X1,Y1,XX,YY : Integer; Texto : String; Cor, Bordas  : Byte;
Var Click : Boolean; On_Off : Integer);

Procedure Barra(X1,Y1,XX,YY : Integer; Texto : String; Cor, Bordas : Byte);

{Procedure Aviso(X, Y, X1, Y1 : Integer; Texto : String);}

Procedure Imagem(X1,Y1,X2,Y2 : Integer; Boo : Boolean);

Procedure Reg_Click(var C1, C2 : Integer);

Implementation

Var Regs : Registers;  { Registradores do MS DOS }
{Executa a Interrupcao do Mouse}
PROCEDURE Mouse( var Reg_AX, Reg_BX, Reg_CX, Reg_DX : word );
  begin
    With Regs DO
      begin
        AX := Reg_AX; BX := Reg_BX; CX := Reg_CX; DX := Reg_DX;
      end;
    intr($33,Regs);
    With Regs DO
      begin
        Reg_Ax := AX; Reg_BX := BX; Reg_CX := CX; Reg_DX := DX;
      end;
  end;

{Reseta As Variaveis da Interrupcao}
Procedure Reseta;
Begin
  AX:=0;
  BX:=0;
  CX:=0;
  DX:=0;
End;

PROCEDURE LigaMouse;
begin
    Reseta;
    AX := 1 ; Mouse( AX,BX,CX,DX )
end;

PROCEDURE DesligaMouse;
  begin
    Reseta;
    AX := 0 ; Mouse( AX,BX,CX,DX )
  end;

Procedure Mostra_Ponteiro(Esconde : Boolean);
begin
     Reseta;
     If Esconde Then Ax := 1 Else Ax := 2;
     Mouse(Ax,Bx,Cx,Dx);
End;


{*************************************}
{AS TRES FUNCOES ABAIXO, RETORNAM TRUE SE}
{ SEU RESPECTIVO BOTAO FOR PRESSIONADO}
{*************************************}
Function  BotaoEsquerdo:Boolean;
Begin
  Reseta;
  AX:=3;
  Mouse(AX,BX,CX,DX);
  BotaoEsquerdo:= BX = 1 ;

End;

Function  BotaoDireito:Boolean;
Begin
  Reseta;
  AX:=3;
  Mouse(AX,BX,CX,DX);
  BotaoDireito:= BX = 2 ;
End;

Function  BotaoCentral:Boolean;
Begin
  Reseta;
  AX:=3;
  Mouse(AX,BX,CX,DX);
  Botaocentral:= BX = 4 ;
End;

{RETORNA AS COORDENADAS DE PIXEL PARA
CARACTERES, REALIZANDO OS CALCULOS A SEGUIR}

Procedure CursorMouse(Var X,Y:Integer);
Begin
  Reseta;
  AX:=3;
  Mouse(AX,BX,CX,DX);
  X:=CX;
  Y:=DX;
End;

{DEFINE A AREA DE TRABALHO DO MOUSE, OU SEJA
UMA JANELA}

Procedure WindowMouse(X,Y,X1,Y1:Byte);
Begin
  Reseta;
  AX:=7;
  CX:=X * 8;
  DX:=X1 * 8;
  Mouse(AX,BX,CX,DX);

  Reseta;
  AX:=8;
  CX:=Y * 8;
  DX:=Y1 * 8;
  Mouse(AX,BX,CX,DX);
End;

Procedure Escreva(X,Y : Integer; St: String; Cor : byte);
Begin
  Regs.Ah:=$13;
  Regs.Al:=$01;
  Regs.Bl:=Cor;
  Regs.Bh:=$00;
  Regs.Cx:=Length(St);
  Regs.Dl:=X;
  Regs.Dh:=Y;
  Regs.Es:=Seg(St[1]);
  Regs.Bp:=Ofs(St[1]);
  Intr(16,Regs)
End;

Procedure Relogio(X,Y : Integer; Cor :Byte);
Var H,M,S,MS : Word;
          St : String[10];
Function Principal(W : Word) : String;
Begin
  Str(W : 0, St);
  If Length(St) = 1 Then St := '0' + St;
  Principal := St;
End;
Begin
  GetTime(H,M,S,MS);
  Escreva(X, Y, Principal(H) + ':' + Principal(M),Cor);
End;

Procedure Data(X,Y : Integer; Cor : Byte; Caso : Boolean);
Var
      J, M, D, W : Word;
  St,St1,St2,St3 : String[9];
Const
  Mes :array[1..12] of string[9] =('Janeiro','Fevereiro','Marco','Abril',
         'Maio','Junho','Julho','Agosto','Setembro','Outubro','Novembro',
         'Dezembro');
Begin
  Getdate(J,M,D,W);
  Case W Of
    0 : St := 'Domingo';
    1 : St := 'Segunda-Feira';
    2 : St := 'Terca-Feira';
    3 : St := 'Quarta-Feira';
    4 : St := 'Quinta-Feira';
    5 : St := 'Sexta-Feira';
    6 : St := 'Sabado';
  End;
  Str(D,St1);Str(M,St2);Str(J,St3);
  If D in[0..9] Then St1 := '0'+St1;
  If M in[0..9] Then St2 := '0'+St2;
  If Caso = True Then Escreva(X,Y,St+' '+St1+' '+Mes[M]+' '+St3,Cor)
                 Else Escreva(X,Y,St1+'/'+St2+'/'+St3[3]+St3[4],Cor);
End;

Procedure PoeBotao(X1,Y1,XX,YY : Integer; Texto : String; Cor, Bordas : Byte);

var
  Horizontal, Vertical : Real;
               P, X, Y : Integer;
Begin
  SetFillStyle(1,7);Bar(X1,Y1,XX,YY);
  SetColor(15);
  for P :=0 to Bordas do Line(X1+p,Y1+p,XX-p,Y1+p);
  for P :=0 to Bordas do Line(XX-p,Y1+p,XX-p,YY-p);
  SetColor(8);
  for P :=0 to Bordas do Line(X1+p,YY-p,XX-p,YY-p);
  for P :=0 to Bordas do Line(X1+p,Y1+p,X1+p,YY-p);
  SetTextStyle(2,0,6);
  Horizontal :=((XX-X1)/2)+X1-(Length(Texto)*10)/2;Vertical:=((YY-Y1)/2)+Y1-5;
  SetColor(1);OutTextXY(Round(Horizontal)+1,Round(Vertical)-5,Texto);
  SetColor(1);OutTextXY(Round(Horizontal)+2,Round(Vertical)-5,Texto);
end;

Procedure Botao(X1,Y1,XX,YY : Integer; Texto : String; Cor, Bordas : Byte;
Var Click : Boolean; On_Off : Integer);

var
  Horizontal, Vertical : Real;
               P, X, Y : Integer;
                     B : Boolean;

   Procedure Off;
   Var P : Integer;
   Begin
       Mostra_Ponteiro(False);
       SetFillStyle(1,7);Bar(X1,Y1,XX,YY);
       SetColor(15);
       for P :=0 to Bordas do Line(X1+p,Y1+p,XX-p,Y1+p);
       for P :=0 to Bordas do Line(XX-p,Y1+p,XX-p,YY-p);
       SetColor(8);
       for P :=0 to Bordas do Line(X1+p,YY-p,XX-p,YY-p);
       for P :=0 to Bordas do Line(X1+p,Y1+p,X1+p,YY-p);
       SetTextStyle(2,0,6);
       Horizontal :=((XX-X1)/2)+X1-(Length(Texto)*10)/2;Vertical:=((YY-Y1)/2)+Y1-5;
       SetColor(1);OutTextXY(Round(Horizontal)+1,Round(Vertical)-5,Texto);
       SetColor(1);OutTextXY(Round(Horizontal)+2,Round(Vertical)-5,Texto);
       Mostra_Ponteiro(True);
       CliCk:=False;
   End;

   Procedure On;
   Var P : Integer;
   Begin
        Mostra_Ponteiro(False);
        SetFillStyle(1,7);Bar(X1,Y1,XX,YY);
        SetColor(8);
        for P :=0 to Bordas do Line(X1+P,Y1+P,XX-P,Y1+P);
        for P :=0 to Bordas do Line(XX-P,Y1+P,XX-P,YY-P);
        SetColor(15);
        for P :=0 to Bordas do Line(X1+P,YY-P,XX-P,YY-P);
        for P :=0 to Bordas do Line(X1+P,Y1+P,X1+P,YY-P);
        SetColor(8);
        SetTextStyle(2,0,6);
        Horizontal :=((XX-X1)/2)+X1-(Length(Texto)*10)/2;
        Vertical :=((YY-Y1)/2)+Y1-4;
        OutTextXY(Round(Horizontal),Round(Vertical)-5,Texto);
        OutTextXY(Round(Horizontal)+1,Round(Vertical)-5,Texto);
        SetTextStyle(0,0,0);
        Mostra_Ponteiro(True);
        Delay(150);

        Reseta;
        AX:=3;
        Mouse(AX,BX,CX,DX);
        While BX = 1 Do Cursormouse(X,Y);
        Click := True;
   End;

Begin
  CursorMouse(X,Y);
   If ((X>X1)and(X<XX)) and ((Y>Y1)and(Y<YY)) and (Botaoesquerdo) then B:=true
                                                                  else B:=false;
   If ( And (On_Off = 1) Then On;
   If (On_Off = 2) Then Off;
End;

Procedure Reg_Click_Solto(var C1, C2 : Integer);{Armazena onde foi clicado}
Begin
     C1 := CX;
     C2 := DX;
End;

Procedure Reg_Click(var C1, C2 : Integer);{Armazena onde foi clicado}
Var X, Y, S, S1 : Integer;
Begin
     Reseta;
     AX:=3;
     Mouse(AX,BX,CX,DX);
     C1 := CX;
     C2 := DX;
     While BX = 1 Do Cursormouse(X,Y);
     Reg_CliCk_Solto(S, S1);
End;


{Ex.:   Barra(1,440,640,475,'TESTE COM BARRA DE TAREFAS',1,1);}
Procedure Barra(X1,Y1,XX,YY : Integer; Texto : String; Cor, Bordas : Byte);

var
  Horizontal, Vertical : Real;
                     P : Integer;
begin
  SetFillStyle(1,7);Bar(X1,Y1,XX,YY);
  SetColor(15);
  for P :=0 to Bordas do Line(X1+p,Y1+p,XX-p,Y1+p);
  for P :=0 to Bordas do Line(XX-p,Y1+p,XX-p,YY-p);
  SetColor(8);
  for P :=0 to Bordas do Line(X1+p,YY-p,XX-p,YY-p);
  for P :=0 to Bordas do Line(X1+p,Y1+p,X1+p,YY-p);
  SetTextStyle(2,0,6);
  Horizontal :=((XX-X1)/2)+X1-(Length(Texto)*10)/2;Vertical:=((YY-Y1)/2)+Y1-5;
  SetColor(1);OutTextXY(Round(Horizontal)+1,Round(Vertical)-5,Texto);
  SetColor(1);OutTextXY(Round(Horizontal)+2,Round(Vertical)-5,Texto);
end;

Procedure Tela(A : Integer);
Const PelAddrRgR  = $3C7;
      PelAddrRgW  = $3C8;
      PelDataReg  = $3C9;

{Type Vermelho_Verde_Azul = Record Vermelho, Verde, Azul : Byte; End;}

Var I : Integer; Ch : Char; {Cor : Array[0..63] Of Vermelho_Verde_Azul;}

    Procedure Pega_Cor(C : Byte; Var Vermelho, Verde, Azul : Byte);
      Begin
           Port[PelAddrRgR] := C;
           Vermelho := Port[PelDataReg];
              Verde := Port[PelDataReg];
               Azul := Port[PelDataReg];
      End;

      Procedure Seleciona_Cor(C, Vermelho, Verde, Azul : Byte);
        Begin
             Port[PelAddrRgW] := C;
             Port[PelDataReg] := Vermelho;
             Port[PelDataReg] := Verde;
             Port[PelDataReg] := Azul;
        End;

        Procedure Seleciona_Intensidade(B : Byte);
         Var                        I : Integer;
             Fvermelho, Fverde, Fazul : Byte;
           Begin
                For I := 0 To 63 Do
                    Begin
                         Fvermelho := Cor . Vermelho * B DIV 63;
                         Fverde := Cor . Verde * B DIV 63;
                         Fazul := Cor . Azul * B DIV 63;
                         Seleciona_Cor(I, Fvermelho, Fverde, Fazul);
                    End;
           End;

Begin
   If A = 0 Then
               Begin
   For I := 0 To 63 Do Pega_Cor(I, Cor.Vermelho, Cor.Verde, Cor.Azul);
   For I := 63 DownTo 0 Do Begin Seleciona_Intensidade(I); Delay(20); End;
               End;
   If A = 1 Then
                Begin
   For I := 0 To 63 Do Begin Seleciona_Intensidade(I); Delay(20); End;
                End;
End;

Procedure Menu(X1,Y1,XX,YY : Integer; Texto : String;Cor , Bordas : Byte;
Var R : TMenu; A : Integer);

var
     Horizontal, Vertical : Real;
          C1, C2, P, X, Y : Integer;
                        B : Boolean;
  Procedure Destaca;
  var p : integer;
  Begin
    R.X := True;
     C2 := 0; Inc(C1); If C1=1 Then
   begin
    Mostra_Ponteiro(False);
    SetFillStyle(1,1);Bar(X1,Y1,XX,YY);
    SetColor(0);
    for P :=0 to Bordas do Line(X1+P,Y1+P,XX-P,Y1+P);
    for P :=0 to Bordas do Line(XX-P,Y1+P,XX-P,YY-P);
    SetColor(0);
    for P :=0 to Bordas do Line(X1+P,YY-P,XX-P,YY-P);
    for P :=0 to Bordas do Line(X1+P,Y1+P,X1+P,YY-P);
    SetColor(15);
    SetTextStyle(2,0,6);
    Horizontal :=((XX-X1)/2)+X1-(Length(Texto)*10)/2;
    Vertical :=((YY-Y1)/2)+Y1-4;
    OutTextXY(Round(Horizontal),Round(Vertical)-5,Texto);
    OutTextXY(Round(Horizontal)+1,Round(Vertical)-5,Texto);
    SetTextStyle(0,0,0);
    CursorMouse(X,Y);
    Mostra_Ponteiro(True);
   end;
end;

Procedure Normal;
Var p : Integer;
Begin
  C1 := 0; Inc(C2);
  If C2=1 Then
  Begin
    Mostra_Ponteiro(False);
    SetFillStyle(1,15);Bar(X1,Y1,XX,YY);
    SetColor(8);
    For P :=0 To Bordas Do Line(X1+p,Y1+p,XX-p,Y1+p);
    For P :=0 To Bordas Do Line(XX-p,Y1+p,XX-p,YY-p);
    SetColor(8);
    For P :=0 To Bordas Do Line(X1+p,YY-p,XX-p,YY-p);
    For P :=0 To Bordas Do Line(X1+p,Y1+p,X1+p,YY-p);
    SetTextStyle(2,0,6);
    Horizontal :=((XX-X1)/2)+X1-(Length(Texto)*10)/2;
    Vertical:=((YY-Y1)/2)+Y1-5;
    SetColor(1);OutTextXY(Round(Horizontal)+1,Round(Vertical)-5,Texto);
    SetColor(1);OutTextXY(Round(Horizontal)+2,Round(Vertical)-5,Texto);
    Mostra_Ponteiro(True);
    R.X := False;
  End;
End;
Begin
  CursorMouse(R.A,R.;
  If (A = 1) Then Begin C2 := 0; Normal; End;
   If ((R.A>X1)and(R.A<XX)) and ((R.B>Y1)and(R.B<YY)) then
      B := True else B := False;
   If ( Then Destaca Else If (R.X) Then Normal
End;

Procedure Imagem(X1,Y1,X2,Y2 : Integer; Boo : Boolean);
Var   S1 : Word;
   PMenu : Pointer;
Begin
     If Boo Then Begin
                    S1 := ImageSize(X1,Y1,X2,Y2);
                    Getmem(PMenu,s1);
                    GetImage(X1,Y1,X2,Y2,PMenu^);
                 End;
     If Not Boo Then Begin
                             Mostra_Ponteiro(False);
                             PutImage(X1,Y1,PMenu^,0);
                             Freemem(PMenu,S1);
                             Mostra_Ponteiro(True);
                          End;
End;

{Procedure Aviso(X, Y, X1, Y1 : Integer; Texto : String);
Var I : Integer;
    T : Word;
  OKA : Boolean;
    P : Pointer;
begin
       Mostra_Ponteiro(False);
       T := ImageSize(X,Y,X1,Y1);
       Getmem(P,T);
       GetImage(X,Y,X1,Y1,P^);
     SetFillStyle(1,7);
     Bar(X,Y,X1,Y1);
     SetFillStyle(1,1);
     Bar(X,Y,X1,Y+20);
     SetColor(15);
     SetTextStyle(DefaultFont, HorizDir,1);
     Rectangle(X,Y,X1,Y1);
     I := (((X1-X)-(Length(Texto)*8)) Div 2);
     OutTextXY(I + X,Y+7,Texto);
     I := (((X1-X)-(40)) Div 2);
     PoeBotao(X + I, Y1-35, X + I + 40, Y1-10, 'OK',0,0);
     Mostra_Ponteiro(True);
     OKA := False;
     repeat
       Botao(X + I,Y1-35,X + I + 40,Y1-10,'OK',0,0,OKA,1);
     until (OKA);
      If OKA Then Begin
                      Mostra_Ponteiro(False);
                      PutImage(X,Y,P^,0);
                      Freemem(P,T);
                      Mostra_Ponteiro(True);
                      Exit;
                  End;
End;}

Begin
  Detectgraph(Driver_Grafico,Modo_Grafico);
  Initgraph(Driver_Grafico,Modo_Grafico,'tpbgi');
  Erro:=Graphresult;
  If Erro<>Grok Then
   Begin
     Write(Grapherrormsg(erro));
     Halt;
   End;
End.