PC-X 1998 July/pcx23_9807.iso/PC-XUSER/PC-XUSER.16/XVISION/XV2APP.PAS

Pascal/Delphi Source File | 1998-04-05 | 11.3 KB | 436 lines

Unit XV2APP;

INTERFACE

Uses Crt, Graph; {  Egyelôre még mindig Graph  unittal megy az XVision de  }
                 {  nemsokára kicserélôdik a grafikus rész egy normálisra  }

Const
  EvNothing    = 1;
  EvMouseMove  = 2;
  EvMouseDown  = 4;
  EvMouseUp    = 8;
  EvKeyDown    = 16;
  EvMessage    = 32;
  EvCommand    = 64;

Type
  TEvent = record
    What: Word;
    case Word of
      EvNothing: ();
      EvCommand: (
        Command: Word);
      EvMouseUp, EvMouseDown, EvMouseMove: (
        Buttons: Byte;
        WhereX : Integer;
        WhereY : Integer);
      EvKeyDown: (
        Shift  : Byte;
        case Integer of
          0: (KeyCode: Word);
          1: (CharCode: Char;
              ScanCode: Byte));
      EvMessage: (
        InfoPtr: Pointer);
  end;
  PView=^TView;          { Ez lesz az alapobjetkum, amelyikbôl mindegyik   }
  TView=Object           { másik objektum is származik                     }
    Prev, Next: PView;   { Az elôzô és a következô objektum                }
    Owner: PView;        { Az objektum tulajdonosa                         }
    Child, LChild: PView;{ A fa egyel lejjebbi szintje                     }
    Options: Word;       { Az objektum általános beállításai               }
    X, Y, W, H: Integer; { A képernyôelem mérete és relatív pozíciója      }
    EventMask: Word;     { Azoknak az eseményeknek a listája, melyeket kér }
                         { a képenyôelem                                   }
    TabNum: Integer;     { A tabulátorszám                                 }
    Constructor Init(ax, ay, aw, ah: Integer);
                                       { Az alapobjektum Init konstruktora }
    Procedure Insert(P: PView); Virtual;
                       { Ezzel lehet objektumot beilleszteni az objektumra }
    Procedure HandleEvent(var Event: TEvent); Virtual;
                             { Ez hívódik meg, ha az objektum eseménzt kap }
    Procedure Draw; Virtual;                { Az objektum rajzoló metódusa }
    Procedure DrawIt; Virtual;              { Az objektum rajzoló metódusa }
    Procedure DrawView; Virtual;
                          { Az objektumot és minden "gyermekét" kirajzolja }
    Procedure GetVideoArea(var xx,yy: Integer);
                          { Az objektum abszolut koordinátáival tér vissza }
  End;
  PApplication=^TApplication;
  TApplication=Object(TView) { Ez lesz az alapobjektum, ez fogja "mozgatni"}
                             { a rendszert                                 }
    Constructor Init;
    Procedure SetGraphMode; Virtual; { A grafikus módba kapcsoló rutin     }
    Procedure Draw; Virtual;                { Az objektum rajzoló metódusa }
    Procedure Run; Virtual;                       { Ez indítja a rendszert }
    Procedure Execute(Def: PView); Virtual;      { Ez várja az eseményeket }
  End;

Function HiMouseX: Word;      { Egér X koordinátájának lekérdezése         }
Function HiMouseY: Word;      { Egér Y koordinátájának lekérdezése         }
Function buttons: Byte;       { Lekérdezi az egérgombok állapotát          }
procedure mouse_show;         { Egér megjelenítése                         }
procedure mouse_hide;         { Egér elrejtése                             }
Function  IsInArea(X,Y,XX,YY,WW,HH: Integer): Boolean;
{ Megadja, hogy X és Y az XX,YY,WW,HH által meghatározott téglalapban van-e}
Procedure SetFocus(P: PView); { 'P' fókuszálttá tétele                     }

Var
  Application: PView;         { A fában legfelsô objektum címe             }
  Exiting: Boolean;           { Ha igaz, akkor végetér a program           }

IMPLEMENTATION

Var                                      { Belsô globális változók         }
  MouseInstalled: Boolean;    { Ha az értéke igaz akkor van egér           }
  MouseShown: Boolean;   { Ha az értéke igaz akkor látható az egér         }
  OldX,OldY: Integer;    { Az egér régi pozícióját tartalmazó változók     }
  OldButtons: Byte;

(******************************************************************)
(*  Alapvetô egérkezelô rutinok                                   *)
(******************************************************************)

Function HiMouseX: Word;      { Egér X koordinátájának lekérdezése }
Var
  resl: Word;
