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

Pascal/Delphi Source File | 1994-04-30 | 8.2 KB | 269 lines

Program test;
{$M $4000,0,20000}
uses graph,macu,mousu,crt;
type
    dottype=array[1..8,1..8] of boolean;
    linetype=array[1..80] of string[80];
var
   dots:dottype;
   gd,gm,lcv,chose,
   axx,axy:integer;
   done,cycle:boolean;
   txt:linetype;
   s:string;
   key:char;
   lcv2,picked,colorn:integer;
   choice,
   chosen:boolean;
   no,no2,win,check:integer;

function IntToStr(i: integer): string;
var
  s: string[8];
begin
  Str(i, s);
  IntToStr := s;
end;

function IsOdd(i:integer): boolean;
var
   s:string;
begin
     s:=inttostr(i);
     case s[length(s)] of
          '0':IsOdd:=false;
          '1':IsOdd:=true;
          '2':IsOdd:=false;
          '3':IsOdd:=true;
          '4':IsOdd:=false;
          '5':IsOdd:=true;
          '6':IsOdd:=false;
          '7':IsOdd:=true;
          '8':IsOdd:=false;
          '9':IsOdd:=true;
     end;
end;

procedure showbackgroundwindow;
begin
                hidemousecursor;
                for lcv:=1 to 9 do
                    line(10,lcv*10,90,lcv*10);
                for lcv:=1 to 9 do
                    line(lcv*10,10,lcv*10,90);
                for lcv:=1 to 8 do
                begin
                     setfillstyle(1,lcv-1);
                     bar(100,lcv*10,110,lcv*10+10);
                          setfillstyle(1,lcv-1+8);
                          bar(120,lcv*10,110,lcv*10+10);
                end;
                for lcv:=1 to 8 do
                begin
                     for lcv2:=1 to 8 do
                     begin
                          if dots[lcv,lcv2]=true then
                          begin
                               setfillstyle(1,0);
                               bar(lcv*10+1,lcv2*10+1,lcv*10+9,lcv2*10+9);
                          end;
                          if dots[lcv,lcv2]=false then
                          begin
                               setfillstyle(1,colorn);
                               bar(lcv*10+1,lcv2*10+1,lcv*10+9,lcv2*10+9);
                          end;
                     end;
                end;
                showmousecursor;

end;

Procedure CheckBackground;
begin
     if ((mousex>gwindow[win].xend) and (mousex<gwindow[win].xspot) and
        (mousey<gwindow[win].yspot) and (mousey>gwindow[win].yend)) or
        (order[1]<>win) or ((not moved) and (mkey=none)) then exit;
             moved:=false;
             setcurrentdrawingwindow(win);
           if mkey<>none then
           begin
                setupmousetocurrentwindow;
                if (mousex>100) and (mousex<120) and (mousey>10) and (mousey<100) then
                begin
                     for lcv:=1 to 8 do
                     begin
                          if (mousey>lcv*10) and (mousey<(lcv+1)*10) then
                          begin
                               if mousex<110 then
                               picked:=lcv-1;
                               if (mousex>110) and (mousey<90) then
                               picked:=lcv+7;
                               colorn:=picked;
                               showbackgroundwindow;
                          end;
                     end;
                end;
                chosen:=false;
                repeat
                setupmousetocurrentwindow;
                if (mousex>10) and (mousex<90) and (mousey>10) and (mousey<90) then
                begin
                for lcv:=1 to 8 do
                begin
                     if (mousex<(lcv+1)*10) and (mousex>lcv*10) then
                     begin
                          for lcv2:=1 to 8 do
                          begin
                               if (mousey<(lcv2+1)*10) and (mousey>lcv2*10) then
                               begin
                                    if chosen=false then
                                    begin
                                         if dots[lcv,lcv2]=true then
                                         begin
                                              choice:=false;
                                              chosen:=true;
                                              setfillstyle(1,colorn);
                                         end;
                                         if dots[lcv,lcv2]=false then
                                         begin
                                              choice:=true;
                                              chosen:=true;
                                              setfillstyle(1,0);
                                         end;
                                    end;
                                    dots[lcv,lcv2]:=choice;
                                    hidemousecursor;
                                    bar(lcv*10+1,lcv2*10+1,lcv*10+9,lcv2*10+9);
                                    showmousecursor;
                               end;
                          end;
                     end;
                end;
                end;
                getbuttonstatus;
                until mkey=none;
           end;
end;


procedure makenewbackground;
begin
for lcv2:=1 to 8 do
     begin
          no:=0;
          for lcv:=1 to 8 do
          begin
               if dots[lcv,lcv2]=false then no:=no*2+1;
               if dots[lcv,lcv2]=true then no:=no*2;
          end;
          gray50[lcv2]:=(no);
     end;
     color:=colorn;
     startupscreen;
     showallwindows;
end;

Procedure SaveBackGround;
begin
     assign(output,'Back.mac');
     rewrite(output);
     for lcv:=1 to 8 do
     begin
          writeln(output,gray50[lcv]);
     end;
     writeln(output,color);
     close(output);
end;


Procedure LoadBackGround;
begin
     assign(input,'Back.mac');
     reset(input);
     for lcv:=1 to 8 do
     begin
          readln(input,gray50[lcv]);
     end;
     readln(input,color);
     close(input);
end;


Begin
     chose:=0;
     gd:=4;
     gm:=1;
     initgraph(gd,gm,'c:\tp\bgi');
     writeln(graphresult);
     makemenu(1,'IBM  ');
     makesubmenu(1,1,'Control Panel');
     makesubmenu(1,2,'BackGround');

     makemenu(2,'File');
     makesubmenu(2,1,'Quit');
     makesubmenu(2,2,'Open');
     makesubmenu(2,3,'Rename');

     MakeWindow(freewindow,10,10,100,100,'Writer 1.0',1);
     loadbackground;
     resetmouse;
     setgraphicscursor(standardshapecurs);
     showmousecursor;
     startupscreen;
     showallwindows;
     done:=false;
     check:=0;
     repeat
           getbuttonstatus;
           if mkey<>none then checkallwindows;
           if check=1 then
           begin
                if (moved) and (order[1]=win) then showbackgroundwindow;
                if gwindow[win].title<>'' then checkbackground;
                if gwindow[win].title='' then
                begin
                     check:=0;
                     makenewbackground;
                end;
           end;
           chose:=0;
           checkmenu(1,chose);
           if chose=2 then
           begin
                for lcv2:=1 to 8 do
                begin
                     no2:=gray50[lcv2];
                     for lcv:=8 downto 1 do
                     begin
                          no:=no2;
                          if IsOdd(no) then
                          begin
                               no2:=(no2-1) div 2;
                               dots[lcv,lcv2]:=false;
                          end;
                          if not IsOdd(no) then
                          begin
                               no2:=no2 div 2;
                               dots[lcv,lcv2]:=true;
                          end;
                     end;
                end;
                colorn:=color;
                win:=freewindow;
                makewindow(win,200,100,350,220,'BackGround',2);
                hidemousecursor;
                showwindow(win);
                check:=1;
                showbackgroundwindow;
           end;
           chose:=0;
           checkmenu(2,chose);
           if chose=1 then
           begin
                savebackground;
                closegraph;
                halt(1);
           end;

     until done;
end.