Power-Programmierung/CD1.mdf/pascal/library/dos/mouse/mouse0/macu.pas

Pascal/Delphi Source File | 1994-04-30 | 18.4 KB | 736 lines

unit macu;
Interface
Uses Graph,mousu;
type
    subtype = Array [1..10,1..10] of Record
              Title:string;
              end;

    gwindowtype = Array [1..100] of Record
                 Xspot,
                 Yspot,
                 Xend,
                 Yend,kind:Integer;
                 Title:string;
                 end;

    Menutype = Array [1..10] of Record
               Title:String;
               Legth:integer;
               end;

    ordertype = array [1..100] of integer;

Var
   gray50:fillpatterntype;

   gwindow:gwindowtype;

   Menu:Menutype;

   submenu:subtype;

   order:ordertype;

   Number,XX,
   Legth,YY,
   X,Y,kind,xx2,
   amountofmenus,
   amountofwindows,
   color,
   zz,
   topx,topy,
   botx,boty,
   omousex,
   omousey,
   mmousex,
   mmousey,
   movex,
   movey,lcv,lcv2,
   current:integer;

   Title:string;

   Resized,
   Moved:boolean;

Procedure StartUpScreen;

Procedure SetUpMouseToCurrentWindow;

Procedure MakeMenu(Number:integer;Title:string);

Procedure MakeSubMenu(number,x:integer;title:string);

Procedure CheckMenu(number:integer;var chosen:integer);

Procedure ShowIcon(X,Y,number:Integer);

Procedure SpecialIcon(Xx,Yy:integer;title:string);

Function CurrentDrawingWindow:integer;

Procedure SetCurrentDrawingWindow(number:integer);

Function GetMaxWindowX:Integer;

Function GetMaxWindowY:Integer;

Function GetMinWindowX:Integer;

Function GetMinWindowY:Integer;

Function FreeWindow:Integer;

Procedure ShowAllWindows;

Procedure CloseWindow(number:integer);

Procedure MakeWindow(number,X,Y,xx,yy:integer;title:string;kind:integer);

Procedure MoveWindow(number,X,Y,xx,yy:integer);

Procedure ShowWindow(number:integer);

Procedure Checkwindow(number:integer);

Procedure CheckAllWindows;

Implementation


Procedure StartUpScreen;
Begin
     hidemousecursor;
     setviewport(0,0,getmaxx,getmaxy,clipoff);
     Setfillpattern(gray50,color);
     Bar(0,10,GetMaxX,GetMaxY);
     SetFillstyle(1,15);
     Bar(0,0,GetMaxX,9);
     SetTextStyle(smallfont,horizdir,4);
     setcolor(0);
     XX:=0;
     for lcv:=1 to amountofmenus do
     begin
          outtextxy(xx,-1,menu[lcv].title);
          xx:=xx+menu[lcv].Legth;
     end;
     showmousecursor;
end;


Procedure SetUpMouseToCurrentWindow;
var
   viewport:viewporttype;
begin
     getbuttonstatus;
     getviewsettings(viewport);
     with viewport do
     begin
          mousex:=mousex-x1;
          mousey:=mousey-y1;
     end;
end;


Procedure Puttop(number:integer);
var
   noo:integer;
begin
     noo:=amountofwindows;
     For lcv:=1 to amountofwindows do
          if order[lcv]=number then noo:=lcv;
     for lcv:=noo downto 1 do
          order[lcv]:=order[lcv-1];
     order[1]:=number;
end;


Procedure getridof(number:integer);
var
   noo:integer;
begin
     For lcv:=1 to amountofwindows do
          if order[lcv]=number then noo:=lcv;
     for lcv:=noo to amountofwindows do
     begin
          order[lcv]:=order[lcv+1];
     end;
     amountofwindows:=amountofwindows-1;
end;


Procedure ShowIcon(X,Y,number:Integer);
begin
     if number=1 then
     begin
          rectangle(x,y,x+32,y+32);
          line(x+27,y,x,y+27);
     end;
     if number=2 then
     begin
          outtextxy(x+5,y+5,'DATA');
     end;
end;


