home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / MOUSE.ZIP / INTERFAC.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-06  |  8KB  |  269 lines
  1. Program test;
  2. {$M $4000,0,20000}
  3. uses graph,macu,mousu,crt;
  4. type
  5.     dottype=array[1..8,1..8] of boolean;
  6.     linetype=array[1..80] of string[80];
  7. var
  8.    dots:dottype;
  9.    gd,gm,lcv,chose,
  10.    axx,axy:integer;
  11.    done,cycle:boolean;
  12.    txt:linetype;
  13.    s:string;
  14.    key:char;
  15.    lcv2,picked,colorn:integer;
  16.    choice,
  17.    chosen:boolean;
  18.    no,no2,win,check:integer;
  19.  
  20. function IntToStr(i: integer): string;
  21. var
  22.   s: string[8];
  23. begin
  24.   Str(i, s);
  25.   IntToStr := s;
  26. end;
  27.  
  28. function IsOdd(i:integer): boolean;
  29. var
  30.    s:string;
  31. begin
  32.      s:=inttostr(i);
  33.      case s[length(s)] of
  34.           '0':IsOdd:=false;
  35.           '1':IsOdd:=true;
  36.           '2':IsOdd:=false;
  37.           '3':IsOdd:=true;
  38.           '4':IsOdd:=false;
  39.           '5':IsOdd:=true;
  40.           '6':IsOdd:=false;
  41.           '7':IsOdd:=true;
  42.           '8':IsOdd:=false;
  43.           '9':IsOdd:=true;
  44.      end;
  45. end;
  46.  
  47. procedure showbackgroundwindow;
  48. begin
  49.                 hidemousecursor;
  50.                 for lcv:=1 to 9 do
  51.                     line(10,lcv*10,90,lcv*10);
  52.                 for lcv:=1 to 9 do
  53.                     line(lcv*10,10,lcv*10,90);
  54.                 for lcv:=1 to 8 do
  55.                 begin
  56.                      setfillstyle(1,lcv-1);
  57.                      bar(100,lcv*10,110,lcv*10+10);
  58.                           setfillstyle(1,lcv-1+8);
  59.                           bar(120,lcv*10,110,lcv*10+10);
  60.                 end;
  61.                 for lcv:=1 to 8 do
  62.                 begin
  63.                      for lcv2:=1 to 8 do
  64.                      begin
  65.                           if dots[lcv,lcv2]=true then
  66.                           begin
  67.                                setfillstyle(1,0);
  68.                                bar(lcv*10+1,lcv2*10+1,lcv*10+9,lcv2*10+9);
  69.                           end;
  70.                           if dots[lcv,lcv2]=false then
  71.                           begin
  72.                                setfillstyle(1,colorn);
  73.                                bar(lcv*10+1,lcv2*10+1,lcv*10+9,lcv2*10+9);
  74.                           end;
  75.                      end;
  76.                 end;
  77.                 showmousecursor;
  78.  
  79. end;
  80.  
  81. Procedure CheckBackground;
  82. begin
  83.      if ((mousex>gwindow[win].xend) and (mousex<gwindow[win].xspot) and
  84.         (mousey<gwindow[win].yspot) and (mousey>gwindow[win].yend)) or
  85.         (order[1]<>win) or ((not moved) and (mkey=none)) then exit;
  86.              moved:=false;
  87.              setcurrentdrawingwindow(win);
  88.            if mkey<>none then
  89.            begin
  90.                 setupmousetocurrentwindow;
  91.                 if (mousex>100) and (mousex<120) and (mousey>10) and (mousey<100) then
  92.                 begin
  93.                      for lcv:=1 to 8 do
  94.                      begin
  95.                           if (mousey>lcv*10) and (mousey<(lcv+1)*10) then
  96.                           begin
  97.                                if mousex<110 then
  98.                                picked:=lcv-1;
  99.                                if (mousex>110) and (mousey<90) then
  100.                                picked:=lcv+7;
  101.                                colorn:=picked;
  102.                                showbackgroundwindow;
  103.                           end;
  104.                      end;
  105.                 end;
  106.                 chosen:=false;
  107.                 repeat
  108.                 setupmousetocurrentwindow;
  109.                 if (mousex>10) and (mousex<90) and (mousey>10) and (mousey<90) then
  110.                 begin
  111.                 for lcv:=1 to 8 do
  112.                 begin
  113.                      if (mousex<(lcv+1)*10) and (mousex>lcv*10) then
  114.                      begin
  115.                           for lcv2:=1 to 8 do
  116.                           begin
  117.                                if (mousey<(lcv2+1)*10) and (mousey>lcv2*10) then
  118.                                begin
  119.                                     if chosen=false then
  120.                                     begin
  121.                                          if dots[lcv,lcv2]=true then
  122.                                          begin
  123.                                               choice:=false;
  124.                                               chosen:=true;
  125.                                               setfillstyle(1,colorn);
  126.                                          end;
  127.                                          if dots[lcv,lcv2]=false then
  128.                                          begin
  129.                                               choice:=true;
  130.                                               chosen:=true;
  131.                                               setfillstyle(1,0);
  132.                                          end;
  133.                                     end;
  134.                                     dots[lcv,lcv2]:=choice;
  135.                                     hidemousecursor;
  136.                                     bar(lcv*10+1,lcv2*10+1,lcv*10+9,lcv2*10+9);
  137.                                     showmousecursor;
  138.                                end;
  139.                           end;
  140.                      end;
  141.                 end;
  142.                 end;
  143.                 getbuttonstatus;
  144.                 until mkey=none;
  145.            end;
  146. end;
  147.           
  148.  
  149. procedure makenewbackground;
  150. begin
  151. for lcv2:=1 to 8 do
  152.      begin
  153.           no:=0;
  154.           for lcv:=1 to 8 do
  155.           begin
  156.                if dots[lcv,lcv2]=false then no:=no*2+1;
  157.                if dots[lcv,lcv2]=true then no:=no*2;
  158.           end;
  159.           gray50[lcv2]:=(no);
  160.      end;
  161.      color:=colorn;
  162.      startupscreen;
  163.      showallwindows;
  164. end;
  165.  
  166. Procedure SaveBackGround;
  167. begin
  168.      assign(output,'Back.mac');
  169.      rewrite(output);
  170.      for lcv:=1 to 8 do
  171.      begin
  172.           writeln(output,gray50[lcv]);
  173.      end;
  174.      writeln(output,color);
  175.      close(output);
  176. end;
  177.  
  178.  
  179. Procedure LoadBackGround;
  180. begin
  181.      assign(input,'Back.mac');
  182.      reset(input);
  183.      for lcv:=1 to 8 do
  184.      begin
  185.           readln(input,gray50[lcv]);
  186.      end;
  187.      readln(input,color);
  188.      close(input);
  189. end;
  190.  
  191.  
  192. Begin
  193.      chose:=0;
  194.      gd:=4;
  195.      gm:=1;
  196.      initgraph(gd,gm,'c:\tp\bgi');
  197.      writeln(graphresult);
  198.      makemenu(1,'IBM  ');
  199.      makesubmenu(1,1,'Control Panel');
  200.      makesubmenu(1,2,'BackGround');
  201.  
  202.      makemenu(2,'File');
  203.      makesubmenu(2,1,'Quit');
  204.      makesubmenu(2,2,'Open');
  205.      makesubmenu(2,3,'Rename');
  206.  
  207.      MakeWindow(freewindow,10,10,100,100,'Writer 1.0',1);
  208.      loadbackground;
  209.      resetmouse;
  210.      setgraphicscursor(standardshapecurs);
  211.      showmousecursor;
  212.      startupscreen;
  213.      showallwindows;
  214.      done:=false;
  215.      check:=0;
  216.      repeat
  217.            getbuttonstatus;
  218.            if mkey<>none then checkallwindows;
  219.            if check=1 then
  220.            begin
  221.                 if (moved) and (order[1]=win) then showbackgroundwindow; 
  222.                 if gwindow[win].title<>'' then checkbackground;
  223.                 if gwindow[win].title='' then
  224.                 begin
  225.                      check:=0;
  226.                      makenewbackground;
  227.                 end;
  228.            end;
  229.            chose:=0;
  230.            checkmenu(1,chose);
  231.            if chose=2 then
  232.            begin
  233.                 for lcv2:=1 to 8 do
  234.                 begin
  235.                      no2:=gray50[lcv2];
  236.                      for lcv:=8 downto 1 do
  237.                      begin
  238.                           no:=no2;
  239.                           if IsOdd(no) then
  240.                           begin
  241.                                no2:=(no2-1) div 2;
  242.                                dots[lcv,lcv2]:=false;
  243.                           end;
  244.                           if not IsOdd(no) then
  245.                           begin
  246.                                no2:=no2 div 2;
  247.                                dots[lcv,lcv2]:=true;
  248.                           end;
  249.                      end;
  250.                 end;
  251.                 colorn:=color;
  252.                 win:=freewindow;
  253.                 makewindow(win,200,100,350,220,'BackGround',2);
  254.                 hidemousecursor;
  255.                 showwindow(win);
  256.                 check:=1;
  257.                 showbackgroundwindow;
  258.            end;
  259.            chose:=0;
  260.            checkmenu(2,chose);
  261.            if chose=1 then
  262.            begin
  263.                 savebackground;
  264.                 closegraph;
  265.                 halt(1);
  266.            end;
  267.            
  268.      until done;
  269. end.