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.