Procedure SpecialIcon(Xx,Yy:integer;title:string);
var
   co,txt3:integer;
   txt2:char;

begin
     assign(input,title);
     reset(input);
     for y:=1 to 32 do
     begin
          for x:=1 to 32 do
          begin
               read(input,txt2);
               co:=0;
               val(txt2,co,txt3);
               if txt3=1 then
               begin
                    if txt2='A' then co:=10;
                    if txt2='B' then co:=11;
                    if txt2='C' then co:=12;
                    if txt2='D' then co:=13;
                    if txt2='E' then co:=14;
                    if txt2='F' then co:=15;
               end;
               putpixel(x+xx,y+yy,co);
          end;
          readln(input,txt2);
     end;
     close(input);
end;


Function CurrentDrawingWindow:integer;
begin
     currentdrawingwindow:=current;
end;



Procedure SetCurrentDrawingWindow(number:integer);
Begin
     current:=number;
     kind:=gwindow[number].kind;
     if (kind=1) or (kind=2) or (kind=3) then
     begin
     setviewport( gwindow[number].xspot+10,gwindow[number].yspot+10,
                  gwindow[number].xend+10,gwindow[number].yend+10,clipon);
     end;
     if kind=5 then
     begin
     setviewport( gwindow[number].xspot,gwindow[number].yspot+10,
                  gwindow[number].xend,gwindow[number].yend,clipon);
     end;
     if kind=4 then
     begin
     setviewport( gwindow[number].xspot,gwindow[number].yspot,
                  gwindow[number].xend,gwindow[number].yend,clipon);
     end;
end;


Function GetMaxWindowX:Integer;
Var
   viewport:viewporttype;

Begin
     getviewsettings(viewport);
     with viewport do
     begin
          getmaxwindowx:=x2;
     end;
end;


Function GetMaxWindowY:Integer;
Var
   viewport:viewporttype;

Begin
     getviewsettings(viewport);
     with viewport do
     begin
          getmaxwindowy:=y2;
     end;
end;

Function GetMinWindowX:Integer;
Var
   viewport:viewporttype;

Begin
     getviewsettings(viewport);
     with viewport do
     begin
          getminwindowx:=x1;
     end;
end;


Function GetMinWindowY:Integer;
Var
   viewport:viewporttype;

Begin
     getviewsettings(viewport);
     with viewport do
     begin
          getminwindowy:=y1;
     end;
end;


Function FreeWindow:integer;
begin
     for lcv:=1 to 100 do
     begin
          if gwindow[lcv].title='' then
          begin
               freewindow:=lcv;
               exit;
          end;
     end;
end;


Procedure ShowWindow(number:integer);
var
   mx,lcv,ln:integer;
begin
     ln:=-1;
     setviewport(0,0,getmaxx,getmaxy,clipoff);
     x:=gwindow[number].xspot;
     y:=gwindow[number].yspot;
     xx:=gwindow[number].xend;
     yy:=gwindow[number].yend;
     kind:=gwindow[number].kind;
     setfillstyle(1,15);
     bar(x,y,xx,yy);
     setcolor(0);
     rectangle(x,y,xx,yy);
     if (kind<>4) and (kind<>5) then rectangle(x+10,y+10,xx-10,yy-10);
     if (kind=1) or (kind=2) then rectangle(x+2,y+2,x+8,y+8);
     if (kind=1) or (kind=3) then rectangle(xx-2,yy-2,xx-8,yy-8);
     if (kind=5) then line(x,y+10,xx,y+10);
     if kind<>4 then
     begin
     repeat
           ln:=ln+1;
           mx:=gwindow[number].xend-gwindow[number].xspot;
           mx:=mx div 2;
           mx:=mx-((length(gwindow[number].title)-ln)*6);
           mx:=mx+gwindow[number].xspot;
     until mx>gwindow[number].xspot+10;
     moveto(mx,gwindow[number].yspot-1);
     for lcv:=1 to length(gwindow[number].title)-ln do
     begin
          outtext(gwindow[number].title[lcv]);
     end;
     setviewport(x,y,xx,yy,clipon);
     if (order[1]=number) and (gwindow[number].title<>'') then
     begin
          for lcv:=1 to 4 do
          begin
               if (kind=1) or (kind=2) then line(10,lcv*2,mx-2-topx,lcv*2);
               if (kind=3) or (kind=5) then line(0,lcv*2,mx-2-topx,lcv*2);
               line((mx+((length(gwindow[number].title)-ln)*6))-topx,lcv*2,botx-topx,lcv*2);
          end;
     end;
     end;
     if (kind<>4) or (kind<>5) then setviewport(x+10,y+10,xx-10,yy-10,clipon);
     if kind=5 then setviewport(x,y+10,xx,yy,clipon);
     if kind=4 then setviewport(x,y,xx,yy,clipon);
