DataMuseum.dk

top - metrics - download

    Length: 7680 (0x1e00)
    Types: TextFile
    Names: »KODEEDIT.PAS«

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

TextFile

(* Med dette program kan der genereres en ny brugerfil. Når startegn starter op 
leder det efter en brugerfil med 29 $ og et !. Dn kan laves med dette program *)


type
  streng20=string(.20.);
  streng80=string(.80.);
  reg_type=record
    ax,bx,cx,dx,bp,si,di,ds,es,flags:integer
  end;
var
  reg:reg_type;
  filnavn:file of integer;
  fil           : file;
  streng: streng80;
  tjeksum,tal,iofejl,lengde,sum,i: integer;
  diskdrev:char;
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
(*$U+*) (* CTRL+C check for hver programlinie *)
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
procedure drv_get(var diskdrev : char);

var
  d_no          :integer;
  
begin
   reg.cx := $19;
   swint(224,reg);
   d_no := reg.ax;
   diskdrev:=chr(65+d_no);
end;
procedure TaendCursor;
begin
  write(@27'e');
end;    
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
procedure SlukCursor;
begin  
  write(@27'f');
end;    
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
procedure Ramme(x1,y1,x2,y2: integer);
var
  x,y: integer;
begin
  gotoxy(x1,y2); write('▶8b◀');
  for x:=(x1+1) to (x2-1) do write('▶88◀'); write('▶8c◀');
  for y:=(y2+1) to (y1-1) do begin
    gotoxy(x1,y); write('▶89◀');
    gotoxy(x2,y); write('▶89◀');
  end;
  gotoxy(x1,y1); write('▶8d◀');
  for x:=(x1+1) to (x2-1) do write('▶88◀'); write('▶8e◀');
end;
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
procedure SetFunkTast(ascii: byte; streng: streng20);
begin
  write(@27':'+chr(ascii)+streng+@0);
end;
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
procedure SetFunkTaster;
begin
  SetFunkTast(75,@9);   (* pil til venstre *)
  SetFunkTast(77,@24);  (* pil til højre *)
  SetFunkTast(72,@26);  (* pil op *)
  SetFunkTast(80,@10);  (* pil ned *)
  SetFunkTast(71,@29);  (* pil home *)
  SetFunkTast(82,@4);   (* tegn ind *)
  SetFunkTast(83,@5);   (* slet tegn *)
  SetFunkTast(73,@21); (* A1 *)
  SetFunkTast(74,@22); (* A2 *)
end;
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
procedure InputStreng(kolonne,linie,max_laengde:integer;
                      tegn_stoerrelse: integer;
                      fjern_mellemrum,tegn_ramme: boolean;
                      VAR streng:streng80);

(* Hvis 'fjern_mellemrum'=TRUE fjernes evt. mellemrum til sidst, også      *)
(* på skærmen.                                                             *)
(* 'tegn_stoerrelse'=0 ændrer ikke indtastede bogstavers størrelse         *)
(* 'tegn_stoerrelse'=1 ændres alle store bogstaver til små                 *)
(* 'tegn_stoerrelse'=2 ændres alle små bogstaver til store                 *)
(* Hvis der trykkes RETURN uden at der indtastes tegn, returnerer 'streng' *)
(* den tomme streng.                                                       *)
(* Hvis der trykkes ESCAPE, returnerer 'streng' kun                        *)
(* chr(27), altså escape.                                                  *)

const
  PIL_HOEJRE=@24;
  PIL_VENSTRE=@9;
  PIL_HOME=@29;
  TEGN_IND=@4;
  BACK_SPACE=@8;
  SLET_TEGN=@5;
  SLET_REST_LINIE=@21; (* A1-tast *)  
  SLET_HEL_LINIE=@22;  (* A2-tast *)
  RETURN_TAST=@13;
  ESC_TAST=@27;

  SLUK_CURSOR=@27'f';
  TAEND_CURSOR=@27'e';
  
  tegnsaet:set of char=(.' '..'ü'.);

var
  tegn: char;
  streng_tegn: array(.1..80.) of char;
  temp_streng: streng80;
  i,xpos: integer;
