Miny z Windows v grafike

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategórie: KMP (Programy mladých programátorů)
mines2.pngAutor: Soul-Draco
web: www.soul-draco.tk

Program: Mines2.pas,  Mouse.pas
Soubor exe: Mines2.exe
Potřebné: Egavga.bgi

Toto sú presne tie isté miny ktoré poznáte z OS Windows. Naprogramované v grafike tak aby sa verne podobali tým vo Windows. Máte za úlohu označiť políčka s mínami. Jediným pomocníkom je že na odkrytom políčku sa zobrazuje počet mín okolo. 
{ MOUSE.PAS                                Copyright (c) Soul-Draco }
{                                                                   }
{ Rutiny pre pracu s mysou pre mines2.pas                           }
{                                                                   }
{ Datum:16.05.1994                             http://www.trsek.com }
 
Unit Mouse;
Interface
Uses DOS;
Type StatusTyp=(zapnuto,vypnuto);
     MouseCursor=record
      RetBodx,RetBody:integer;
      MouseBitMap:array[0..31] of word;
     end;
 
Const krizek:Mousecursor=(
		retbodx:8;
		retbody:7;
		MouseBitMap:(
			$fe3f,$fe3f,$fe3f,$fe3f,$fe3f,$fe3f,$8000,$8080,
			$8000,$fe3f,$fe3f,$fe3f,$fe3f,$fe3f,$fe3f,$ffff,
			$0000,$0080,$0080,$0080,$0080,$0080,$0080,$3f7e,
  			$0080,$0080,$0080,$0080,$0080,$0080,$0000,$0000));
 
Var mousereg:registers;
    textmys:Mousecursor;
 
Function ExistMouseDriver:boolean;
Function MouseOn:boolean;
Procedure Mousexy(var x,y,tlacitko:integer);
Function MouseBut(tlacitko:integer):boolean;
Function MouseX:word;
Function MouseY:word;
Function MouseK:byte;
Procedure SetMouseCursor(status:StatusTyp);
Procedure SetMouseImage(kurzor:MouseCursor);
Procedure LimitMouseX(LeftX,RightX:integer);
Procedure LimitMouseY(TopY,BottomY:integer);
 
 
 
Implementation
var radka:integer;
 
 
 
Function ExistMouseDriver:boolean;
const intreg=207;
var offsetmysi:integer absolute 0:204;
    segmentmysi:integer absolute 0:206;
begin;
  if (segmentmysi<>0) 
  and (offsetmysi<>0) 
  and (mem[segmentmysi:offsetmysi]<>intreg) then
    existmousedriver:=true
  else
    existmousedriver:=false;
end;
 
 
 
Function MouseOn:boolean;
begin;
{ CursorOn:=false;}
 if ExistMouseDriver then 
 begin
   mousereg.ax:=0;
   intr($33,mousereg);
{  MouseOn:=(mousereg.ax=65535);}
   MouseOn:=((mousereg.ax and 65535)=65535);
 end 
 else 
   MouseOn:=false;
end;
 
 
 
Procedure Mousexy(var x,y,tlacitko:integer);
begin;
 mousereg.ax:=3;
 intr($33,mousereg);
 tlacitko:=mousereg.bx;
 x:=mousereg.cx;
 y:=mousereg.dx;
end;
 
 
 
Function MouseBut(tlacitko:integer):boolean;
begin;
 mousereg.ax:=3;
 intr($33,mousereg);
 MouseBut:=(mousereg.bx and tlacitko)<>0;
end;
 
 
 
Function MouseX:word;
begin;
 mousereg.ax:=3;
 intr($33,mousereg);
 Mousex:=mousereg.cx;
end;
 
 
 
Function MouseY:word;
begin;
 mousereg.ax:=3;
 intr($33,mousereg);
 Mousey:=mousereg.dx;
end;
 
 
 
Function MouseK:byte;
begin;
 mousereg.ax:=3;
 intr($33,mousereg);
 Mousek:=mousereg.bx;
end;
 
 
 
Procedure SetMouseCursor(status:StatusTyp);
begin;
 if status=zapnuto then 
 begin
   mousereg.ax:=1;
{  viditelnostkurzoru:=true;}
 end 
 else begin
   mousereg.ax:=2;
{  viditelnostkurzoru:=false;}
 end;
 intr($33,mousereg);
end;
 
 
 
Procedure SetMouseImage(kurzor:MouseCursor);
begin;
 mousereg.ax:=9;
 mousereg.bx:=kurzor.RetBodx;
 mousereg.cx:=kurzor.RetBody;
 mousereg.dx:=ofs(kurzor.MouseBitMap[0]);
 mousereg.es:=seg(kurzor.MouseBitMap[0]);
 intr($33,mousereg);
end;
 
 
 
Procedure LimitMouseX(LeftX,RightX:integer);
begin;
 MouseReg.ax:=$07;
 MouseReg.cx:=LeftX;
 MouseReg.dx:=RightX;
 Intr($33,MouseReg);
end;
 
 
 
Procedure LimitMouseY(TopY,BottomY:integer);
begin;
 MouseReg.ax:=$08;
 MouseReg.cx:=TopY;
 MouseReg.dx:=BottomY;
 Intr($33,MouseReg);
end;
 
 
 
begin
 textmys.retbodx:=0;
 textmys.retbody:=15;
 for radka:=0 to 31 do 
    textmys.mousebitmap[radka]:=$0000;
end.