Begin
  Asm
    cmp MouseInstalled,0
    je @@nomouse
    mov ax,03h
    int 33h
    mov ResL, CX
    jmp @@exit
  @@nomouse:
    MOV ResL, 0
  @@exit:
  End;
  HiMouseX:=ResL;
End;

Function HiMouseY: Word;      { Egér X koordinátájának lekérdezése }
Var
  resl: Word;
Begin
  Asm
    cmp MouseInstalled,0
    je @@nomouse
    mov ax,03h
    int 33h
    mov ResL, DX
    jmp @@exit
  @@nomouse:
    MOV ResL, 0
  @@exit:
  End;
  HiMouseY:=ResL;
End;

Function buttons: Byte; Assembler;       { Lekérdezi az egérgombok }
Asm                                                    { állapotát }
  cmp MouseInstalled,0
  je @@nomouse
  mov bx, 0
  mov ax,03h
  int 33h
  mov ax,bx
  jmp @@exit
@@nomouse:
  MOV ax,0
@@exit:
End;

procedure mouse_show; assembler;              { Egér megjelenítése }
 asm
 cmp mouseshown,1 ; je @@exit
 cmp mouseinstalled,1 ; jne @@exit
 mov ax,01h
 int 33h
 mov mouseshown,1
@@exit:
 end;

procedure mouse_hide;assembler;                 { Egér eltⁿntetése }
 asm
 cmp mouseshown,1 ; jne @@exit
 cmp mouseinstalled,1 ; jne @@exit;
 mov ax,02h
 int 33h
 mov mouseshown,0
@@exit:
end;

Function IsInArea(X,Y,XX,YY,WW,HH: Integer): Boolean;
Begin
  IsInArea:=False;
  if (((X>=XX) and (X<=XX+WW)) and
      ((Y>=YY) and (Y<=YY+HH))) then IsInArea:=True;
End;

{-------------------------------------------------------------------------}
{  Åltalános célú rutinok                                                 }
{-------------------------------------------------------------------------}
Procedure SetFocus(P: PView);
Begin
  While ((P<>Application) and (P<>Nil)) do
  Begin
    if ((P^.TabNum<>-1) and (P^.Prev<>Nil)) then
    Begin
      if P^.Next<>Nil then P^.Next^.Prev:=P^.Prev Else P^.Owner^.LChild:=P^.Owner^.LChild^.Prev;
      if P^.Prev<>Nil then P^.Prev^.Next:=P^.Next Else P^.Owner^.Child:=P^.Owner^.Child^.Next;
      P^.Next:=P^.Owner^.Child;
      P^.Prev:=Nil;
      P^.Owner^.Child^.Prev:=P;
      P^.Owner^.Child:=P;
      P^.DrawView;
    End;
    P:=P^.Owner;
  End;
End;

Procedure GetEvent(Var E: TEvent);       { Az eseményfigyelô rutin }
 Function Shiftpress:Byte; Assembler;{ 1: RShift  2:LShift  3:Both }
 Asm
   XOR  AX, AX
   MOV  AH, 02h
   INT  16h
   AND  AX, 3
 End;
Var
  EX,EY: Word;
  b1: byte;
  ch: Char;
  cb: Byte;
Begin
  E.What:=EvNothing;
  if Keypressed then
  Begin
    E.What:=EvKeyDown;
    E.Shift:=ShiftPress;
    ch:=Readkey;
    if ch=#0 then E.KeyCode:=Ord(Readkey)*256 else
    Begin
      E.KeyCode:=ord(ch);
      E.CharCode:=ch;
    End;
  End;
  EX:=HiMouseX;
  EY:=HiMouseY;
  E.Buttons:=Buttons;
  b1:=buttons;
  if ((OldX<>EX) or (OldY<>EY)) then
  Begin
    E.What:=EvMouseMove;
    E.WhereX:=EX;
    E.WhereY:=EY;
  End;
  if (((b1 and 1)<>0) and ((OldButtons and 1)=0)) or
     (((b1 and 2)<>0) and ((OldButtons and 2)=0)) then
  Begin
    E.What:=EvMouseDown;
    E.WhereX:=EX;
    E.WhereY:=EY;
  End;
  if (((b1 and 1)=0) and ((OldButtons and 1)<>0)) or
     (((b1 and 2)=0) and ((OldButtons and 2)<>0)) then
  Begin
    E.What:=EvMouseUp;
    E.WhereX:=EX;
    E.WhereY:=EY;
  End;
  OldX:=EX;
  OldY:=EY;
  OldButtons:=b1;
End;

{-------------------------------------------------------------------------}
{  A TView objektum                                                       }
{-------------------------------------------------------------------------}

