DataMuseum.dk

top - metrics - download

    Length: 4864 (0x1300)
    Types: TextFile
    Names: »FLYT60.PAS«

└─⟦29e35ddf2⟧ Bits:30003931/CCPM_Tegn.imd Disketter indleveret af Steffen Jensen (Piccolo/Piccoline)
    └─⟦this⟧ »FLYT60.PAS« 

TextFile

procedure flyt(var xin,yin:integer;mode:byte);

var
 xx,yy,status,term,bredde,hoejde,xmin,ymin       : integer;
 linie                       : array(.1..5.) of coor;
 flag                   : boolean;

begin
  vaelg_returmode(xin,yin,returmode);
  flag:=true;
  xx:=xin;yy:=yin;
  repeat
    begin
      rqlocator(1,xin,yin,status,term,xout,yout);
      if (xx=xout) and (yy=yout) then flag:=false else flag:=true;
      xout:=728*(round(xout/728));
      yout:=93*(round(yout/93));
      linie(.1.).x:=xout;linie(.1.).y:=yout;
      yin:=yout;xin:=xout;
    end;
  until ((yout<=29850) and flag) or (term=33);
  if term<>33 then begin
    writemode(3);
    inputmode(1,2);
    linie(.2.):=linie(.1.);
    linie(.3.):=linie(.1.);
    linie(.4.):=linie(.1.);
    linie(.5.):=linie(.1.);
    polyline(5,linie);
    flag:=false;
    repeat
      rqlocator(1,xin,yin,status,term,xout,yout);
      if contrl(.3.)>0
      then
        begin
          xout:=728*(round(xout/728));
          yout:=93*(round(yout/93));
          polyline(5,linie);
          linie(.2.).x:=xout;
          linie(.2.).y:=linie(.1.).y;
          linie(.3.).x:=linie(.2.).x;
          linie(.3.).y:=yout;
          linie(.4.).x:=linie(.1.).x;
          linie(.4.).y:=yout;
          linie(.5.):=linie(.1.);
          xin:=xout;yin:=yout;
          polyline(5,linie);
        end;
      if term=32 then begin
       if (linie(.1.).x<>linie(.2.).x) and (linie(.2.).y<>linie(.3.).y) then begin
       flag:=true;
       polyline(5,linie);
       end;
      end;
    until flag=true;
  bredde:=abs(linie(.1.).x-linie(.2.).x);
  hoejde:=abs(linie(.1.).y-linie(.4.).y);
  xmin:=linie(.1.).x;ymin:=linie(.1.).y;
  if xmin>linie(.2.).x then xmin:=linie(.2.).x;
  if ymin>linie(.3.).y then ymin:=linie(.3.).y;
    linie(.2.):=linie(.1.);
    linie(.3.):=linie(.1.);
    linie(.4.):=linie(.1.);
    linie(.5.):=linie(.1.);
    polyline(5,linie);
  if mode=1 then (*flyt*)
     fjern(xmin,xmin+bredde,ymin,ymin+hoejde) else
     fjern_uden_fjern(xmin,xmin+bredde,ymin,ymin+hoejde);(*kopi*)
  xin:=xmin;yin:=ymin;
  repeat
  rqlocator(1,xin,yin,status,term,xout,yout);
      if ((contrl(.3.)>0) and (xout<32600-bredde) and (yout<30000-hoejde))
      then
        begin
          xout:=728*(round(xout/728));
          yout:=93*(round(yout/93));
          polyline(5,linie);
          linie(.1.).x:=xout;
          linie(.1.).y:=yout;
          linie(.2.).x:=xout+bredde;
          linie(.2.).y:=yout;
          linie(.3.).x:=xout+bredde;
          linie(.3.).y:=yout+hoejde;
          linie(.4.).x:=xout;
          linie(.4.).y:=yout+hoejde;
          linie(.5.):=linie(.1.);
          xin:=xout;yin:=yout;
          polyline(5,linie);
        end;
      if term=32 then begin
      polyline(5,linie);
      if returmode=1 then retur(xin,xin+bredde,yin,yin+hoejde) else
      transretur(xin,xin+bredde,yin,yin+hoejde);
      polyline(5,linie);
      if (mode=1) then begin
        term:=33;
      end; 
      end;
    until term=33;
 polyline(5,linie);
 writemode(1);
 inputmode(1,1);
 linecolor(0);
 linecolor(aktuel_farve);
 end;
end;

procedure kopimenu(var xin,yin:integer);

var
  disp               : integer;
  
begin
  ordre('KOPI','');
  fjern(8500,13700,21000,29000);
  fillcolor(1);
  filltype(0);
  fillstyle(0);
  disp:=0;
  if farveskaerm and (not skaerm22khz) then disp:=-300;
  gtext(10000+disp,27100,'FLYT');
  gtext(10000+disp,23100,'KOPI');
  repeat
    rqlocator(2,xin,yin,status,term,xout,yout);
  until ((yout>=21000) and (yout<=29000) and  (xout>=8800) and (xout<=13500)) or (term=33);
  retur(8500,13700,21000,29000);  
  xin:=xout;yin:=yout;
  if term<>33 then begin
  case yout of
  21000..24999:begin
               ordre('KOPI',''); 
               flyt(xin,yin,2);
             end;
  25000..29000:begin
               ordre('FLYT','');
               flyt(xin,yin,1);
             end;
  otherwise
    dyt;
  end;
  end;
skaerm1;
end;  

procedure slut_menu;
var
  disp     : integer;
  
begin
  ordre('FARVEL ?','');
  fjern(23000,31000,21000,29000);  
  disp:=0;
  if farveskaerm and (not skaerm22khz) then begin
  gtext(25000,27100,'SLUT');
  gtext(24200,23100,'VIDERE');
  end else begin
  gtext(26000,27100,'SLUT');
  gtext(25600,23100,'VIDERE');
  end;
  repeat
    rqlocator(2,xin,yin,status,term,xout,yout);
  until ((yout>=21000) and (yout<=29000) and  (xout>=23300) and (xout<=31000)) or (term=33);
  retur(23000,31000,21000,29000);  
  xin:=xout;yin:=yout;
  if term<>33 then begin
  case yout of
  21000..24999:begin
               (* nå! *);
             end;
  25000..29000:begin
               holdop:=true;
             end;
  otherwise
    dyt;
  end;
  end;
skaerm1;
end;  
«eof»