end;


Procedure ShowAllWindows;
begin
     hidemousecursor;
     For lcv:=amountofwindows downto 1 do
     begin
          if gwindow[order[lcv]].title<>'' then showwindow(order[lcv]);
     end;
     showmousecursor;
end;


procedure CloseWindow(number:integer);
begin
     hidemousecursor;
     setfillpattern(gray50,color);
     bar(topx,topy,botx,boty);
     showmousecursor;
     gwindow[number].xspot:=getmaxx+1;
     gwindow[number].yspot:=getmaxy+1;
     gwindow[number].xend:=getmaxx+1;
     gwindow[number].yend:=getmaxy+1;
     gwindow[number].title:='';
     getridof(number);
end;


Procedure MakeWindow(number,X,Y,XX,YY:integer;title:string;kind:integer);
Begin
     amountofwindows:=amountofwindows+1;
     puttop(number);
     gwindow[number].xspot:=x;
     gwindow[number].yspot:=y;
     gwindow[number].xend:=XX;
     gwindow[number].yend:=yy;
     gwindow[number].title:=title;
     gwindow[number].kind:=kind;
end;


Procedure MoveWindow(number,X,Y,xx,yy:integer);
begin
     puttop(number);
     gwindow[number].xspot:=x;
     gwindow[number].yspot:=y;
     gwindow[number].xend:=XX;
     gwindow[number].yend:=yy;
end;


Procedure MoveNew;
var
   omx,mx,
   omy,my:integer;
Begin
     setviewport(0,0,getmaxx,getmaxy,clipoff);
     setwritemode(1);
     setcolor(15);
     mx:=mousex+movex;
     my:=mousey+movey;
     omx:=mx;
     omy:=my;
     repeat
           if (omx<>mx) or (omy<>my) then
           begin
           if mx<1 then
           begin
                mx:=omx;
                hidemousecursor;
                SetMouseCursorPos(omx-movex,mousey);
                showmousecursor;
           end;
           if my<11 then
           begin
                my:=omy;
                hidemousecursor;
                SetMouseCursorPos(mousex,omy-movey);
                showmousecursor;
           end;

           hidemousecursor;
           rectangle(OMx,OMy,Omx+(botx-topx),Omy+(boty-topy));
           rectangle(Mx,My,mx+(botx-topx),my+(boty-topy));
           showmousecursor;
           end;
           omx:=mx;
           omy:=my;
           getbuttonstatus;
           mx:=mousex+movex;
           my:=mousey+movey;
     until mkey<>left;
     hidemousecursor;
     rectangle(OMx,OMy,Omx+(botx-topx),Omy+(boty-topy));
     showmousecursor;
     setwritemode(0);
     moved:=true;
end;


Procedure changebox;
var
   omx,mx,
   omy,my:integer;
Begin
     setviewport(0,0,getmaxx,getmaxy,clipoff);
     setwritemode(1);
     setcolor(15);
     mx:=mousex+movex;
     my:=mousey+movey;
     omx:=mx;
     omy:=my;
     repeat
           if (omx<>mx) or (omy<>my) then
           begin
                hidemousecursor;
                rectangle(topx,topy,mx+(botx-topx),my+(boty-topy));
                rectangle(topx,topy,Omx+(botx-topx),Omy+(boty-topy));
                showmousecursor;
           end;
           omx:=mx;
           omy:=my;
           getbuttonstatus;
           mx:=mousex+movex;
           my:=mousey+movey;
     until mkey<>left;
     hidemousecursor;
     rectangle(topx,topy,Omx+(botx-topx),Omy+(boty-topy));
     showmousecursor;
     setwritemode(0);
     resized:=true;