begin
  if (tegn_ramme=true) then
    Ramme((kolonne-2),(linie+1),(kolonne+max_laengde+1),(linie-1)); 
  streng:='';
  for i:=1 to max_laengde do streng_tegn(.i.):=' ';
  xpos:=1;tegn:=chr(0);
  repeat
    gotoxy(kolonne-1+xpos,linie);
    TaendCursor;
    read(KBD,tegn);
    SlukCursor;
    
    if (tegn in tegnsaet) and (xpos<=max_laengde) then begin
      streng_tegn(.xpos.):=tegn;
      xpos:=xpos+1;
      write(tegn);
    end else begin

    if (tegn=PIL_VENSTRE) and (xpos>=2) then begin
      xpos:=xpos-1;
    end else begin

    if (tegn=PIL_HOEJRE) and (xpos<=(max_laengde-1)) then begin
      xpos:=xpos+1;
    end else begin

    if (tegn=SLET_REST_LINIE) then begin 
      for i:=xpos to max_laengde do begin
        streng_tegn(.i.):=' ';
        write(' ');
      end;
    end else begin

    if (tegn=SLET_HEL_LINIE) then begin 
      gotoxy(kolonne,linie);
      for i:=kolonne to (max_laengde+kolonne) do write(' ');
      for i:=1 to max_laengde do streng_tegn(.i.):=' ';
      xpos:=1;
    end else begin

    if (tegn=PIL_HOME) then begin
      xpos:=1;
    end else begin

    if (tegn=TEGN_IND) then begin
      for i:=max_laengde downto (xpos+1) do begin
        streng_tegn(.i.):=streng_tegn(.i-1.);
      end;
      streng_tegn(.xpos.):=' ';
      for i:=xpos to max_laengde do write(streng_tegn(.i.));
    end else begin
    
    if ((tegn=BACK_SPACE) and (xpos>1)) then begin
      for i:=xpos to max_laengde do begin
        streng_tegn(.(i-1).):=streng_tegn(.i.);
      end;
      streng_tegn(.max_laengde.):=' ';
      xpos:=(xpos-1);
      gotoxy(kolonne,linie);
      for i:=1 to max_laengde do write(streng_tegn(.i.));
    end else begin
   
    if (tegn=SLET_TEGN) then begin
      for i:=xpos to (max_laengde-1) do begin
        streng_tegn(.i.):=streng_tegn(.i+1.);
        write(streng_tegn(.i.));
      end;
      streng_tegn(.max_laengde.):=' ';
      write(' ');
    end else begin
   
    end;end;end;end;end;end;end;end;end;

  until ((tegn=RETURN_TAST) or (tegn=ESC_TAST));
  
  if (tegn=RETURN_TAST) then begin
    for i:=1 to max_laengde do streng:=streng+streng_tegn(.i.);
    i:=max_laengde;
    repeat
      if streng_tegn(.i.)=' ' then delete(streng,i,1);
      i:=i-1;
    until (streng_tegn(.i.)<>' ') or (i=1);

    if (tegn_stoerrelse=1) then begin
      for i:=1 to len(streng) do begin
        if (streng(.i.) in (.'A'..'^'.)) then begin
          streng(.i.):=chr(ord(streng(.i.))+32);
        end;
      end;
    end;
         
    if (tegn_stoerrelse=2) then begin
      for i:=1 to len(streng) do begin
        if (streng(.i.) in (.'a'..'ü'.)) then begin
          streng(.i.):=chr(ord(streng(.i.))-32);
        end;
      end;
    end;
         
    if fjern_mellemrum then begin
      temp_streng:=streng; streng:='';
      for i:=1 to len(temp_streng) do begin
        if (temp_streng(.i.)<>' ') then begin
          streng:=streng+temp_streng(.i.);
        end;
      end;
    end;
         
    if (fjern_mellemrum) or
       (tegn_stoerrelse=1) or (tegn_stoerrelse=2) then begin
      gotoxy(kolonne,linie);
      for i:=1 to max_laengde do write(' ');
      gotoxy(kolonne,linie);
      write(streng);
    end;

  end;

  if (tegn=ESC_TAST) then streng:=@27;

end;
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
begin
  write(clrhom);
  drv_get(diskdrev);
  SetFunkTaster;
  gotoxy(26,1);write(rvson,' INSTALLERING AF BRUGERNAVN ',RVSOFF);
  gotoxy(35,3);write('Bemærk !');
  gotoxy(15,6);write('Da det er første gang programmet startes, skal det');
  gotoxy(15,7);write('forsynes med navnet på den bruger, der har ret til');
  gotoxy(15,8);write('anvende det. I rammen herunder skal denne identifi-');
  gotoxy(15,9);write('kation indtastes. Der kan editeres indtil der tas-');
  gotoxy(15,10);write('tes retur ( <▶83◀ ).');
  repeat
  inputstreng(25,15,30,0,false,true,streng);
  until len(streng)>5;
  TaendCursor;
  sum:=0;lengde:=len(streng);
  for i:=1 to len(streng) do begin
     streng(.i.):=chr(255-ord(streng(.i.)));
     sum:=sum+ord(streng(.i.));
  end;
  sum:=sum-1001;
   (*gem*);
  assign(filnavn,'A:BRUGER.FIL');
  (*$I-*) rewrite(filnavn) (*$I+*);
  iofejl:=iores;
  if iofejl<>0 then write('Fejl i brugerfil !');
  write(filnavn,lengde);(*Strengens længde *);
  write(filnavn,sum);(* sum-1001 *)
  for i:=1 to lengde do begin
    tal:=ord(streng(.i.));
    write(filnavn,tal);
  end;
  close(filnavn);
end.  
 «eof»