Constructor TView.Init(ax, ay, aw, ah: Integer);
Begin
  X:=AX; Y:=AY; W:=AW; H:=AH;
  Options:=0;
  TabNum:=0;
  EventMask:=evMouseDown+evMouseUp;
  Prev:=Nil; Next:=Nil; Child:=Nil; LChild:=Nil; Owner:=Nil;
End;

Procedure TView.Insert(P: PView);
Var
  MaxNum: Integer;
  Q: PView;
Begin
  P^.Owner:=@Self;
  if Child<>Nil then    { Beillesztés a rendszerbe }
  Begin
    Child^.Prev:=P;
    P^.Next:=Child;
    Child:=P;
  End
  Else
  Begin
    Child:=P;
    LChild:=P;
  End;
  if P^.TabNum<>-1 then
  Begin
    Q:=Child;
    MaxNum:=0;
    While Q<>Nil do
    Begin
      if Q^.TabNum>MaxNum then MaxNum:=TabNum;
      Q:=Q^.Next;
    End;
    P^.TabNum:=MaxNum+1;
  End;
  P^.DrawView;
End;

Procedure TView.HandleEvent(var Event: TEvent);
Begin
End;

Procedure TView.Draw;
Begin
End;

Procedure TView.DrawIt;
Var
  P: PView;
  xx,yy: Integer;
Begin
  P:=@Self;
  While ((P<>Nil) and (P<>Application)) do
  Begin
    P:=P^.Owner;
  End;
  if P=Application then
  Begin
    Mouse_Hide;
    GetVideoArea(xx,yy);
    SetViewPort(xx,yy,xx+w,yy+h,True);
                  { Csak az objektumnak megadott területre lehet rajzolni }
    Draw;
    Mouse_Show;
  End;
End;

Procedure TView.DrawView;
Var
  P: PView;
  xx,yy: Integer;
Begin
  DrawIt;
  P:=@Self;
  P:=LChild;
  While P<>Nil do
  Begin
{   P^.DrawIt;}
    P^{.LChild^}.DrawView;
    P:=P^.Prev;
  End;
End;

Procedure TView.GetVideoArea(var xx,yy: Integer);
Var
  P: PView;
Begin
  P:=@Self;
  xx:=0;
  yy:=0;
  While P<>Nil do
  Begin
    xx:=xx+P^.X;
    yy:=yy+P^.Y;
    P:=P^.Owner;
  End;
End;

{-------------------------------------------------------------------------}
{  A TApplication                                                         }
{-------------------------------------------------------------------------}
Constructor TApplication.Init;
Begin
  MouseInstalled:=False; MouseShown:=False;
  Exiting:=False;
  Application:=@Self;
  WriteLn('XVISION2> Rendszerelemek azonosítása...');
  Asm                                         { Az egér vizsgálata }
    MOV AX, 0
    INT 33h
    CMP AX, 0 ; JE @@Exit;
    MOV BYTE(MouseInstalled), 1
  @@Exit:
  End;
  WriteLn('XVISION2> Åtkapcsolás grafikus módba...');
  SetGraphMode;
  Inherited Init(0,0,GetMaxX, GetMaxY);
  Mouse_Show;
  DrawIt;
End;

Procedure TApplication.SetGraphMode;
Var
  driver,mode: Integer;
Begin
  driver:=VGA;
  mode  :=VGAHi;
  InitGraph(driver, mode, 'D:\BP\BGI\');
End;

Procedure TApplication.Draw;
Begin
  SetFillStyle(1,7);
  Bar(0,0,w,h);
End;

Procedure TApplication.Run;
Begin
  Execute(@Self);
End;

Procedure TApplication.Execute;
Var
  E: TEvent;
  P,Q: PView;
  xx,yy: Integer;
Begin
  Repeat
    GetEvent(E);
    Case E.What of
    EvMouseMove,
    EvMouseDown,
    EvMouseUp  :Begin
                  P:=Def; Q:=Nil;
                  While (P<>Nil) do
                  Begin
                    P^.GetVideoArea(xx,yy);
                    if IsInArea(E.WhereX, E.WhereY, xx, yy, P^.W, P^.H) then
                    Begin
                      Q:=P;
                      P:=P^.Child;
                    End
                    Else
                    Begin
                      P:=P^.Next;
                    End;
                  End;
                  if Q<>Nil then
                  Begin
                    if (Q^.EventMask and E.What)<>0 then
                    Begin
                      SetFocus(Q);
                      Q^.HandleEvent(E);
                    End;
                  End;
                End;
    EvKeyDown:  Begin
                End;
    End;
  Until Exiting;
End;

End.