end;


Procedure Checkwindow(number:integer);
begin
     if gwindow[number].title='' then exit;
     topx:=gwindow[number].xspot;
     topy:=gwindow[number].yspot;
     botx:=gwindow[number].xend;
     boty:=gwindow[number].yend;
     kind:=gwindow[number].kind;
     omousex:=mousex;
     omousey:=mousey;
     if (mkey=left) and ((mousex<topx+10) or (mousex>botx-10) or
                        (mousey<topy+10) or (mousey>boty-10)) then
     begin
          if (kind<>4) and (mousex<botx) and (mousex>topx+10) then
          begin
               if (mousey>topy) and (mousey<topy+10) then
               begin
                    movex:=topx-mousex;
                    movey:=topy-mousey;
                    movenew;
                    mmousex:=mousex-omousex;
                    mmousey:=mousey-omousey;
                    hidemousecursor;
                    setfillpattern(gray50,color);
                    bar(topx,topy,botx,boty);
                    topx:=mmousex+topx;
                    topy:=mmousey+topy;
                    botx:=mmousex+botx;
                    boty:=mmousey+boty;
                    MoveWindow(number,topx,topy,botx,boty);
                    showmousecursor;
                    puttop(number);
               end;
          end;
          if ((kind=1) or (kind=3)) and (mousex<botx) and (mousex>botx-10) and (mousey<boty) and (mousey>boty-10) then
          begin
               movex:=topx-mousex;
               movey:=topy-mousey;
               setminmaxhorzcurspos(topx+40,getmaxx);
               setminmaxvertcurspos(topy+40,getmaxy);
               changebox;
               mmousex:=mousex-omousex;
               mmousey:=mousey-omousey;
               hidemousecursor;
               setfillpattern(gray50,color);
               bar(topx,topy,botx,boty);
               botx:=mmousex+botx;
               boty:=mmousey+boty;
               MoveWindow(number,topx,topy,botx,boty);
               setminmaxhorzcurspos(0,getmaxx);
               setminmaxvertcurspos(0,getmaxy);
               showmousecursor;
               puttop(number);
          end;
          if ((kind=1) or (kind=2)) and (mousex>topx) and (mousex<topx+10) and (mousey>topy) and (mousey<topy+10) then
          begin
               hidemousecursor;
               setfillpattern(gray50,color);
               bar(topx,topy,botx,boty);
               showmousecursor;
               gwindow[number].xspot:=getmaxx+1;
               gwindow[number].yspot:=getmaxy+1;
               gwindow[number].xend:=getmaxx+1;
               gwindow[number].yend:=getmaxy+1;
               gwindow[number].title:='';
               getridof(number);
          end;
     end;
end;

Procedure CheckAllWindows;
var
   no,nwindow:integer;
Begin
     moved:=false;
     resized:=false;
     if mkey=left then
     begin
          checkwindow(order[1]);
          if amountofwindows>1 then
          begin
               for nwindow:=2 to amountofwindows do
               begin
                    no:=0;
                    for lcv:=1 to nwindow-1 do
                    begin
                         if ((mousex<gwindow[order[lcv]].xspot) or (mousex>gwindow[order[lcv]].xend)) or
                            ((mousey<gwindow[order[lcv]].yspot) or (mousey>gwindow[order[lcv]].yend)) then
                            no:=no+1;
                    end;
                    if no=nwindow-1 then checkwindow(order[nwindow]);
               end;
          end;
          if (moved) or (resized) then showallwindows;
          current:=order[1];
     end;
end;


Procedure MakeMenu(Number:integer;Title:string);
Begin
     Menu[number].title:=title;
     menu[number].Legth:=length(title)*6;
     amountofmenus:=amountofmenus+1;
end;

Procedure MakeSubMenu(number,x:integer;title:string);
begin
     submenu[number,x].title:=title;
end;


Procedure CheckSubmenu(number,zz:integer;var chosen:integer);
var
   yy:integer;
begin
     if mkey=right then
     begin
          yy:=0;
          for lcv:=1 to zz do
          begin
               if submenu[number,lcv].title<>'' then yy:=yy+10;
          end;
          if (mousex>xx) and (mousex<xx2) and (mousey>yy) and (mousey<yy+10) then
          begin
               hidemousecursor;
               setfillstyle(1,0);
               bar(xx,yy,xx2,yy+10);
               setcolor(15);
               outtextxy(xx,yy,submenu[number,lcv].title);
               showmousecursor;
               chosen:=zz;
               repeat
                     getbuttonstatus;
               until (mkey<>right) or (mousey<yy) or (mousey>yy+10);
               hidemousecursor;
               setfillstyle(1,15);
               bar(xx,yy,xx2,yy+10);
               setcolor(0);
               outtextxy(xx,yy,submenu[number,lcv].title);
               showmousecursor;
          end;
     end;
end;


procedure showmenu(number:integer;var chosen:integer);
var
   yy:integer;
   title:string;
begin
     setfillstyle(1,0);
     bar(xx,0,xx+menu[number].legth,10);
     setcolor(15);
     outtextxy(xx,-1,menu[number].title);
     setfillstyle(1,15);
     yy:=10;
     xx2:=0;
     for lcv:=1 to 10 do
     begin
          title:=submenu[number,lcv].title;
          if title<>'' then yy:=yy+10;
          if (title<>'') and (length(title)>xx2) then xx2:=length(title);
     end;
     xx2:=xx2*6+xx;
     bar(xx,10,xx2,yy);
     setcolor(7);
     rectangle(xx-1,10,xx2+1,yy+1);
     setcolor(0);
     yy:=10;
     for lcv:=1 to 10 do
     begin
          if submenu[number,lcv].title<>'' then
          begin
               outtextxy(xx,yy,submenu[number,lcv].title);
               yy:=yy+10;
          end;
     end;
     showmousecursor;
     repeat
     chosen:=0;
     for lcv:=1 to 10 do
     begin
          if submenu[number,lcv].title<>'' then checksubmenu(number,lcv,chosen);
     end;
     getbuttonstatus;
     until (mkey<>right) or (((mousex<xx) or (mousex>xx+menu[number].legth)) and (mousey<10));
     hidemousecursor;
     setfillstyle(1,15);
     bar(xx,0,xx+menu[number].legth,10);
     setcolor(0);
     outtextxy(xx,-1,menu[number].title);
     setfillpattern(gray50,color);
     bar(xx-1,10,xx2+1,yy+1);
     showmousecursor;
end;


Procedure CheckMenu(number:integer;var chosen:integer);
begin
     setviewport(0,0,getmaxx,getmaxy,clipoff);
     xx:=0;
     if mkey=right then
     begin
          if (mousey>0) and (mousey<10) then
          begin
               for lcv:=1 to number-1 do
               begin
                    xx:=xx+menu[lcv].legth;
               end;
               if (mousex>xx) and (mousex<xx+menu[lcv].legth) then
               begin
                    hidemousecursor;
                    showmenu(number,chosen);
                    showallwindows;
               end;
          end;
     end;
end;


Begin
     for lcv:=1 to 4 do
     begin
          gray50[lcv*2-1]:=($AA);
          gray50[lcv*2]:=($55);
     end;
     for lcv:=1 to 100 do
     begin
          gwindow[lcv].xspot:=getmaxx+1;
          gwindow[lcv].yspot:=getmaxy+1;
          gwindow[lcv].xend:=getmaxx+1;
          gwindow[lcv].yend:=getmaxy+1;
          gwindow[lcv].title:='';
          order[lcv]:=0;
     end;
     for lcv:=1 to 10 do
     begin
          for lcv2:=1 to 10 do
          begin
              submenu[lcv,lcv2].Title:='';
          end;
     end;
     for lcv:=1 to 10 do
     begin
          menu[lcv].title:='';
          menu[lcv].legth:=0;
     end;
     amountofmenus:=0;
     amountofwindows:=0;
     color:=7;
End.